RecoverTree.hs

-- | Recover tree structure from linearized form
--
-- Suppose we have a list of strings
--
-- > A
-- >  B
-- >   C
-- >   D
-- >  E
-- >   F
--
-- with identation indicating nesting. We want to recover the tree structure
-- from this linearized form.
recoverTree :: forall a.
               (a -> a -> Bool) -- Comparing nesting depth
            -> [a]
            -> (Tree a, [a])
recoverTree nestedBelow = \case
    []   -> error "recoverTree: empty list"
    x:xs -> let (children, xs') = parseChildrenOf x xs
            in (Tree.Node x children, xs')
  where
    tryParseChildOf :: a -> [a] -> Maybe (Tree a, [a])
    tryParseChildOf _      []     = Nothing
    tryParseChildOf parent (x:xs) =
        if x `nestedBelow` parent
          then let (grandchildren, xs') = parseChildrenOf x xs
               in Just (Tree.Node x grandchildren, xs')
          else Nothing

    parseChildrenOf :: a -> [a] -> ([Tree a], [a])
    parseChildrenOf parent xs =
        case tryParseChildOf parent xs of
          Nothing           -> ([], xs)
          Just (child, xs') -> first (child:) $ parseChildrenOf parent xs'


_exampleLinear :: [String]
_exampleLinear = [
      "A"
    , " B"
    , "  C"
    , "  D"
    , " E"
    , "  F"
    ]

_exampleTree :: Tree String
_exampleTree = fst $ recoverTree ((>) `on` depth) _exampleLinear
  where
    depth :: String -> Int
    depth = length . takeWhile (== ' ')