{-# 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 { forall n a b. Graph n a b -> Map n a
_vertices  :: Map n a
                         , forall n a b. Graph n a b -> Map (n, n) b
_relations :: Map (n, n) b
                         } deriving (Int -> Graph n a b -> ShowS
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 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 :: forall n a b. Ord n => Graph n a b
emptyGraph = forall n a b. Map n a -> Map (n, n) b -> Graph n a b
Graph forall a. Monoid a => a
mempty 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 :: forall n a b.
(Show n, Ord n) =>
n -> a -> Graph n a b -> Graph n a b
addNode n
name a
node Graph n a b
graph = if n
name forall k a. Ord k => k -> Map k a -> Bool
`notMember` forall n a b. Graph n a b -> Map n a
_vertices Graph n a b
graph
                          then forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall n a b a.
Lens (Graph n a b) (Graph n a b) (Map n a) (Map n a)
vertices (forall k a. Ord k => k -> a -> Map k a -> Map k a
insert n
name a
node) Graph n a b
graph
                          else forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"vertex with name %s key already exists" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show 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 :: forall n b a.
(Show n, Ord n) =>
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) forall k a. Ord k => k -> Map k a -> Bool
`notMember` forall n a b. Graph n a b -> Map (n, n) b
_relations Graph n a b
graph
                                          then forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall n a b b.
Lens (Graph n a b) (Graph n a b) (Map (n, n) b) (Map (n, n) b)
relations (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 forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"relation with names (%s, %s) already exists" (forall a. Show a => a -> String
show n
startName) (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 :: (Text, Text) -> Text
relationName (Text
st, Text
en) = Text
st forall a. Semigroup a => a -> a -> a
<> Text
"0" forall a. Semigroup a => a -> a -> a
<> Text
en