diff --git a/src/Database/Persist/Local/Class/PersistEntityGraph.hs b/src/Database/Persist/Local/Class/PersistEntityGraph.hs index 745c682..3fedea3 100644 --- a/src/Database/Persist/Local/Class/PersistEntityGraph.hs +++ b/src/Database/Persist/Local/Class/PersistEntityGraph.hs @@ -23,5 +23,5 @@ import Prelude import Database.Persist class (PersistEntity n, PersistEntity e) => PersistEntityGraph n e where - parentField :: EntityField e (Key n) - childField :: EntityField e (Key n) + sourceField :: EntityField e (Key n) + destField :: EntityField e (Key n) diff --git a/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs b/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs new file mode 100644 index 0000000..bb29ec9 --- /dev/null +++ b/src/Database/Persist/Local/Class/PersistEntityHierarchy.hs @@ -0,0 +1,52 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Database.Persist.Local.Class.PersistEntityHierarchy + ( HierarchyEdgeDirection (..) + , PersistEntityHierarchy (..) + , defParentField + , defChildField + ) +where + +import Prelude + +import Database.Persist +import Database.Persist.Local.Class.PersistEntityGraph + +data HierarchyEdgeDirection n e = TowardsChild | TowardsParent + +class PersistEntityGraph n e => PersistEntityHierarchy n e where + edgeDirection :: HierarchyEdgeDirection n e + parentField :: EntityField e (Key n) + childField :: EntityField e (Key n) + +defParentField + :: PersistEntityGraph n e + => HierarchyEdgeDirection n e + -> EntityField e (Key n) +defParentField dir = + case dir of + TowardsChild -> sourceField + TowardsParent -> destField + +defChildField + :: PersistEntityGraph n e + => HierarchyEdgeDirection n e + -> EntityField e (Key n) +defChildField dir = + case dir of + TowardsChild -> destField + TowardsParent -> sourceField diff --git a/src/Database/Persist/Local/Sql.hs b/src/Database/Persist/Local/Sql.hs index fb8c723..37634fe 100644 --- a/src/Database/Persist/Local/Sql.hs +++ b/src/Database/Persist/Local/Sql.hs @@ -49,17 +49,17 @@ dummyFromFst _ = Nothing dummyFromSnd :: Proxy (a, b) -> Maybe b dummyFromSnd _ = Nothing -childFieldFromProxy +destFieldFromProxy :: PersistEntityGraph node edge => Proxy (node, edge) -> EntityField edge (Key node) -childFieldFromProxy _ = childField +destFieldFromProxy _ = destField -parentFieldFromProxy +sourceFieldFromProxy :: PersistEntityGraph node edge => Proxy (node, edge) -> EntityField edge (Key node) -parentFieldFromProxy _ = parentField +sourceFieldFromProxy _ = sourceField rawSqlWithGraph :: ( RawSql a @@ -139,8 +139,8 @@ containsCycle' proxy = do conn <- ask let tNode = entityDef $ dummyFromFst proxy tEdge = entityDef $ dummyFromSnd proxy - fwd = childFieldFromProxy proxy - bwd = parentFieldFromProxy proxy + fwd = destFieldFromProxy proxy + bwd = sourceFieldFromProxy proxy start = DBName "temp_start_cte" temp = DBName "temp_hierarchy_cte" tid = DBName "id" diff --git a/vervis.cabal b/vervis.cabal index 1ae7abe..55063c3 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -69,6 +69,7 @@ library Database.Persist.Class.Local Database.Persist.Sql.Local Database.Persist.Local.Class.PersistEntityGraph + Database.Persist.Local.Class.PersistEntityHierarchy Database.Persist.Local.Class.PersistQueryForest Database.Persist.Local.RecursionDoc Database.Persist.Local.Sql