69 lines
2.8 KiB
Haskell
Executable File
69 lines
2.8 KiB
Haskell
Executable File
#! /usr/bin/env stack
|
|
-- stack --resolver lts-12.20 --install-ghc script
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module Main where
|
|
|
|
import Control.Applicative
|
|
import Control.Monad.State
|
|
import Data.Bifunctor (first, second)
|
|
import Data.Function (on)
|
|
import Data.Maybe
|
|
|
|
import qualified Data.List as L
|
|
import qualified Data.Map as M
|
|
import qualified Text.Parsec as P
|
|
import qualified Text.Parsec.Language as PL
|
|
import qualified Text.Parsec.Token as PT
|
|
|
|
main :: IO ()
|
|
main = interact $ (show .) $ (. parseEvents) $ \events ->
|
|
let spansAsleep = flip execState M.empty $ start (L.sort events)
|
|
where
|
|
start [] = pure ()
|
|
start ((Event { evtType = Begins g }):es) = began g es
|
|
start (e:es) = error $ "start: " ++ show e
|
|
began g ((Event { evtDate = dt, evtTime = tm, evtType = Sleeps }):es) = slept g dt tm es
|
|
began _ es = start es
|
|
slept g sdt stm ((Event { evtDate = wdt, evtTime = wtm, evtType = Wakes }):es) = do
|
|
modify $ flip (M.unionWith (++)) (M.singleton g [((sdt, stm), (wdt, wtm))])
|
|
began g es
|
|
minuteAsleep g = L.maximumBy (compare `on` snd) $
|
|
[ (m, n) | m <- [0..59], let n = length $ filter (\((_,stm),(_,wtm)) -> tmMinute stm <= m && m < tmMinute wtm) (fromJust $ M.lookup g spansAsleep) ]
|
|
mostAsleep = L.maximumBy (compare `on` snd . snd) $
|
|
[ (g, minuteAsleep g) | g <- M.keys spansAsleep ]
|
|
in let m@(g,(minute,_)) = mostAsleep in (m, g*minute)
|
|
|
|
type Guard = Int
|
|
|
|
data Date = Date { dtYear :: Int
|
|
, dtMonth :: Int
|
|
, dtDay :: Int
|
|
} deriving (Eq, Ord, Show)
|
|
|
|
data Time = Time { tmHour :: Int
|
|
, tmMinute :: Int
|
|
} deriving (Eq, Ord, Show)
|
|
|
|
data EventType = Begins Guard | Sleeps | Wakes deriving (Eq, Ord, Show)
|
|
|
|
data Event a = Event { evtDate :: Date
|
|
, evtTime :: Time
|
|
, evtType :: EventType
|
|
, evtExtra :: a
|
|
} deriving (Eq, Ord, Show)
|
|
|
|
instance Functor Event where
|
|
fmap f evt = evt { evtExtra = f (evtExtra evt) }
|
|
|
|
parseEvents :: String -> [Event ()]
|
|
parseEvents = either (error . show) id . P.runParser (many event <* P.eof) () "input"
|
|
where
|
|
decimal = fromInteger <$> PT.decimal PL.haskell
|
|
whiteSpace = PT.whiteSpace PL.haskell
|
|
event = Event <$ P.char '[' <*> date <* whiteSpace <*> time <* P.char ']' <* whiteSpace <*> eventType <* P.endOfLine <*> pure ()
|
|
date = Date <$> decimal <* P.char '-' <*> decimal <* P.char '-' <*> decimal
|
|
time = Time <$> decimal <* P.char ':' <*> decimal
|
|
eventType = (Begins <$ P.string "Guard #" <*> decimal <* P.string " begins shift")
|
|
<|> (Sleeps <$ P.string "falls asleep")
|
|
<|> (Wakes <$ P.string "wakes up")
|