Grueling learning process through Day7

day7/Day7Part1.hs

@@ -0,0 +1,11 @@
+module Day7Part1 (main) where
+
+import Day7Lib
+
+convertToString :: Int -> String
+convertToString = show
+
+main :: IO ()
+main = do
+  input <- getContents
+  putStrLn $ convertToString $ day7 input

day7/Day7Part2.hs

@@ -0,0 +1,11 @@
+module Day7Part2 (main) where
+
+import Day7Lib
+
+convertToString :: Int -> String
+convertToString = show
+
+main :: IO ()
+main = do
+  input <- getContents
+  putStrLn $ convertToString $ day7' input

package.yaml

@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 - split
+- containers
 
 ghc-options:
 - -Wall
@@ -182,6 +183,30 @@ executables:
     dependencies:
     - aoc2022
 
+  Day7Part1:
+    main:                Day7Part1.hs
+    other-modules:       []
+    source-dirs:         day7
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -main-is Day7Part1
+    dependencies:
+    - aoc2022
+
+  Day7Part2:
+    main:                Day7Part2.hs
+    other-modules:       []
+    source-dirs:         day7
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -main-is Day7Part2
+    dependencies:
+    - aoc2022
+
 tests:
   Day1-test:
     main:                Day1.hs

src/Day6Lib.hs

@@ -1,7 +1,7 @@
-module Day6Lib where
-    -- ( day6,
-    --   day6'
-    -- ) where
+module Day6Lib
+    ( day6,
+      day6'
+    ) where
 
 import Data.List (nub, elemIndex)
 import Data.Maybe (fromJust)

src/Day7Lib.hs

