src/task4/task4.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 -- import Data.List (foldl')        -- import the strict fold
   4 import Data.List
   5
   6 import Data.Text (Text)
   7 import qualified Data.Text as T
   8 import qualified Data.Text.IO as TIO
   9
  10 import qualified Data.HashMap.Strict as M
  11 import Data.HashMap.Strict ((!))
  12
  13 import Data.Void (Void)
  14
  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
  19
  20
  21 type TaskName = String
  22 type Preconditions = [TaskName]
  23
  24 data Task = Task { name :: TaskName
  25                  , duration :: Int
  26                  , preconditions :: Preconditions
  27                  } deriving (Show, Eq)
  28
  29
  30 type CompletedTasks = M.HashMap TaskName Int
  31
  32 main :: IO ()
  33 main = do
  34         task_text <- TIO.readFile "data/04-preparation.txt"
  35         let tasks = successfulParse task_text
  36         print $ part1 tasks
  37         print $ part2 tasks
  38
  39
  40 part1 :: [Task] -> Int
  41 part1 = sum . (map duration)
  42
  43 part2 :: [Task] -> Int
  44 part2 tasks = maximum $ M.elems $ timeAllTasks tasks M.empty
  45
  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
  52
  53 doableTasks :: CompletedTasks -> [Task] -> ([Task], [Task])
  54 doableTasks completed tasks = partition (allSatisfied completed) tasks
  55
  56 allSatisfied :: CompletedTasks -> Task -> Bool
  57 allSatisfied completed task =
  58     all (\n -> n `M.member` completed) (preconditions task)
  59
  60
  61 completeTask :: CompletedTasks -> Task -> CompletedTasks
  62 completeTask completed task = M.insert (name task) (duration task + startTime) completed
  63     where startTime = if null $ preconditions task
  64                       then 0
  65                       else maximum $ map (\p -> completed!p) $ preconditions task
  66
  67
  68
  69 -- Parse the input file
  70
  71 type Parser = Parsec Void Text
  72
  73 -- don't treat newlines as automatically-consumed whitespace
  74 sc :: Parser ()
  75 sc = L.space (skipSome (char ' ')) CA.empty CA.empty
  76
  77 lexeme  = L.lexeme sc
  78 integer = lexeme L.decimal
  79 symb = L.symbol sc
  80
  81 -- tasks is just a sequence of many individual tasks
  82 tasksP = many taskP
  83
  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}
  87
  88 nameP = lexeme (some letterChar)
  89
  90 successfulParse :: Text -> [Task]
  91 successfulParse input =
  92         case parse tasksP "input" input of
  93                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  94                 Right tasks  -> tasks