Implement replacing subnodes via path
This commit is contained in:
parent
db1287aff3
commit
efd33ff05e
1 changed files with 14 additions and 7 deletions
|
|
@ -7,12 +7,13 @@ module Forest.Node
|
|||
-- * Node
|
||||
NodeId
|
||||
, Node(..)
|
||||
, hasChildren
|
||||
, emptyNode
|
||||
, initialNode
|
||||
, hasChildren
|
||||
, mapChildren
|
||||
, applyId
|
||||
, applyPath
|
||||
, mapChildren
|
||||
, replaceAt
|
||||
-- * Path
|
||||
, Path(..)
|
||||
, localPath
|
||||
|
|
@ -56,23 +57,29 @@ instance ToJSON Node where
|
|||
instance FromJSON Node where
|
||||
parseJSON = genericParseJSON nodeOptions
|
||||
|
||||
hasChildren :: Node -> Bool
|
||||
hasChildren = not . Map.null . nodeChildren
|
||||
|
||||
emptyNode :: T.Text -> Bool -> Bool -> Bool -> Bool -> Node
|
||||
emptyNode text edit delete reply act = Node text edit delete reply act Map.empty
|
||||
|
||||
initialNode :: Node
|
||||
initialNode = emptyNode "Loading..." False False False False
|
||||
|
||||
hasChildren :: Node -> Bool
|
||||
hasChildren = not . Map.null . nodeChildren
|
||||
|
||||
mapChildren :: (NodeId -> Node -> a) -> Node -> [a]
|
||||
mapChildren f node = map (uncurry f) $ Map.toAscList $ nodeChildren node
|
||||
|
||||
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
|
||||
|
||||
mapChildren :: (NodeId -> Node -> a) -> Node -> [a]
|
||||
mapChildren f node = map (uncurry f) $ Map.toAscList $ nodeChildren node
|
||||
replaceAt :: Node -> Path -> Node -> Node
|
||||
replaceAt childNode (Path []) _ = childNode
|
||||
replaceAt childNode (Path (x:xs)) node =
|
||||
let newChildren = Map.adjust (replaceAt childNode $ Path xs) x $ nodeChildren node
|
||||
in node{nodeChildren = newChildren}
|
||||
|
||||
{- Path -}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue