1 {-# LANGUAGE OverloadedStrings #-}
3 -- import Data.List (foldl') -- import the strict fold
6 import Data.Text (Text)
7 import qualified Data.Text as T
8 import qualified Data.Text.IO as TIO
10 import qualified Data.HashMap.Strict as M
11 import Data.HashMap.Strict ((!))
13 import Data.Void (Void)
15 import Text.Megaparsec -- hiding (State)
16 import Text.Megaparsec.Char
17 import qualified Text.Megaparsec.Char.Lexer as L
18 import qualified Control.Applicative as CA
21 type TaskName = String
22 type Preconditions = [TaskName]
24 data Task = Task { name :: TaskName
26 , preconditions :: Preconditions
30 type CompletedTasks = M.HashMap TaskName Int
34 task_text <- TIO.readFile "data/04-preparation.txt"
35 let tasks = successfulParse task_text
40 part1 :: [Task] -> Int
41 part1 = sum . (map duration)
43 part2 :: [Task] -> Int
44 part2 tasks = maximum $ M.elems $ timeAllTasks tasks M.empty
46 timeAllTasks :: [Task] -> CompletedTasks -> CompletedTasks
47 timeAllTasks tasks completed
48 | null tasks = completed
49 | otherwise = timeAllTasks notDoable completed'
50 where (doable, notDoable) = doableTasks completed tasks
51 completed' = foldl' completeTask completed doable
53 doableTasks :: CompletedTasks -> [Task] -> ([Task], [Task])
54 doableTasks completed tasks = partition (allSatisfied completed) tasks
56 allSatisfied :: CompletedTasks -> Task -> Bool
57 allSatisfied completed task =
58 all (\n -> n `M.member` completed) (preconditions task)
61 completeTask :: CompletedTasks -> Task -> CompletedTasks
62 completeTask completed task = M.insert (name task) (duration task + startTime) completed
63 where startTime = if null $ preconditions task
65 else maximum $ map (\p -> completed!p) $ preconditions task
69 -- Parse the input file
71 type Parser = Parsec Void Text
73 -- don't treat newlines as automatically-consumed whitespace
75 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
78 integer = lexeme L.decimal
81 -- tasks is just a sequence of many individual tasks
84 -- a task is name, duration, preconditions, followed by newline
85 taskP = taskify <$> nameP <*> integer <*> (many nameP) <* newline
86 where taskify n d ns = Task {name = n, duration = d, preconditions = ns}
88 nameP = lexeme (some letterChar)
90 successfulParse :: Text -> [Task]
91 successfulParse input =
92 case parse tasksP "input" input of
93 Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err