···2233import AoC.Y2018.Day1 as X
44import AoC.Y2018.Day2 as X
55-import AoC.Y2018.Day3 as X55+import AoC.Y2018.Day3 as X
66+import AoC.Y2018.Day4 as X
+40
src/AoC/Util/Parser.hs
···11+-- | Parsing stuff
22+33+module AoC.Util.Parser where
44+55+import Papa
66+import qualified Text.Megaparsec as P
77+import qualified Text.Megaparsec.Char as P
88+import qualified Text.Megaparsec.Char.Lexer as L
99+import Data.Time.LocalTime (LocalTime)
1010+import Data.Time.Format (parseTimeM, defaultTimeLocale)
1111+1212+type Parser = P.Parsec Void String
1313+1414+sc :: Parser ()
1515+sc = L.space P.space1 P.empty P.empty
1616+1717+lexeme :: Parser a -> Parser a
1818+lexeme = L.lexeme sc
1919+2020+symbol :: String -> Parser String
2121+symbol = L.symbol sc
2222+2323+integer :: Parser Integer
2424+integer = lexeme L.decimal
2525+2626+datetime :: Parser (Maybe LocalTime)
2727+datetime = do
2828+ _ <- P.count 1 $ P.char '['
2929+ y <- L.decimal
3030+ _ <- P.count 1 $ P.char '-'
3131+ m <- L.decimal
3232+ _ <- P.count 1 $ P.char '-'
3333+ d <- L.decimal
3434+ _ <- P.count 1 P.space1
3535+ h <- L.decimal
3636+ _ <- P.count 1 $ P.char ':'
3737+ k <- L.decimal :: Parser Integer
3838+ _ <- P.count 1 $ P.char ']'
3939+ let dt = show y <> "-" <> show m <> "-" <> show d <> " " <> show h <> ":" <> show k
4040+ return $ parseTimeM True defaultTimeLocale "%Y-%-m-%-d %k:%-M" dt
+23
src/AoC/Util/Util.hs
···11+{-# LANGUAGE TupleSections #-}
22+33+module AoC.Util.Util where
44+55+import Papa
66+import Data.Time.LocalTime
77+import qualified Data.Map as M
88+import Data.Time.Calendar
99+1010+minute :: LocalTime -> Integer
1111+minute = fromIntegral . todMin . localTimeOfDay
1212+1313+freq :: [Integer] -> M.Map Integer Integer
1414+freq = M.fromListWith (+) . (<$>) (,1)
1515+1616+bogusTime :: LocalTime
1717+bogusTime = LocalTime (fromGregorian 1500 1 1) midnight
1818+1919+timeSansMaybe :: Maybe LocalTime -> LocalTime
2020+timeSansMaybe = fromMaybe bogusTime
2121+2222+invertMap :: (Ord a , Ord b) => M.Map a b -> M.Map b [a]
2323+invertMap = M.fromListWith (++) . M.foldMapWithKey (\ k a -> [(a, [k])])
+6-22
src/AoC/Y2018/Day3.hs
···66import qualified Data.Text as T (unpack)
77import qualified Data.Text.IO as T (readFile)
88import qualified Data.Map.Strict as C
99-import qualified Control.Monad.Combinators as P
1010-import qualified Text.Megaparsec as P
1111-import qualified Text.Megaparsec.Char as P
1212-import qualified Text.Megaparsec.Char.Lexer as L
99+1010+import AoC.Util.Parser
1111+import qualified Text.Megaparsec as P(someTill,parse,endBy1)
1212+import qualified Text.Megaparsec.Char as P(char,eol)
1313+import qualified Text.Megaparsec.Char.Lexer as L(decimal)
13141415newtype CellID = CellID (Integer,Integer) deriving (Eq, Ord, Show)
1516···2425 } deriving Show
2526makeLenses ''ClaimEntry
26272727--- | Parser stuff
2828-2929-type Parser = P.Parsec Void String
3030-3131-sc :: Parser ()
3232-sc = L.space P.space1 P.empty P.empty
3333-3434-lexeme :: Parser a -> Parser a
3535-lexeme = L.lexeme sc
3636-3737-symbol :: String -> Parser String
3838-symbol = L.symbol sc
3939-4040-integer :: Parser Integer
4141-integer = lexeme L.decimal
4242-4328headPartial :: [Integer] -> Integer
4429headPartial [x] = x
4530headPartial _ = 0
···6550parseClaimsInput :: FilePath -> IO [ClaimEntry]
6651parseClaimsInput f = parseClaimsInput' claimParser . T.unpack <$> T.readFile f
67526868--- | Parser stuff complete
69537054claimLoc :: ClaimEntry -> [(CellID, ClaimID)]
7155claimLoc c = let cs :: [(Integer, Integer)]
···9579 return $
9680 case xs of
9781 [x] -> Just x
9898- _ -> Nothing8282+ _ -> Nothing
+131
src/AoC/Y2018/Day4.hs
···11+{-# LANGUAGE TemplateHaskell #-}
22+33+module AoC.Y2018.Day4 where
44+55+import Prelude (enumFromTo)
66+import Papa
77+import qualified Data.Map.Strict as M
88+import qualified Data.Text.IO as T (readFile)
99+import qualified Data.Text as T (unpack)
1010+import AoC.Util.Parser
1111+import AoC.Util.Util
1212+import Data.Time.LocalTime
1313+import qualified Text.Megaparsec as P
1414+import qualified Text.Megaparsec.Char as P
1515+import qualified Control.Monad.Combinators as PC()
1616+1717+1818+type Guard = Integer
1919+type NapMinutes = [Integer]
2020+type NapDuration = Sum Integer
2121+type NapTimeFreq = [(Integer, [Integer])] -- TODO: maybe an IntMap
2222+2323+type NapEvent = (Guard, NapMinutes, NapDuration) -- TODO: to a datatype
2424+type NapEvent' = (Guard, (NapTimeFreq, NapDuration)) -- TODO: maybe a map
2525+2626+data Record = AtWork Guard LocalTime
2727+ | Awake LocalTime
2828+ | Asleep LocalTime
2929+ deriving (Show)
3030+3131+makePrisms ''Record
3232+3333+dateParser :: Parser (Maybe LocalTime)
3434+dateParser = (lexeme . P.try) datetime
3535+3636+atWorkParser :: Parser Record
3737+atWorkParser = dateParser >>= \t -> do
3838+ symbol "Guard"
3939+ P.char '#'
4040+ i <- integer
4141+ symbol "begins"
4242+ P.string "shift"
4343+ P.eol
4444+ return $ AtWork i (timeSansMaybe t)
4545+4646+awakeParser :: Parser Record
4747+awakeParser = dateParser >>= \t -> do
4848+ symbol "wakes"
4949+ P.string "up"
5050+ P.eol
5151+ return $ Awake (timeSansMaybe t)
5252+5353+asleepParser :: Parser Record
5454+asleepParser = dateParser >>= \t -> do
5555+ symbol "falls"
5656+ P.string "asleep"
5757+ P.eol
5858+ return $ Asleep (timeSansMaybe t)
5959+6060+recParser :: Parser [Record]
6161+recParser = P.some $
6262+ P.try atWorkParser
6363+ <|> P.try asleepParser
6464+ <|> P.try awakeParser
6565+6666+parseRecords' :: FilePath -> IO [Record]
6767+parseRecords' f = g . P.parse recParser "" . T.unpack <$> T.readFile f
6868+ where
6969+ sortFn :: Record -> LocalTime
7070+ sortFn (AtWork _ t) = t
7171+ sortFn (Asleep t) = t
7272+ sortFn (Awake t) = t
7373+ g e = case e of
7474+ Left _ -> []
7575+ Right xs -> sortOn sortFn xs
7676+7777+processRecords :: [Record] -> [NapEvent]
7878+processRecords = foldl' g []
7979+ where
8080+ calcNapMins :: LocalTime -> [Integer] -> [Integer]
8181+ calcNapMins _ [] = []
8282+ calcNapMins t (x : xs) = [x .. (minute t - 1)] ++ xs
8383+8484+ napDuration :: Sum Integer -> [Integer] -> Sum Integer
8585+ napDuration t xs = fromMaybe 0 $ (\a -> subtract a <$> t) <$> firstOf traverse xs
8686+8787+ g :: [NapEvent] -> Record -> [NapEvent]
8888+ g m (AtWork gid _) = (gid, [], mempty) : m
8989+ g m (Asleep t) = m & ix 0 %~ (_2 %~ (minute t :))
9090+ g m (Awake t) = m & ix 0 -- only do the following for the head element, if present
9191+ %~
9292+ (\i ->
9393+ i & _3 -- update 3rd element of the tuple i.e. sum
9494+ <>~ napDuration (pure $ minute t) (i ^. _2))
9595+9696+ . (_2 %~ calcNapMins t) -- update 2nd element of the tuple i.e. array
9797+9898+groupRecords :: [NapEvent] -> [NapEvent']
9999+groupRecords = M.toList
100100+ . M.map
101101+ ( _1 %~
102102+ (M.toDescList
103103+ . invertMap
104104+ . freq)
105105+ )
106106+ . M.fromListWith (\(b,c) (d,e) -> (b ++ d, c + e))
107107+ . over mapped (\(a,b,c) -> (a, (b,c)))
108108+ . toListOf (folded.folded)
109109+ . groupBy ((==) `on` fst)
110110+ . sortBy (comparing fst)
111111+112112+mkResult :: Traversable t => t NapEvent' -> Maybe (Guard, Integer)
113113+mkResult = liftA2 (\ma mb -> do a <- ma; b <- mb; pure (a,b))
114114+ (preview (traverse . _1))
115115+ (preview (traverse . _2 . _1 . ix 0 . _2 . ix 0))
116116+117117+mostAsleep :: [NapEvent'] -> Maybe (Guard, Integer)
118118+mostAsleep = mkResult . sortBy (comparing (Down . snd . snd))
119119+120120+mostFreqAsleep :: [NapEvent'] -> Maybe (Guard, Integer)
121121+mostFreqAsleep = mkResult
122122+ . maximumByOf traverse (compare `on` (\a -> a ^? _2 . _1 . traverse . _1))
123123+124124+puzzleBootStrap :: ([NapEvent'] -> Maybe (Guard, Integer)) -> FilePath -> IO (Maybe Integer)
125125+puzzleBootStrap f p = fmap (uncurry (*)) . f . groupRecords . processRecords <$> parseRecords' p
126126+127127+day4Puzzle1 :: FilePath -> IO (Maybe Integer)
128128+day4Puzzle1 = puzzleBootStrap mostAsleep
129129+130130+day4Puzzle2 :: FilePath -> IO (Maybe Integer)
131131+day4Puzzle2 = puzzleBootStrap mostFreqAsleep