Parsing DAG from text

Question

This module allows to parse indented text file into Map from node to child nodes identified by Coordinate. This module seems way too complex - mainly because of managing stack that allows to "jump back" with decreasing indentation. How can I redesign it?

sample input:

a
 b
 c
  d
   e
 f

produces:

*Parse> parse tree
fromList [("a",["f","c","b"]),("c",["d"]),("d",["e"])]

implementation:

module Parse where
import System.Environment (getArgs)
import Data.List (find, isInfixOf, intercalate)
import Data.Char (isAlpha)
import Control.Lens ((&))
import Data.List.Split (splitWhen)
import Control.Arrow
import qualified Data.Map.Strict as Map
import Data.Maybe
import Debug.Trace
import Control.Applicative

type Coordinate = String

parse :: String -> Map.Map Coordinate [Coordinate]
parse = snd . go
  where
    go = foldl addDependency ([], Map.empty) . filter ((>0) . length) . lines

addDependency (stack, acc) line = if null stack then
                                   (,) [(0, line)] $ Map.singleton line []
                                   else let children = fromMaybe [] . flip Map.lookup acc
                                            lineDepth = countIndent line
                                            indent = signum $ lineDepth - (fst . head $ stack)
                                            coord = toCoordinate line
                                            addChild c = Map.insert c (coord : children c) acc
                                            parent = tail stack
                                        in
                                         case indent of
                                           0 -> (,) ((lineDepth,coord):parent) $ addChild (snd . head $ parent)
                                           1 -> (,) ((lineDepth,coord):stack) (addChild $ snd . head $ stack)
                                           _ -> let newStack = back stack lineDepth
                                                    newHead = snd . head $ newStack
                                                     in (,) ((lineDepth,coord):newStack) (addChild newHead)

back stack@((i,c):ss) indent = if indent > i then stack else back ss indent
toCoordinate = dropWhile (not . special)
special = (||) <$> isAlpha <*> (=='(')
countIndent = length . takeWhile (not . special)

Answer 1

Make things easier on yourself by separating concerns. E.g., each line encodes a position in its amount of leading whitespace followed by an identifier. Parse this representation into a more manipulable form in a single function invocation, don't thread it through your algorithm logic which shouldn't care about serialized representation.

type SerializedGraph = String -- Aliases for pedagogical clarity
type Indentation = Int
type Symbol = String

parse :: SerializedGraph -> [(Indentation, Symbol)]
parse = map (first length . span (== ' ')) . lines
    where first :: (a -> b) -> (a, c) -> (b, c)
          first f (a, c) = (f a, c)

Now consider intermediate representations that can get you closer to your goal. Remember that it's easy to construct a map from an association list with fromList, so let's make that our end goal. Write out the types for a roadmap from where we are to where we want to be.

    [(Indentation, Symbol)] -- [(Hint, Key)]
==> ???
==> [(Symbol, [Symbol])] -- [(Key, [Value])]

If that final representation has only unique keys, then a reasonable intermediary would be one that hasn't had values which share a key accumulated yet. I.e., [(Symbol, Symbol)] -- [(Key, Value)].

associate :: [(Int, String)] -> [(String, String)]
associate []          = []
associate ((i, s):ss) = [(s, t) | (j, t) <- descendants, j == i + 1]
                     ++ associate descendants
                     ++ associate siblings
    where (descendants, siblings) = span ((> i) . fst) ss

Now all that's left to do is create a Map. We could accumulate values on our own, but really that's what fromListWith is for.

toMap :: [(String, String)] -> Map String [String]
toMap = fromListWith (++) . map (second (:[]))
    where second f (a, b) = (a, f b)

All that's left is composing these functions together.

readGraph :: String -> Map String [String]
readGraph = toMap . associate . parse