Day 7, part 2 - partial progress: made a tree, I guess?

7.hs

@@ -1,5 +1,6 @@
-import Data.HashSet (Set, fromList, delete)
+import Data.HashMap (Map, fromList, toList, delete, findWithDefault)
 import Data.List.Split
+import Data.Tree (Tree, unfoldTree, drawTree)
 
 type Weight = Int
 type Program = String
@@ -9,21 +10,32 @@ discardEmpty :: [String] -> [String]
 discardEmpty [""] = []
 discardEmpty xs = xs
 
-parseLine :: String -> (Program, Weight, Programs)
+parseLine :: String -> (Program, (Weight, Programs))
 parseLine line =
     let nameAndWeight : programsString : _ = splitOn ")" line
         programs = discardEmpty $ splitOn ", " $ last $ splitOn " -> " programsString
         name : weight : _ = splitOn " (" nameAndWeight
-    in (name, read weight, programs)
+    in (name, (read weight, programs))
+
+getBottom :: Map Program (Weight, Programs) -> [(Program, (Weight, Programs))] -> Program
+getBottom m l = bottomName
+    where 
+        (bottomName, _) : _ = toList $ foldr 
+            (\(name, (_, programs)) set -> 
+                case programs of
+                    [] -> delete name set
+                    ps -> foldr delete set ps) 
+            m l
+
+mapToTree :: Map Program (Weight, Programs) -> Program -> Tree Weight
+mapToTree m = unfoldTree (\s -> findWithDefault undefined s m)
 
 main :: IO ()
 main = do
     input <- readFile "7.txt"
-    let list    = map parseLine $ lines input
+    let programsList = map parseLine $ lines input
-        nameSet = fromList $ map (\(name, _, _) -> name) list
+        programsMap = fromList programsList
-        bottom  = foldr (\(name, _, programs) set -> 
+        bottomName = getBottom programsMap programsList
-            case programs of
+        programsTree = mapToTree programsMap bottomName
-                [] -> delete name set
+    print $ bottomName
-                ps -> foldr delete set ps)
+    writeFile "7_tree.txt" $ drawTree $ fmap show programsTree
-            nameSet list
-    print $ bottom