Given a flat list of integers greater than zero, representing object nesting
levels, e.g. [1, 2, 4],
generate a tree formed from nested lists of those nesting level integers where:

 Every int appears, in order, at its depth of nesting.
 If the next level int is greater than the previous then it appears in a sub-list of the list containing the previous item


The generated tree data structure should ideally be in a languages nested list format that can
be used for further calculations rather than something just calculated for printing.



An input of [1, 2, 4] should produce the equivalent of: [1, [2, [[4]]]]
where 1 is at depth1, 2 is two deep and 4 is nested 4 deep.

[1, 2, 4, 2, 2, 1] should produce [1, [2, [[4]], 2, 2], 1]. 

All the nesting integers are in the same order but at the correct nesting
levels.

Similarly [3, 1, 3, 1] should generate [[[3]], 1, [[3]], 1]

Task

Generate and show here the results for the following inputs:

 []
 [1, 2, 4]
 [3, 1, 3, 1]
 [1, 2, 3, 1]
 [3, 2, 1, 3]
 [3, 3, 3, 1, 1, 3, 3, 3]


{-# LANGUAGE TupleSections #-}
 
import Data.Bifunctor (bimap)
import Data.Tree (Forest, Tree (..), drawTree, foldTree)
 
------------- TREE FROM NEST LEVELS (AND BACK) -----------
 
treeFromSparseLevels :: [Int] -> Tree (Maybe Int)
treeFromSparseLevels =
  Node Nothing
    . forestFromNestLevels
    . rooted
    . normalised
 
sparseLevelsFromTree :: Tree (Maybe Int) -> [Int]
sparseLevelsFromTree = foldTree go
  where
    go Nothing xs = concat xs
    go (Just x) xs = x : concat xs
 
forestFromNestLevels :: [(Int, a)] -> Forest a
forestFromNestLevels = go
  where
    go [] = []
    go ((n, v) : xs) =
      uncurry (:) $
        bimap (Node v . go) go (span ((n <) . fst) xs)
 
--------------------- TEST AND DISPLAY -------------------
main :: IO ()
main =
  mapM_
    ( \xs ->
        putStrLn ("From: " <> show xs)
          >> let tree = treeFromSparseLevels xs
              in putStrLn ((drawTree . fmap show) tree)
                   >> putStrLn
                     ( "Back to: "
                         <> show (sparseLevelsFromTree tree)
                         <> "\n\n"
                     )
    )
    [ [],
      [1, 2, 4],
      [3, 1, 3, 1],
      [1, 2, 3, 1],
      [3, 2, 1, 3],
      [3, 3, 3, 1, 1, 3, 3, 3]
    ]
 
----------- MAPPING TO A STRICTER DATA STRUCTURE ---------
 
-- Path from the virtual root to the first explicit node.
rooted :: [(Int, Maybe Int)] -> [(Int, Maybe Int)]
rooted [] = []
rooted xs = go $ filter ((1 <=) . fst) xs
  where
    go xs@((1, mb) : _) = xs
    go xs@((n, mb) : _) =
      fmap (,Nothing) [1 .. pred n] <> xs
 
-- Representation of implicit nodes.
normalised [] = []
normalised [x] = [(x, Just x)]
normalised (x : y : xs)
  | 1 < (y - x) =
    (x, Just x) :
    (succ x, Nothing) : normalised (y : xs)
  | otherwise = (x, Just x) : normalised (y : xs)