AoC2019/day6.hs

import Data.Foldable as Fold
import Data.Maybe as Maybe
import Data.List.Split
import Data.List as List

main = do
   content <- getContents
   let ops = map parse $ lines content
   --let result = foldl toMap [("COM",0)] (sorted ops "COM")
   let result = toTree2 "YOU" ops 0
   mapM putStrLn (map show result)
   putStrLn $ show $ sum (map (\x-> snd x) result)
   putStrLn("Hello World")

toMap :: [(String,Int)] -> (String,String) -> [(String,Int)]
toMap state (p1,p2) = state ++ [(p2, (snd value) + 1)]
      where value = (fromMaybe (p1,-1) ((Fold.find (\x -> fst x == p1) state))) 

sorted :: [(String, String)] -> String -> [(String, String)]
sorted input base = baseOps ++ (concat $ map (sorted input) subelems)
                    where
	               baseOps = filter (\(x, _) -> x == base) input
                       subelems = map snd baseOps

toTree :: [(String,Int)] -> [(String,String)] -> [(String,Int)]
toTree dist ops = do
      let visits = map fst dist
      let newop = (Fold.find (\x-> (elem (fst x) visits)) ops)
      if Maybe.isNothing newop
         then dist
         else do
            let newdist = toMap dist (Maybe.fromJust newop)
            let newops = List.delete (Maybe.fromJust newop) ops
            toTree newdist newops    

toTree2 :: String -> [(String,String)] -> Int -> [(String,Int)]
toTree2 base ops counter = do
      let rightnewop = (filter (\x-> base == fst x) ops)
      let leftnewop = (filter (\x-> base == snd x)  ops)
      let newstops = (map snd rightnewop)  ++ ( map fst leftnewop)
      if null rightnewop && null leftnewop
         then []
         else do
	    let newcounter = counter + 1
            let newdist = (map (\x-> (x,newcounter)) newstops)
	    let newops = filter(\x->notElem x (leftnewop ++ rightnewop)) ops
            newdist ++ (concat $ map (\x -> toTree2 x newops newcounter) newstops)

parse :: String -> (String, String)
parse input = do 
            let split = splitOn ")" input 
            (split !! 0, split !! 1)