advent-of-code/app/seven.hs

86 lines
2.8 KiB
Haskell
Raw Normal View History

2022-12-17 14:50:06 +01:00
-- everything stolen from http://learnyouahaskell.com/zippers#a-very-simple-file-system
import Control.Monad
data FS = FS [Inode]
data Inode = Dir Name [Inode] | File Name Size deriving(Show)
type Name = String
type Size = Int
data Command = Ls | Cd Name | CdUp | CdRoot deriving(Show)
data Line = LineC Command | LineI Inode deriving(Show)
parseCommand :: String -> Command
parseCommand "ls" =Ls
parseCommand "cd .." =CdUp
parseCommand ('c':'d':' ':name) =(Cd name)
parseInode :: String -> Inode
parseInode ('d':'i':'r':' ': name) = Dir name []
parseInode input = File (drop 1 $ dropWhile (/= ' ') input) (read $ takeWhile (/= ' ') input)
parseEither :: String -> Line
parseEither ('$':' ':command) =LineC $ parseCommand command
parseEither input= LineI $ parseInode input
foldFunction :: FSZipper -> Line -> FSZipper
foldFunction zipper (LineC Ls) = zipper
foldFunction zipper (LineC (Cd name)) = fsTo name zipper
foldFunction zipper (LineC CdUp) = fsUp zipper
foldFunction zipper (LineI inode) = fsNewInode inode zipper
data FSCrumb = FSCrumb Name [Inode] [Inode] deriving (Show)
type FSZipper = (Inode,[FSCrumb])
fsUp :: FSZipper -> FSZipper
fsUp (item, FSCrumb name ls rs:bs) = (Dir name (ls ++ [item] ++ rs), bs)
fsUpToRoot :: FSZipper -> FSZipper
fsUpToRoot ((Dir "/" content),bc) = ((Dir "/" content),bc)
fsUpToRoot zipper = fsUp zipper
fsTo :: Name -> FSZipper -> FSZipper
fsTo name (Dir folderName items, bs) =
let (ls, item:rs) = break (nameIs name) items
in (item, FSCrumb folderName ls rs:bs)
nameIs :: Name -> Inode -> Bool
nameIs name (Dir folderName _) = name == folderName
nameIs name (File fileName _) = name == fileName
fsNewInode :: Inode -> FSZipper -> FSZipper
fsNewInode newInode ((Dir name content),bc) = (Dir name (newInode:content),bc)
initZipper :: FSZipper
initZipper = (Dir "/" [],[])
data InodeSize = DirS Size | FileS Size deriving(Show)
getSize (DirS s)= s
getSize (FileS s)=s
flattenToSmallDirs :: Inode -> [InodeSize]
flattenToSmallDirs (Dir _ children) =
let childSizes =join $ map flattenToSmallDirs children
currentSize=(sum $ map getSize $ childSizes) in
(DirS currentSize):(filter isDir childSizes )
flattenToSmallDirs (File _ size) = [FileS size]
filterSmallDirs :: [InodeSize] -> [Size]
filterSmallDirs ((DirS s):rest) = if (s<100000) then s:(filterSmallDirs rest) else filterSmallDirs rest
filterSmallDirs ((FileS s):rest) = filterSmallDirs rest
filterSmallDirs [] = []
isDir (DirS s)=True
isDir (FileS s)=False
main = do
content <- readFile "seven-input.txt"
let statements = map parseEither $ drop 1 $ lines content
let a = foldl foldFunction initZipper statements
print $ sum $ filterSmallDirs $ flattenToSmallDirs $ fst $ fsUpToRoot a