Day04 part 1

module Day04 (part1, part2) where

import Text.Parsec

import Data.List

import Data.Either

part1 :: [String] -> String

part1 = const "Not implemented"

part1 input = show $ mostAsleepGuard * mostAsleepMinute where

    mostAsleepGuard = longest $ parseSleepPeriods input

    asleepMinutes = asleepPerMinute (lookupList mostAsleepGuard $ parseSleepPeriods input)

    Just mostAsleepMinute = findIndex (\x -> all (<=x) asleepMinutes) asleepMinutes

part2 :: [String] -> String

part2 = const "Not implemented"

part2 input = show $ groupByFst $ parseSleepPeriods input

example1 :: [String]

example1 = [

    "[1518-11-01 00:00] Guard #10 begins shift",

    "[1518-11-01 00:05] falls asleep",

    "[1518-11-01 00:25] wakes up",

    "[1518-11-01 00:30] falls asleep",

    "[1518-11-01 00:55] wakes up",

    "[1518-11-01 23:58] Guard #99 begins shift",

    "[1518-11-02 00:40] falls asleep",

    "[1518-11-02 00:50] wakes up",

    "[1518-11-03 00:05] Guard #10 begins shift",

    "[1518-11-03 00:24] falls asleep",

    "[1518-11-03 00:29] wakes up",

    "[1518-11-04 00:02] Guard #99 begins shift",

    "[1518-11-04 00:36] falls asleep",

    "[1518-11-04 00:46] wakes up",

    "[1518-11-05 00:03] Guard #99 begins shift",

    "[1518-11-05 00:45] falls asleep",

    "[1518-11-05 00:55] wakes up"]

parseSleepPeriods :: [String] -> [(Int, Period)]

parseSleepPeriods = sleepPeriods . sort . rights . map (parse parseRecord "input/day04")

asleepPerMinute :: [Period] -> [Int]

asleepPerMinute [] = replicate 60 0

asleepPerMinute (p:ps) = zipWith (+) (replicate (begin p) 0 ++ replicate (end p - begin p) 1 ++ replicate (60 - end p) 0) (asleepPerMinute ps)

groupByFst :: (Eq a) => [(a,b)] -> [(a,[b])]

groupByFst [] = []

groupByFst complete@((a,b):ls) = (a, lookupList a complete) : groupByFst (filter ((==a) . fst) ls)

lookupList :: (Eq a) => a -> [(a,b)] -> [b]

lookupList _ [] = []

lookupList x ((y1,y2):ys)

    | x == y1 = y2 : lookupList x ys

    | otherwise = lookupList x ys

-- |Extracts the id of the guard who slept the longest.

longest :: [(Int, Period)] -> Int

longest = fst . maxBySnd . totalDurations

maxBySnd :: (Ord b) => [(a,b)] -> (a,b)

maxBySnd [(a,b)] = (a,b)

maxBySnd ((a,b):ls)

    | snd (maxBySnd ls) > b = maxBySnd ls

    | otherwise = (a,b)

totalDurations :: [(Int, Period)] -> [(Int, Int)]

totalDurations [] = []

totalDurations complete@((guardId, period):ips) = (guardId, totalDuration guardId complete) : (totalDurations $ filter ((/=guardId) . fst) ips)

totalDuration :: Int -> [(Int, Period)] -> Int

totalDuration guardId = sum . map duration . map snd . filter ((==guardId) . fst)

duration :: Period -> Int

duration p = end p - begin p

sleepPeriods :: [Record] -> [(Int, Period)]

sleepPeriods [] = []

sleepPeriods ((Record _ _ (BeginsShift guardId)):rs) = sleepPeriodsFor guardId rs where

    sleepPeriodsFor guardId ((Record _ time1 FallsAsleep):(Record _ time2 WakesUp):rs) =

        (guardId, Period (minute time1) (minute time2)) : sleepPeriodsFor guardId rs

    sleepPeriodsFor _ rs@(Record _ _ (BeginsShift _):_) = sleepPeriods rs

    sleepPeriodsFor _ [] = []

-- |A period.

data Period = Period {

    begin :: Int, -- ^The minute the period starts.

    end :: Int  -- ^The minute the period has ended.

} deriving (Show, Eq)

data Record = Record {

    date :: Date,

    time :: Time,

    event :: Event

} deriving (Show, Eq, Ord)

data Date = Date {

    year :: Int,

    month :: Int,

    day :: Int

} deriving (Show, Eq, Ord)

data Time = Time {

    hour :: Int,

    minute :: Int

} deriving (Show, Eq, Ord)

data Event = BeginsShift Int | FallsAsleep | WakesUp deriving (Show, Eq, Ord)

parseDate :: Parsec String () Date

parseDate = do

    year <- count 4 digit

    char '-'

    month <- count 2 digit

    char '-'

    day <- count 2 digit

    return $ Date (read year) (read month) (read day)

parseTime :: Parsec String () Time

parseTime = do

    hour <- count 2 digit

    char ':'

    minute <- count 2 digit

    return $ Time (read hour) (read minute)

parseBeginsShift :: Parsec String () Event

parseBeginsShift = do

    string "Guard #"

    guardId <- many1 digit

    string " begins shift"

    return $ BeginsShift (read guardId)

parseFallsAsleep :: Parsec String () Event

parseFallsAsleep = do

    string "falls asleep"

    return FallsAsleep

parseWakesUp :: Parsec String () Event

parseWakesUp = do

    string "wakes up"

    return WakesUp

parseRecord :: Parsec String () Record

parseRecord = do

    char '['

    date <- parseDate

    char ' '

    time <- parseTime

    string "] "

    event <- parseBeginsShift <|> parseFallsAsleep <|> parseWakesUp <?> "event"

    return $ Record date time event where