Data commit

Task/Tree-datastructures/Haskell/tree-datastructures-1.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE TypeApplications        #-}
+
+import Data.List (span)
+
+-- A nested tree structure.
+-- Using `Maybe` allows encoding several zero-level items
+-- or irregular lists (see test example)
+data Nest a = Nest (Maybe a) [Nest a]
+  deriving Eq
+
+instance Show a => Show (Nest a) where
+  show (Nest (Just a) []) = show a
+  show (Nest (Just a) s) = show a ++ show s
+  show (Nest Nothing []) = "\"\""
+  show (Nest Nothing s) = "\"\"" ++ show s
+
+-- An indented tree structure.
+type Indent a = [(Int, a)]
+
+-- class for isomorphic types
+class Iso b a => Iso a b where
+  from :: a -> b
+
+-- A bijection from nested form to indent form
+instance Iso (Nest a) (Indent a) where
+  from = go (-1)
+    where
+      go n (Nest a t) =
+        case a of
+          Just a -> (n, a) : foldMap (go (n + 1)) t
+          Nothing -> foldMap (go (n + 1)) t
+
+-- A bijection from indent form to nested form
+instance Iso (Indent a) (Nest a) where
+  from = revNest . foldl add (Nest Nothing [])
+    where
+      add t (d,x) = go 0 t
+        where
+          go n (Nest a s) =
+            case compare n d of
+              EQ -> Nest a $ Nest (Just x) [] : s
+              LT -> case s of
+                      h:t -> Nest a $ go (n+1) h : t
+                      [] -> go n $ Nest a [Nest Nothing []]
+              GT -> go (n-1) $ Nest Nothing [Nest a s]
+
+      revNest (Nest a s) = Nest a (reverse $ revNest <$> s)
+
+-- A bijection from indent form to a string
+instance Iso (Indent String) String where
+  from = unlines . map process
+    where
+      process (d, s) = replicate (4*d) ' ' ++ s
+
+-- A bijection from a string to indent form
+instance Iso String (Indent String) where
+  from = map process . lines
+    where
+      process s = let (i, a) = span (== ' ') s
+                  in (length i `div` 4, a)
+
+-- A bijection from nest form to a string via indent form
+instance Iso (Nest String) String where
+  from = from @(Indent String) . from
+
+-- A bijection from a string to nest form via indent form
+instance Iso String (Nest String) where
+  from = from @(Indent String) . from

Task/Tree-datastructures/Haskell/tree-datastructures-2.hs

@@ -0,0 +1,18 @@
+test = unlines
+  [ "RosettaCode"
+  , "    rocks"
+  , "        code"
+  , "        comparison"
+  , "        wiki"
+  , "    mocks"
+  , "        trolling"
+  , "Some lists"
+  , "            may"
+  , "        be"
+  , "    irregular"  ]
+
+itest :: Indent String
+itest = from test
+
+ttest :: Nest String
+ttest = from test

Task/Tree-datastructures/Haskell/tree-datastructures-3.hs

@@ -0,0 +1,85 @@
+import Data.Bifunctor (bimap, first)
+import Data.Char (isSpace)
+import Data.List (find)
+import Data.Tree (Forest, Tree (..), drawTree)
+
+-------- MAPPINGS BETWEEN INDENTED LINES AND TREES -------
+
+forestFromNestLevels :: [(Int, String)] -> Forest String
+forestFromNestLevels = go
+  where
+    go [] = []
+    go ((n, v) : xs) =
+      uncurry (:) $
+        bimap (Node v . go) go (span ((n <) . fst) xs)
+
+indentLevelsFromLines :: [String] -> [(Int, String)]
+indentLevelsFromLines xs =
+  let pairs = first length . span isSpace <$> xs
+      indentUnit = maybe 1 fst (find ((0 <) . fst) pairs)
+   in first (`div` indentUnit) <$> pairs
+
+outlineFromForest ::
+  (String -> String -> String) ->
+  String ->
+  Forest String ->
+  String
+outlineFromForest showRoot tabString forest =
+  let go indent node =
+        showRoot indent (rootLabel node) :
+        (subForest node >>= go ((<>) tabString indent))
+   in unlines $ forest >>= go ""
+
+-------------------------- TESTS -------------------------
+main :: IO ()
+main = do
+  putStrLn "Tree representation parsed directly:\n"
+  putStrLn $ drawTree $ Node "" nativeForest
+
+  let levelPairs = indentLevelsFromLines test
+  putStrLn "\n[(Level, Text)] list from lines:\n"
+  mapM_ print levelPairs
+
+  putStrLn "\n\nTrees from indented text:\n"
+  let trees = forestFromNestLevels levelPairs
+  putStrLn $ drawTree $ Node "" trees
+
+  putStrLn "Indented text from trees:\n"
+  putStrLn $ outlineFromForest (<>) "    " trees
+
+test :: [String]
+test =
+  [ "RosettaCode",
+    "    rocks",
+    "        code",
+    "        comparison",
+    "        wiki",
+    "    mocks",
+    "        trolling",
+    "Some lists",
+    "            may",
+    "        be",
+    "    irregular"
+  ]
+
+nativeForest :: Forest String
+nativeForest =
+  [ Node
+      "RosettaCode"
+      [ Node
+          "rocks"
+          [ Node "code" [],
+            Node "comparison" [],
+            Node "wiki" []
+          ],
+        Node
+          "mocks"
+          [Node "trolling" []]
+      ],
+    Node
+      "Some lists"
+      [ Node "may" [],
+        Node "be" [],
+        Node "irregular" []
+      ]
+  ]