{-# Language OverloadedStrings, QuasiQuotes, ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 4 solution
Copyright   : (c) Eric Mertens, 2018
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2018/day/4>

-}
module Main (main) where

import Control.Applicative ((<|>))
import Data.List (maximumBy, sortBy)
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Time (LocalTime, readPTime, defaultTimeLocale, todMin, localTimeOfDay)
import Text.ParserCombinators.ReadP (ReadP, readS_to_P)

import Advent (counts, format)

p :: ReadP LocalTime
p :: ReadP LocalTime
p = Bool -> TimeLocale -> String -> ReadP LocalTime
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadP t
readPTime Bool
True TimeLocale
defaultTimeLocale String
"%Y-%m-%d %H:%M"

a :: ReadP Action
a :: ReadP Action
a = Action
Wake  Action -> ReadP String -> ReadP Action
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"wakes up" ReadP Action -> ReadP Action -> ReadP Action
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Action
Sleep Action -> ReadP String -> ReadP Action
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"falls asleep" ReadP Action -> ReadP Action -> ReadP Action
forall a. ReadP a -> ReadP a -> ReadP a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Guard -> Action
Start (Guard -> Action) -> ReadP String -> ReadP (Guard -> Action)
forall a b. a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ReadP String
"Guard #" ReadP (Guard -> Action) -> ReadP Guard -> ReadP Action
forall a b. ReadP (a -> b) -> ReadP a -> ReadP b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Guard
Guard (Int -> Guard) -> ReadP Int -> ReadP Guard
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Int -> ReadP Int
forall a. ReadS a -> ReadP a
readS_to_P ReadS Int
forall a. Read a => ReadS a
reads) ReadP Action -> ReadP String -> ReadP Action
forall a b. ReadP a -> ReadP b -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP String
" begins shift" 

-- | Print solutions to part 1 and part 2 of day 4
--
-- >>> :main
-- 94040
-- 39940
main :: IO ()
IO ()
main =
 do [(LocalTime, Action)]
input <- [format|2018 4 ([@p] @a%n)*|]
    let timesheet :: [(Guard, Int)]
timesheet = [(LocalTime, Action)] -> [(Guard, Int)]
toSleepMinutes (((LocalTime, Action) -> (LocalTime, Action) -> Ordering)
-> [(LocalTime, Action)] -> [(LocalTime, Action)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LocalTime, Action) -> LocalTime)
-> (LocalTime, Action) -> (LocalTime, Action) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (LocalTime, Action) -> LocalTime
forall a b. (a, b) -> a
fst) [(LocalTime, Action)]
input)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([(Guard, Int)] -> Int
part1 [(Guard, Int)]
timesheet)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([(Guard, Int)] -> Int
part2 [(Guard, Int)]
timesheet)

-- | Log entry actions
data Action
  = Start Guard -- ^ Guard begins shift
  | Wake        -- ^ Current guard wakes up
  | Sleep       -- ^ Current guard falls asleep
  deriving (Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show, ReadPrec [Action]
ReadPrec Action
Int -> ReadS Action
ReadS [Action]
(Int -> ReadS Action)
-> ReadS [Action]
-> ReadPrec Action
-> ReadPrec [Action]
-> Read Action
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Action
readsPrec :: Int -> ReadS Action
$creadList :: ReadS [Action]
readList :: ReadS [Action]
$creadPrec :: ReadPrec Action
readPrec :: ReadPrec Action
$creadListPrec :: ReadPrec [Action]
readListPrec :: ReadPrec [Action]
Read, Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq, Eq Action
Eq Action =>
(Action -> Action -> Ordering)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Bool)
-> (Action -> Action -> Action)
-> (Action -> Action -> Action)
-> Ord Action
Action -> Action -> Bool
Action -> Action -> Ordering
Action -> Action -> Action
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Action -> Action -> Ordering
compare :: Action -> Action -> Ordering
$c< :: Action -> Action -> Bool
< :: Action -> Action -> Bool
$c<= :: Action -> Action -> Bool
<= :: Action -> Action -> Bool
$c> :: Action -> Action -> Bool
> :: Action -> Action -> Bool
$c>= :: Action -> Action -> Bool
>= :: Action -> Action -> Bool
$cmax :: Action -> Action -> Action
max :: Action -> Action -> Action
$cmin :: Action -> Action -> Action
min :: Action -> Action -> Action
Ord)

