Initial Commit

.gitignore

@@ -0,0 +1 @@
+/dist-newstyle

Y2022.cabal

@@ -0,0 +1,38 @@
+cabal-version:      3.0
+name:               Y2022
+version:            0.1.0.0
+synopsis:           Solutions to Advent of Code 2022
+-- license:            NONE
+author:             ctsk
+maintainer:         bugs@ctsk.xyz
+build-type:         Simple
+
+source-repository head
+    type:           git
+    location:       https://github.com/ctsk/aoc-2022
+
+common warnings
+    ghc-options: -Wall
+
+library
+    default-language: Haskell2010
+    hs-source-dirs:   src
+    exposed-modules:
+        Lib
+        Print
+        Days.D01
+        Parse
+        Util
+    build-depends:
+        base          ^>=4.18.0.0
+      , megaparsec    ^>=9.4.0
+      , text
+
+executable Y2022
+    import:           warnings
+    main-is:          Main.hs
+    build-depends:
+        Y2022
+      , base ^>=4.18.0.0
+    hs-source-dirs:   app
+    default-language: Haskell2010

app/Main.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main where
+
+import Lib
+import Print
+
+import qualified Days.D01 as D01
+import System.Environment (getArgs)
+
+header :: IO ()
+header = putStrLn "[ Day ]------(1)-----+------(2)----"
+
+usage :: IO ()
+usage = putStrLn "./Main"
+
+main :: IO ()
+main =
+    getArgs >>= \case
+        _ -> header >> run D01.day "data/01.in" >>= printDR 1

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)