Day 7 Cleanup and modularisation

This commit is contained in:
Jens Kadenbach
2022-12-07 16:56:47 +01:00
parent c115484544
commit 7f4a4329b0
5 changed files with 92 additions and 83 deletions

View File

@@ -45,8 +45,10 @@ library
Day5.Shared Day5.Shared
Day6 Day6
Day7 Day7
Day7.Interpreter
Day7.Parser Day7.Parser
Lib Lib
Shared
other-modules: other-modules:
Paths_aoc2022 Paths_aoc2022
hs-source-dirs: hs-source-dirs:

View File

@@ -1,86 +1,10 @@
module Day7 ( module Day7 (
buildTree,
buildTree',
mkdir,
Directory (..),
calculateSize,
filterDirectories,
sumUp,
day7 day7
) where ) where
import Day7.Parser import Day7.Parser
import Data.Map (Map) import Day7.Interpreter
import qualified Data.Map as Map import Shared
data Directory = Directory
{ sub :: Map String Directory
, files :: Map String Int
, isRoot :: Bool
} deriving (Eq)
instance Show Directory where
show d = show (files d) ++ " - " ++ show (sub d) ++ "\n"
mkdir :: Directory
mkdir = Directory { sub = Map.empty, files = Map.empty, isRoot = False }
rootDirectory :: Directory
rootDirectory = Directory { sub = Map.empty, files = Map.empty, isRoot = True }
buildTree :: [TerminalCommand] -> Directory
buildTree commands = fst (buildTree' rootDirectory commands)
buildTree' :: Directory -> [TerminalCommand] -> (Directory, [TerminalCommand])
buildTree' dir [] = (dir, [])
buildTree' dir (command:cs) = case command of
Listing entries ->
let asFiles = Map.fromList $ toFiles entries
newDir = dir { files = asFiles }
in buildTree' newDir cs
In dirName ->
let subFolders = sub dir
selectedDir = Map.findWithDefault mkdir dirName subFolders
(replacement, rest) = buildTree' selectedDir cs
updatedSub = Map.insert dirName replacement subFolders
in buildTree' dir { sub = updatedSub} rest
Out -> (dir, cs)
Root -> if isRoot dir
then buildTree' dir cs
else (dir, command:cs)
toFiles :: [ListingEntry] -> [(String, Int)]
toFiles ((FileListing name size):rest) = (name, size): toFiles rest
toFiles (_:rest) = toFiles rest
toFiles [] = []
calculateSize :: Directory -> Int
calculateSize dir = sum (Map.elems (files dir)) + sum sizes
where
subFolders = Map.elems (sub dir)
sizes = map calculateSize subFolders
flatten :: Directory -> [(String, Directory)]
flatten dir = flatten' ("/", dir)
where
flatten' (name, d) = (name, d) : concatMap flatten' (Map.toList (sub d))
sizeOfDirectories :: Directory -> [(String, Int)]
sizeOfDirectories dir = map withSize allDirectories
where
allDirectories = flatten dir
withSize (name, directory) = (name, calculateSize directory)
filterDirectories :: (Int -> Bool) -> Directory -> [(String, Int)]
filterDirectories predicate dir = filter (\(_, size) -> predicate size) $ sizeOfDirectories dir
sumUp :: [(String, Int)] -> Int
sumUp = sum . map snd
forceRight :: Either a b -> b
forceRight (Left _) = error "forced Right but got Left"
forceRight (Right b) = b
day7 :: IO () day7 :: IO ()
day7 = do day7 = do

80
src/Day7/Interpreter.hs Normal file
View File

@@ -0,0 +1,80 @@
module Day7.Interpreter (
buildTree,
mkdir,
Directory (..),
calculateSize,
filterDirectories,
sizeOfDirectories,
sumUp,
) where
import Day7.Parser
import Data.Map (Map)
import qualified Data.Map as Map
data Directory = Directory
{ sub :: Map String Directory
, files :: Map String Int
, isRoot :: Bool
} deriving (Eq)
instance Show Directory where
show d = "DIR " ++ show (Map.toList $ files d) ++ " - " ++ show (Map.toList $ sub d) ++ "\n"
mkdir :: Directory
mkdir = Directory { sub = Map.empty, files = Map.empty, isRoot = False }
rootDirectory :: Directory
rootDirectory = mkdir { isRoot = True }
buildTree :: [TerminalCommand] -> Directory
buildTree commands = fst (buildTree' rootDirectory commands)
where
-- executes terminal commands and returns all remaining commands
buildTree' :: Directory -> [TerminalCommand] -> (Directory, [TerminalCommand])
buildTree' dir [] = (dir, [])
buildTree' dir (command:cs) = case command of
Listing entries ->
let asFiles = Map.fromList $ toFiles entries
newDir = dir { files = asFiles }
in buildTree' newDir cs -- update current directory and return all remaining commands
In dirName ->
let subFolders = sub dir
selectedDir = Map.findWithDefault mkdir dirName subFolders -- select or create folder
(replacement, rest) = buildTree' selectedDir cs -- recurse down
updatedSub = Map.insert dirName replacement subFolders -- update folder the map of the current directory
in buildTree' dir { sub = updatedSub} rest -- continue with updated folder and rest of commands
Out -> (dir, cs) -- return to previous caller and return all remaining commands
Root -> if isRoot dir
then buildTree' dir cs -- return to previous caller as long is current directory is not root
else (dir, command:cs) -- keep the Root command because it is not yet completed
-- convert to file-pairs and ignore directories
toFiles :: [ListingEntry] -> [(String, Int)]
toFiles ((FileListing name size):rest) = (name, size): toFiles rest
toFiles (_:rest) = toFiles rest
toFiles [] = []
calculateSize :: Directory -> Int
calculateSize dir = sum (Map.elems (files dir)) + sum sizes
where
subFolders = Map.elems (sub dir)
sizes = map calculateSize subFolders
flatten :: Directory -> [(String, Directory)]
flatten dir = flatten' ("/", dir)
where
flatten' (name, d) = (name, d) : concatMap flatten' (Map.toList (sub d))
sizeOfDirectories :: Directory -> [(String, Int)]
sizeOfDirectories dir = map withSize allDirectories
where
allDirectories = flatten dir
withSize (name, directory) = (name, calculateSize directory)
filterDirectories :: (Int -> Bool) -> Directory -> [(String, Int)]
filterDirectories predicate dir = filter (\(_, size) -> predicate size) $ sizeOfDirectories dir
sumUp :: [(String, Int)] -> Int
sumUp = sum . map snd

6
src/Shared.hs Normal file
View File

@@ -0,0 +1,6 @@
module Shared(forceRight) where
forceRight :: Either a b -> b
forceRight (Left _) = error "forced Right but got Left"
forceRight (Right b) = b

View File

@@ -4,8 +4,9 @@ module Day7Spec (spec) where
import Test.Hspec import Test.Hspec
import Text.Heredoc import Text.Heredoc
import Day7 import Shared
import Day7.Parser import Day7.Parser
import Day7.Interpreter
import qualified Data.Map as Map import qualified Data.Map as Map
inputPart1 :: String inputPart1 :: String
@@ -72,10 +73,6 @@ cdOutParsed = [
Listing [FileListing "f" 23, DirListing "foo", DirListing "bar"] Listing [FileListing "f" 23, DirListing "foo", DirListing "bar"]
] ]
forceRight :: Either a b -> b
forceRight (Left _) = error "forced Right but got Left"
forceRight (Right b) = b
spec :: Spec spec :: Spec
spec = spec =
describe "Day7" $ do describe "Day7" $ do