111 lines
3.6 KiB
Haskell
111 lines
3.6 KiB
Haskell
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
|