From 580b3b320948a4f483800a70283ae1d4114c6277 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sat, 8 Feb 2020 23:09:49 +0000
Subject: [PATCH] Add a few node- and path-related functions

---
 src/Forest/Api.hs  |  2 +-
 src/Forest/Tree.hs | 38 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 38 insertions(+), 2 deletions(-)

diff --git a/src/Forest/Api.hs b/src/Forest/Api.hs
index 1a919a6..60b5219 100644
--- a/src/Forest/Api.hs
+++ b/src/Forest/Api.hs
@@ -50,7 +50,7 @@ instance FromJSON Node where
 
 newtype Path = Path
   { pathElements :: [NodeId]
-  } deriving (Show, Eq, ToJSON, FromJSON)
+  } deriving (Show, Eq, Ord, ToJSON, FromJSON)
 
 parsePacket :: Value -> T.Text -> (Object -> Parser a) -> Parser a
 parsePacket value packetType parser = parseJSON value >>= \o -> do
diff --git a/src/Forest/Tree.hs b/src/Forest/Tree.hs
index 0eba61c..55cce30 100644
--- a/src/Forest/Tree.hs
+++ b/src/Forest/Tree.hs
@@ -1,11 +1,24 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Forest.Tree
-  ( emptyNode
+  (
+  -- * Node-related functions
+    emptyNode
   , initialNode
+  , applyId
+  , applyPath
+  -- * Path-related functions
+  , localPath
+  , isLocalPath
+  , isValidPath
+  , narrowPath
+  , narrowSet
   ) where
 
+import           Control.Monad
 import qualified Data.Map.Strict as Map
+import           Data.Maybe
+import qualified Data.Set        as Set
 import qualified Data.Text       as T
 
 import           Forest.Api
@@ -15,3 +28,26 @@ emptyNode text edit delete reply act = Node text edit delete reply act Map.empty
 
 initialNode :: Node
 initialNode = emptyNode "Loading..." False False False False
+
+applyId :: NodeId -> Node -> Maybe Node
+applyId nodeId node = nodeChildren node Map.!? nodeId
+
+applyPath :: Path -> Node -> Maybe Node
+applyPath (Path ids) node = foldM (flip applyId) node ids
+
+localPath :: Path
+localPath = Path []
+
+isLocalPath :: Path -> Bool
+isLocalPath = (== localPath)
+
+isValidPath :: Node -> Path -> Bool
+isValidPath node path = isJust $ applyPath path node
+
+narrowPath :: NodeId -> Path -> Maybe Path
+narrowPath x (Path (y:ys))
+  | x == y = Just (Path ys)
+narrowPath _ _ = Nothing
+
+narrowSet :: NodeId -> Set.Set Path -> Set.Set Path
+narrowSet x s = Set.fromList [Path ys | Path (y:ys) <- Set.toList s, x == y]