{-# 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)
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
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
addNode :: (Show n, Ord n)
=> n
-> a
-> 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
addRelation :: (Show n, Ord n)
=> n
-> n
-> b
-> 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)
type NodeName = Text
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