From 7a33ef16f83574292505c518d0733b67f5811e60 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Tue, 5 Jul 2016 16:13:48 +0000
Subject: [PATCH] PersistEntityGraph is for any graph, PersistEntityHierarchy
 for DAGs

---
 .../Persist/Local/Class/PersistEntityGraph.hs |  4 +-
 .../Local/Class/PersistEntityHierarchy.hs     | 52 +++++++++++++++++++
 src/Database/Persist/Local/Sql.hs             | 12 ++---
 vervis.cabal                                  |  1 +
 4 files changed, 61 insertions(+), 8 deletions(-)
 create mode 100644 src/Database/Persist/Local/Class/PersistEntityHierarchy.hs

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 <fr33domlover@riseup.net>.
+ -
+ - ♡ 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
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+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