From 7d8596c52bddf0517292cb68b812ded2207826f2 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Tue, 5 Jul 2016 12:37:31 +0000
Subject: [PATCH] Path existence checking between graph nodes

---
 src/Data/Graph/Inductive/Query/Path.hs | 68 ++++++++++++++++++++++++++
 vervis.cabal                           |  1 +
 2 files changed, 69 insertions(+)
 create mode 100644 src/Data/Graph/Inductive/Query/Path.hs

diff --git a/src/Data/Graph/Inductive/Query/Path.hs b/src/Data/Graph/Inductive/Query/Path.hs
new file mode 100644
index 0000000..78911fd
--- /dev/null
+++ b/src/Data/Graph/Inductive/Query/Path.hs
@@ -0,0 +1,68 @@
+{- 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/>.
+ -}
+
+-- | Detecting existence of paths in graphs, and finding the paths.
+--
+-- Some path related functions already exist in @fgl@ in the Query modules on
+-- the algorithms they're based on. In this module I'm putting additional path
+-- related utilities I need.
+module Data.Graph.Inductive.Query.Path
+    ( -- * Existence of a path between given nodes
+      connects
+    , uconnects
+    , rconnects
+    )
+where
+
+import Prelude
+
+import Data.Graph.Inductive.Graph
+import Data.Graph.Inductive.Internal.Queue
+
+-- | Since FGL's BFS module doesn't allow to specify the traversal direction,
+-- I'm writing a modified version here. I could use DFS as long as I only check
+-- for existence, but it will be easier to reuse code if the algorithm used for
+-- checking is also used for getting the paths themselves.
+xbfsnWith'
+    :: Graph g
+    => (Context a b -> [Node])
+    -> (Context a b -> c)
+    -> Queue Node
+    -> g a b
+    -> [c]
+xbfsnWith' follow result = go
+    where
+    go q g =
+        if queueEmpty q || isEmpty g
+            then []
+            else
+                let (n, q') = queueGet q
+                in  case match n g of
+                        (Just c, g') ->
+                            let q'' = queuePutList (follow c) q'
+                            in  result c : go q'' g'
+                        (Nothing, g') -> go q' g'
+
+xbfs :: Graph g => (Context a b -> [Node]) -> Node -> g a b -> [Node]
+xbfs follow node = xbfsnWith' follow node' (queuePut node mkQueue)
+
+connects :: Graph g => Node -> Node -> g a b -> Bool
+connects u v = elem v . xbfs suc' u
+
+uconnects :: Graph g => Node -> Node -> g a b -> Bool
+uconnects u v = elem v . xbfs neighbors' u
+
+rconnects :: Graph g => Node -> Node -> g a b -> Bool
+rconnects u v = elem v . xbfs pre' u
diff --git a/vervis.cabal b/vervis.cabal
index 7e8b6f0..1ae7abe 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -55,6 +55,7 @@ library
                        Data.Git.Local
                        Data.Graph.Inductive.Query.Cycle
                        Data.Graph.Inductive.Query.Layer
+                       Data.Graph.Inductive.Query.Path
                        Data.HashMap.Lazy.Local
                        Data.Hourglass.Local
                        Data.List.Local