paths.hs

import qualified Data.Map as Map

type SubPaths = Map.Map String Node
data Node = Content SubPaths | NoContent SubPaths deriving (Show)

content :: [(String, Node)] -> Node
content kvs = Content $ Map.fromList kvs

nocontent :: [(String, Node)] -> Node
nocontent kvs = NoContent $ Map.fromList kvs

routes :: Node
routes = content [
  ("animal", nocontent [
    ("bird", content []),
    ("mammal", nocontent [
      ("cat", content []),
      ("dog", content [])])]),
  ("vegetable", nocontent [
    ("flower", nocontent [
      ("daisy", content [])]),
    ("tree", nocontent [
      ("oak", nocontent [])])]),
  ("mineral", content [
    ("rock", nocontent [])])]

joinPath :: String -> String -> String
joinPath path key = path ++ ('/' : key)

getSubPaths :: SubPaths -> String -> [String]
getSubPaths subpaths path = do
  (key, subnode) <- Map.assocs subpaths
  getPaths' subnode $ joinPath path key

getPaths' :: Node -> String -> [String]
getPaths' (Content subpaths) path = path : getSubPaths subpaths path
getPaths' (NoContent subpaths) path = getSubPaths subpaths path

getPaths :: Node -> [String]
getPaths node = getPaths' node ""

main :: IO ()
main = do
  mapM_ putStrLn $ getPaths routes