newtype Guard = Guard { Guard -> Int
guardId :: Int }
  deriving (Int -> Guard -> ShowS
[Guard] -> ShowS
Guard -> String
(Int -> Guard -> ShowS)
-> (Guard -> String) -> ([Guard] -> ShowS) -> Show Guard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Guard -> ShowS
showsPrec :: Int -> Guard -> ShowS
$cshow :: Guard -> String
show :: Guard -> String
$cshowList :: [Guard] -> ShowS
showList :: [Guard] -> ShowS
Show, ReadPrec [Guard]
ReadPrec Guard
Int -> ReadS Guard
ReadS [Guard]
(Int -> ReadS Guard)
-> ReadS [Guard]
-> ReadPrec Guard
-> ReadPrec [Guard]
-> Read Guard
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Guard
readsPrec :: Int -> ReadS Guard
$creadList :: ReadS [Guard]
readList :: ReadS [Guard]
$creadPrec :: ReadPrec Guard
readPrec :: ReadPrec Guard
$creadListPrec :: ReadPrec [Guard]
readListPrec :: ReadPrec [Guard]
Read, Guard -> Guard -> Bool
(Guard -> Guard -> Bool) -> (Guard -> Guard -> Bool) -> Eq Guard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Guard -> Guard -> Bool
== :: Guard -> Guard -> Bool
$c/= :: Guard -> Guard -> Bool
/= :: Guard -> Guard -> Bool
Eq, Eq Guard
Eq Guard =>
(Guard -> Guard -> Ordering)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Bool)
-> (Guard -> Guard -> Guard)
-> (Guard -> Guard -> Guard)
-> Ord Guard
Guard -> Guard -> Bool
Guard -> Guard -> Ordering
Guard -> Guard -> Guard
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Guard -> Guard -> Ordering
compare :: Guard -> Guard -> Ordering
$c< :: Guard -> Guard -> Bool
< :: Guard -> Guard -> Bool
$c<= :: Guard -> Guard -> Bool
<= :: Guard -> Guard -> Bool
$c> :: Guard -> Guard -> Bool
> :: Guard -> Guard -> Bool
$c>= :: Guard -> Guard -> Bool
>= :: Guard -> Guard -> Bool
$cmax :: Guard -> Guard -> Guard
max :: Guard -> Guard -> Guard
$cmin :: Guard -> Guard -> Guard
min :: Guard -> Guard -> Guard
Ord)

