Initial Commit

src/Days/D01.hs

@@ -0,0 +1,20 @@
+module Days.D01 where
+
+import Lib (Day, Parser, definitive, parsecDay)
+import Parse (number, someLines)
+
+import Data.List (sortBy)
+
+type Intermediate = [[Int]]
+
+parser :: Parser Intermediate
+parser = someLines (someLines number)
+
+part1 :: Intermediate -> Int
+part1 = maximum . map sum
+
+part2 :: Intermediate -> Int
+part2 = sum . take 3 . sortBy (flip compare) . map sum
+
+day :: Day
+day = parsecDay parser (definitive . part1, definitive . part2)

src/Lib.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Lib where
+
+import Util (both, dupe)
+
+import Data.Function ((&))
+import Data.Text qualified as T
+import Data.Text.IO qualified as T
+import Data.Void (Void)
+import Text.Megaparsec qualified as M (Parsec, eof, errorBundlePretty, parse, sepEndBy1)
+
+data Answer where
+    Answer :: (Show a) => a -> Answer
+
+instance Show Answer where
+    showsPrec p (Answer a) = showsPrec p a
+
+data PuzzleError
+    = MalformedInput String
+    | Unsolvable
+
+type Result = Maybe Answer
+
+definitive :: (Show a) => a -> Result
+definitive = Just . Answer
+
+type DayResult = Either String (Result, Result)
+
+data Day
+    = TextDay (T.Text -> DayResult)
+    | StringDay (String -> DayResult)
+    | ParsecDay (FilePath -> T.Text -> DayResult)
+
+run :: Day -> FilePath -> IO DayResult
+run (TextDay f) = fmap f . T.readFile
+run (StringDay f) = fmap f . readFile
+run (ParsecDay f) = \path -> f path <$> T.readFile path
+
+type Parser = M.Parsec Void T.Text
+
+parsecDay ::
+    Parser a ->
+    (a -> Result, a -> Result) ->
+    Day
+parsecDay parser parts =
+    ParsecDay
+        ( \path text ->
+            ( case M.parse (parser <* M.eof) path text of
+                Left e -> Left $ M.errorBundlePretty e
+                Right parsedInput -> Right $ both (parsedInput &) parts
+            )
+        )

src/Parse.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Parse where
+
+import Lib (Parser)
+
+import Text.Megaparsec qualified as M
+import Text.Megaparsec.Char qualified as MC
+import Text.Megaparsec.Char.Lexer qualified as MCL
+
+someLines :: Parser a -> Parser [a]
+someLines p = p `M.sepEndBy1` MC.newline
+
+number :: Parser Int
+number = MCL.decimal

src/Print.hs

@@ -0,0 +1,12 @@
+module Print where
+
+import Data.Maybe (fromMaybe)
+import Lib (DayResult, PuzzleError (..))
+import Text.Printf (printf)
+
+printDR :: Int -> DayResult -> IO ()
+printDR day (Left errorString) = printf "[  %2d ] ====== PARSER ERROR =======\n%s" day errorString
+printDR day (Right (sol1, sol2)) =
+    let r1 = maybe "unsolved" show sol1
+        r2 = maybe "unsolved" show sol2
+     in printf "[  %2d ] %12s | %12s\n" day r1 r2

src/Util.hs

@@ -0,0 +1,7 @@
+module Util where
+
+dupe :: a -> (a, a)
+dupe a = (a, a)
+
+both :: (a -> b) -> (a, a) -> (b, b)
+both f ~(x, y) = (f x, f y)