@@ -0,0 +1,183 @@
+module Day7Lib where
+
+import Data.Maybe
+import Data.Map (Map)
+import Data.List.Split (splitOn)
+
+import qualified Data.Map as M
+-- Command Parsing
+data Command
+    = CD String
+    | LS [FileListing] deriving Show
+
+data FileListing
+    = File Int String
+    | Dir String
+    deriving (Show, Read, Eq, Ord)
+
+convertToInt :: String -> Int
+convertToInt s = read s :: Int
+
+parseLsOutput :: String -> FileListing
+parseLsOutput s
+    | firstPart == "dir" = Dir lastPart
+    | otherwise          = File (convertToInt firstPart) lastPart
+    where
+        firstPart = head $ words s
+        lastPart = last $ words s
+
+parseLS :: [String] -> Command
+parseLS i = LS (map parseLsOutput lsOutput)
+    where
+        lsOutput = tail i
+
+parseCD :: [String] -> Command
+parseCD i = CD cdOutput
+    where
+        cdOutput = last $ words $ head i 
+
+parseCommand :: [String] -> Command
+parseCommand ss
+    | command == "ls" = parseLS ss
+    | command == "cd" = parseCD ss
+    where
+        command = head $ words $ head ss
+        output = tail ss
+
+-- Used https://github.com/prikhi/advent-of-code-2022/blob/master/Day07.hs#L13 as reference
+-- Many thanks if you see this, I had never actually dealt with anything "zoomable" before or even record types
+-- Your solution gave me the guidance I needed to find some new techniques and keep going
+
+data FSNode
+    = FileNode Int
+    | DirectoryNode FileSystem
+    deriving (Show, Read, Eq, Ord)
+
+newtype FileSystem = FileSystem
+    { fromFileSystem :: Map String FSNode
+    }
+    deriving (Show, Read, Eq, Ord)
+
+-- Use zoomables to keep track of the parent objects while traversing down the tree
+data Zoomable = Zoomable
+    { zParents :: [(String, FileSystem)]
+    , zCurrentDir :: (String, FileSystem)
+    }
+    deriving (Show, Read, Eq, Ord)
+
+-- Make a root directory named "/" with an empty filesystem as a zoomable
+rootDir :: Zoomable
+rootDir = Zoomable [] ("/", FileSystem M.empty)
+
+-- Go all the way back up to the root and return the root filesystem
+unZoom :: Zoomable -> FileSystem
+unZoom z = case parentDir z of
+    -- If it doesn't have a parrent, take the filesystem from the currentDir
+    Nothing -> snd $ zCurrentDir z
+    -- If it has a parent keep going
+    Just parent -> unZoom parent
+
+-- Go all the way back up to the root filesystem, but stay as a zoomable
+goToRoot :: Zoomable -> Zoomable
+goToRoot z = Zoomable [] ("/", unZoom z)
+
+-- Go up one step in the directory tree, applying any changes to current dir to the parents filesystem
+parentDir :: Zoomable -> Maybe Zoomable
+parentDir Zoomable {zParents = zParents, zCurrentDir = zCurrentDir} = case zParents of
+    [] -> Nothing
+    (parentName, FileSystem parentFS) : parents ->
+        let (curName, curFS) = zCurrentDir
+            newFSNode = DirectoryNode curFS
+        -- return just a zoomable with the parents as parents, and create a new filesystem map with our currentFS inserted over our parents previous knowledge of us
+        in Just . Zoomable parents $ (parentName, FileSystem $ M.insert curName newFSNode parentFS)
+
+enterDir :: String -> Zoomable -> Zoomable
+enterDir childDir Zoomable {zParents = zParents, zCurrentDir = zCurrentDir} =
+    case M.lookup childDir $ fromFileSystem $ snd zCurrentDir of
+        Just (DirectoryNode childFS) ->
+            Zoomable
+                { zParents = zCurrentDir : zParents
+                , zCurrentDir = (childDir, childFS)
+                }
+        Nothing ->
+            Zoomable
+                { zParents = zCurrentDir : zParents
+                , zCurrentDir = (childDir, FileSystem M.empty)
+                }
+
+toNode :: FileListing -> (String, FSNode)
+toNode fls = case fls of
+    File size name -> (name, FileNode size)
+    Dir name -> (name, DirectoryNode $ FileSystem M.empty)
+
+-- Given a file listing and a filesystem add the filelisting to the file system
+fileSystemModify :: FileListing -> Map String FSNode -> Map String FSNode
+fileSystemModify fls fs = M.insert nodeName node fs
+    where
+        toNodeResult = toNode fls
+        nodeName = fst toNodeResult
+        node = snd toNodeResult
+
+createFileListings :: [FileListing] -> Zoomable -> Zoomable
+createFileListings fls z = 
+    let (name, FileSystem oldFs) = zCurrentDir z
+        newFs = foldr fileSystemModify oldFs fls
+    in z { zCurrentDir = (name, FileSystem newFs) }
+
+
+runCommand :: Zoomable -> Command -> Zoomable
+runCommand z cmd = case cmd of
+    LS fls -> createFileListings fls z
+    CD "/" -> goToRoot z
+    CD ".." -> fromJust (parentDir z)
+    CD child -> enterDir child z
+
+accumulateFileSize :: Int -> FSNode -> Int
+accumulateFileSize acc (DirectoryNode childDir) = acc + totalUsedSpace childDir
+accumulateFileSize acc (FileNode size) = acc + size
+
+-- Calculate total used space
+totalUsedSpace :: FileSystem -> Int
+totalUsedSpace (FileSystem rootFs) = 
+    foldl accumulateFileSize 0 rootFs
+
+
+directorySizes :: FileSystem -> [Int]
+directorySizes fs = concatMap directorySize $ fromFileSystem fs
+
+directorySize :: FSNode -> [Int]
+directorySize dir = case dir of
+    FileNode _ -> []
+    DirectoryNode dn ->
+        let childDirSizes = map (directorySize . snd) . M.toList $ fromFileSystem dn
+        in totalUsedSpace dn : concat childDirSizes
+        
+
+commandsToFileSystem :: [Command] -> FileSystem
+commandsToFileSystem cmds = unZoom $ foldl runCommand rootDir cmds
+
+parseInput :: String -> [Command]
+parseInput input = commands
+    where
+        -- This gives us an empty first command, so we drop 1
+        inputSplitOnCommands = drop 1 $ splitOn "$ " input
+        commandsSplitOnLines = map lines inputSplitOnCommands
+        commands = map parseCommand commandsSplitOnLines
+
+day7 :: String -> Int
+day7 input = result
+    where
+        directorySizeList = directorySizes $ commandsToFileSystem $ parseInput input
+        result = sum $ filter (< 100000) directorySizeList
+
+day7' :: String -> Int
+day7' input = result
+    where
+        directorySizeList = directorySizes filesystem
+        filesystem = commandsToFileSystem $ parseInput input
+        spaceUsed = totalUsedSpace filesystem
+        spaceAvailable = 70000000 - spaceUsed
+        spaceNeeded = 30000000
+        spaceWeNeedToClear = spaceNeeded - spaceAvailable
+        directoryCandidates = filter (>= spaceWeNeedToClear) directorySizeList
+        result = minimum directoryCandidates

stack.yaml

@@ -41,6 +41,7 @@ packages:
 #
 extra-deps:
   - split-0.2.3.5
+  - containers-0.6.4.1
 
 # Override default flag values for local packages and extra-deps
 # flags: {}