-- | Generate a list of Guard ID and minute pairs for each minute that
-- a particular guard is sleeping.
toSleepMinutes :: [(LocalTime, Action)] -> [(Guard, Int)]
toSleepMinutes :: [(LocalTime, Action)] -> [(Guard, Int)]
toSleepMinutes = [(Guard, LocalTime, LocalTime)] -> [(Guard, Int)]
forall {a}. [(a, LocalTime, LocalTime)] -> [(a, Int)]
expandMinutes ([(Guard, LocalTime, LocalTime)] -> [(Guard, Int)])
-> ([(LocalTime, Action)] -> [(Guard, LocalTime, LocalTime)])
-> [(LocalTime, Action)]
-> [(Guard, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Guard -> [(LocalTime, Action)] -> [(Guard, LocalTime, LocalTime)]
forall {c}. Show c => Guard -> [(c, Action)] -> [(Guard, c, c)]
go (String -> Guard
forall a. HasCallStack => String -> a
error String
"no start")
  where
    -- Transform labeled sleep spans into labeled sleep minutes
    expandMinutes :: [(a, LocalTime, LocalTime)] -> [(a, Int)]
expandMinutes [(a, LocalTime, LocalTime)]
xs =
      [ (a
who, Int
i) | (a
who, LocalTime
t1, LocalTime
t2) <- [(a, LocalTime, LocalTime)]
xs
                 , Int
i <- [LocalTime -> Int
getMinute LocalTime
t1 .. LocalTime -> Int
getMinute LocalTime
t2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

    -- Transform start, sleep, wake entries into labeled sleep spans
    go :: Guard -> [(c, Action)] -> [(Guard, c, c)]
go Guard
_ ((c
_, Start Guard
who) : [(c, Action)]
xs)           = Guard -> [(c, Action)] -> [(Guard, c, c)]
go Guard
who [(c, Action)]
xs
    go Guard
who ((c
t, Action
Sleep) : (c
u, Action
Wake) : [(c, Action)]
xs) = (Guard
who, c
t, c
u) (Guard, c, c) -> [(Guard, c, c)] -> [(Guard, c, c)]
forall a. a -> [a] -> [a]
: Guard -> [(c, Action)] -> [(Guard, c, c)]
go Guard
who [(c, Action)]
xs
    go Guard
_ []                              = []
    go Guard
_ [(c, Action)]
xs                              = String -> [(Guard, c, c)]
forall a. HasCallStack => String -> a
error (String
"toSleepMinutes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(c, Action)] -> String
forall a. Show a => a -> String
show [(c, Action)]
xs)

-- | Extract the minute from a local time.
getMinute :: LocalTime -> Int
getMinute :: LocalTime -> Int
getMinute = TimeOfDay -> Int
todMin (TimeOfDay -> Int) -> (LocalTime -> TimeOfDay) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> TimeOfDay
localTimeOfDay

-- | Given a list of guard/minute pairs, find the product of the number
-- of the sleepiest guard multiplied by the minute that guard is sleepiest.
part1 :: [(Guard, Int)] -> Int
part1 :: [(Guard, Int)] -> Int
part1 [(Guard, Int)]
sleepMins = Guard -> Int
guardId Guard
sleepyWho Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sleepyMin
  where
    sleepyWho :: Guard
sleepyWho = [Guard] -> Guard
forall a. Ord a => [a] -> a
mostCommon [Guard
n | (Guard
n, Int
_) <- [(Guard, Int)]
sleepMins]
    sleepyMin :: Int
sleepyMin = [Int] -> Int
forall a. Ord a => [a] -> a
mostCommon [Int
m | (Guard
n, Int
m) <- [(Guard, Int)]
sleepMins, Guard
n Guard -> Guard -> Bool
forall a. Eq a => a -> a -> Bool
== Guard
sleepyWho]

-- | Give a list of guard/minute pairs, find the product of the
-- guard that sleeps the most in a particular minute and that minute.
part2 :: [(Guard, Int)] -> Int
part2 :: [(Guard, Int)] -> Int
part2 [(Guard, Int)]
sleepMins = Guard -> Int
guardId Guard
who Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minute
  where
    (Guard
who, Int
minute) = [(Guard, Int)] -> (Guard, Int)
forall a. Ord a => [a] -> a
mostCommon [(Guard, Int)]
sleepMins

-- | Find the key associated with the largest value in a 'Map'.
mostCommon :: Ord a => [a] -> a
mostCommon :: forall a. Ord a => [a] -> a
mostCommon = (a, Int) -> a
forall a b. (a, b) -> a
fst ((a, Int) -> a) -> ([a] -> (a, Int)) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Int) -> (a, Int) -> Ordering) -> [(a, Int)] -> (a, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((a, Int) -> Int) -> (a, Int) -> (a, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, Int) -> Int
forall a b. (a, b) -> b
snd) ([(a, Int)] -> (a, Int)) -> ([a] -> [(a, Int)]) -> [a] -> (a, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map a Int -> [(a, Int)])
-> ([a] -> Map a Int) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts