{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Database.Bolt.Extras.Graph.Internal.AbstractGraph
  (
    Graph (..)
  , vertices
  , relations
  , emptyGraph
  , addNode
  , addRelation
  , NodeName
  , relationName
  ) where

import           Control.Lens    (makeLenses, over)
import           Data.Map.Strict (Map, insert, notMember)
import           Data.Text       (Text)
import           GHC.Generics    (Generic)
import           Text.Printf     (printf)

-- | Representation of Graph that is used for requests and responses. It is parameterized by three types:
--
--   * @n@: type of node names
--   * @a@: type of nodes
--   * @b@: type of relations
--
-- Relations are described by a pair of nodes - start and end.
--
-- There are lenses defined for 'Graph': 'vertices' and 'relations'.
--
data Graph n a b = Graph { Graph n a b -> Map n a
_vertices  :: Map n a
                         , Graph n a b -> Map (n, n) b
_relations :: Map (n, n) b
                         } deriving (Int -> Graph n a b -> ShowS
[Graph n a b] -> ShowS
Graph n a b -> String
(Int -> Graph n a b -> ShowS)
-> (Graph n a b -> String)
-> ([Graph n a b] -> ShowS)
-> Show (Graph n a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n a b.
(Show n, Show a, Show b) =>
Int -> Graph n a b -> ShowS
forall n a b. (Show n, Show a, Show b) => [Graph n a b] -> ShowS
forall n a b. (Show n, Show a, Show b) => Graph n a b -> String
showList :: [Graph n a b] -> ShowS
$cshowList :: forall n a b. (Show n, Show a, Show b) => [Graph n a b] -> ShowS
show :: Graph n a b -> String
$cshow :: forall n a b. (Show n, Show a, Show b) => Graph n a b -> String
showsPrec :: Int -> Graph n a b -> ShowS
$cshowsPrec :: forall n a b.
(Show n, Show a, Show b) =>
Int -> Graph n a b -> ShowS
Show, (forall x. Graph n a b -> Rep (Graph n a b) x)
-> (forall x. Rep (Graph n a b) x -> Graph n a b)
-> Generic (Graph n a b)
forall x. Rep (Graph n a b) x -> Graph n a b
forall x. Graph n a b -> Rep (Graph n a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n a b x. Rep (Graph n a b) x -> Graph n a b
forall n a b x. Graph n a b -> Rep (Graph n a b) x
$cto :: forall n a b x. Rep (Graph n a b) x -> Graph n a b
$cfrom :: forall n a b x. Graph n a b -> Rep (Graph n a b) x
Generic)

makeLenses ''Graph

-- | An empty graph.
--
emptyGraph :: Ord n => Graph n a b
emptyGraph :: Graph n a b
emptyGraph = Map n a -> Map (n, n) b -> Graph n a b
forall n a b. Map n a -> Map (n, n) b -> Graph n a b
Graph Map n a
forall a. Monoid a => a
mempty Map (n, n) b
forall a. Monoid a => a
mempty

-- | Adds node to graph by its name and data.
-- If graph already contains node with given @name@, @error@ will be thrown.
--
addNode :: (Show n, Ord n)
        => n -- ^ Name of the node
        -> a -- ^ Node data
        -> Graph n a b -> Graph n a b
addNode :: n -> a -> Graph n a b -> Graph n a b
addNode n
name a
node Graph n a b
graph = if n
name n -> Map n a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`notMember` Graph n a b -> Map n a
forall n a b. Graph n a b -> Map n a
_vertices Graph n a b
graph
                          then ASetter (Graph n a b) (Graph n a b) (Map n a) (Map n a)
-> (Map n a -> Map n a) -> Graph n a b -> Graph n a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Graph n a b) (Graph n a b) (Map n a) (Map n a)
forall n a b a.
Lens (Graph n a b) (Graph n a b) (Map n a) (Map n a)
vertices (n -> a -> Map n a -> Map n a
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert n
name a
node) Graph n a b
graph
                          else String -> Graph n a b
forall a. HasCallStack => String -> a
error (String -> Graph n a b) -> (n -> String) -> n -> Graph n a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall r. PrintfType r => String -> r
printf String
"vertex with name %s key already exists" ShowS -> (n -> String) -> n -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> String
forall a. Show a => a -> String
show (n -> Graph n a b) -> n -> Graph n a b
forall a b. (a -> b) -> a -> b
$ n
name

-- | Adds relation to graph by @startName@ of node, @endName@ of node, and @rel@ with relation data.
-- If graph already contains relation with given @(startName, endName)@, @error@ will be thrown.
--
addRelation :: (Show n, Ord n)
            => n -- ^ Name of start node
            -> n -- ^ Name of end node
            -> b -- ^ Relation data
            -> Graph n a b -> Graph n a b
addRelation :: n -> n -> b -> Graph n a b -> Graph n a b
addRelation n
startName n
endName b
rel Graph n a b
graph = if (n
startName, n
endName) (n, n) -> Map (n, n) b -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`notMember` Graph n a b -> Map (n, n) b
forall n a b. Graph n a b -> Map (n, n) b
_relations Graph n a b
graph
                                          then ASetter (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b)
-> (Map (n, n) b -> Map (n, n) b) -> Graph n a b -> Graph n a b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b)
forall n a b b.
Lens (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b)
relations ((n, n) -> b -> Map (n, n) b -> Map (n, n) b
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert (n
startName, n
endName) b
rel) Graph n a b
graph
                                          else String -> Graph n a b
forall a. HasCallStack => String -> a
error (String -> Graph n a b) -> String -> Graph n a b
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"relation with names (%s, %s) already exists" (n -> String
forall a. Show a => a -> String
show n
startName) (n -> String
forall a. Show a => a -> String
show n
endName)

-- | Alias for text node name.
--
type NodeName = Text

-- | Build relationship name from the names of its start and end nodes
-- like @[startNodeName]0[endNodeName]@.
relationName :: (NodeName, NodeName) -> Text
relationName :: (NodeName, NodeName) -> NodeName
relationName (NodeName
st, NodeName
en) = NodeName
st NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
"0" NodeName -> NodeName -> NodeName
forall a. Semigroup a => a -> a -> a
<> NodeName
en