adventofcode/2022/app/Day7/Main.hs

111 lines
3.6 KiB
Haskell
Raw Normal View History

module Day7.Main (main) where
import System.IO
import Data.List
import Data.List.Split
import Data.Char
import System.IO.Unsafe
import Data.Maybe
main :: IO ()
main = do
putStrLn "Day 7"
handle <- openFile "app/Day7/input" ReadMode
contents <- hGetContents handle
let r1 = part1 contents
putStrLn $ "part 1: " ++ show r1
let r2 = part2 contents
putStrLn $ "part 2: " ++ show r2
type Name = String
type Size = Int
data FileSystem = Node Name [FileSystem]
| File Name Size
deriving (Show)
instance Read FileSystem where
readsPrec _ ('d':'i':'r':' ':xs) = [(Node xs [], "")]
readsPrec _ file = [(File name size, "")]
where
parts = splitOn " " file
name = parts !! 1
size = read $ parts !! 0
showFileSystemWithIndent :: Int -> FileSystem -> String
showFileSystemWithIndent n (File name size) = replicate (n*2) ' ' ++ "- " ++ name ++ " (size: " ++ show size ++ ")\n"
showFileSystemWithIndent n (Node name files) = replicate (n*2) ' ' ++ "- " ++ name ++ "/\n" ++ concatMap (showFileSystemWithIndent (n+1)) files
data Command = Cd Name
| Ls [FileSystem]
instance Show Command where
show (Cd name) = "$ cd " ++ show name ++ "\n"
show (Ls files) = "$ ls " ++ show files ++ "\n"
rstrip :: String -> String
rstrip = reverse . dropWhile isSpace . reverse
instance Read Command where
readsPrec _ ('c':'d':' ':name) = [(Cd name, "")]
readsPrec _ ('l':'s':files) = [(Ls items, "")]
where
lines = drop 1 $ splitOn "\n" files
items = map (read :: String -> FileSystem) lines
parseData :: String -> [Command]
parseData contents = map (read :: String -> Command) $ map rstrip $ drop 1 $ splitOn "$ " contents
getName :: FileSystem -> Name
getName (File n _) = n
getName (Node n _) = n
update :: Int -> a -> [a] -> [a]
update n item ls = a ++ (item:b)
where (a, (_:b)) = splitAt n ls
addToFs :: FileSystem -> [Name] -> FileSystem -> FileSystem
addToFs (Node name files) [] item = Node name (item:files)
addToFs (Node name files) (dir:path) item = Node name files'
where
index = fromJust $ findIndex ((== dir) . getName) files
file' = addToFs (files !! index) path item
files' = update index file' files
executeCommand :: [Command] -> [Name] -> FileSystem -> FileSystem
executeCommand [] pwd fs = fs
executeCommand ((Cd "/"):cs) _ fs = executeCommand cs [] fs
executeCommand ((Cd ".."):cs) (_:pwd) fs = executeCommand cs pwd fs
executeCommand ((Cd ".."):cs) [] fs = error "eyyy cd .. from root!"
executeCommand ((Cd path):cs) pwd fs = executeCommand cs (path : pwd) fs
executeCommand ((Ls files):cs) pwd fs = executeCommand cs pwd fs'
where fs' = foldr (\i f -> addToFs f (reverse pwd) i) fs files
commandsToFs :: [Command] -> FileSystem
commandsToFs commands = executeCommand commands [] (Node "root" [])
dirSize :: FileSystem -> Int
dirSize (Node _ files) = sum $ map dirSize files
dirSize (File _ size) = size
bigDirs :: FileSystem -> [Int]
bigDirs (Node _ files) = concatMap bigDirs files ++ [size]
where size = dirSize (Node "" files)
bigDirs (File _ _) = []
part1 :: String -> Int
part1 contents = sum $ filter (<= 100000) $ bigDirs results
where
results = commandsToFs $ parseData contents
part2 :: String -> Int
part2 contents = minimum candidates
where
results = commandsToFs $ parseData contents
fsSize = dirSize results
unused = 70000000 - fsSize
needed = 30000000 - unused
candidates = filter (>= needed) $ bigDirs results