patrickaldis/garnet
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Move code out to separate modules

Browse Source
This commit is contained in:
George Thomas 2025-12-02 15:19:11 +00:00
parent b7c17c2d32
commit f0c2b8ca02
5 changed files with 117 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
haskell/Main.hs
View File

@ -1,22 +1,16 @@
module Main (main) where
import Control.Monad
import Control.Monad.State
import Data.Bifunctor
import Data.ByteString.Lazy qualified as BL
import Data.Functor
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.IO qualified as T
import Data.Void
import Puzzle
import Puzzles.Day1
import Puzzles.Day2
import Test.Tasty
import Test.Tasty.Golden (goldenVsString)
import Test.Tasty.Ingredients.ConsoleReporter
import Text.Megaparsec hiding (Pos)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as Lex
main :: IO ()
main =
@ -41,87 +35,3 @@ main =
zip (map show [1 :: Int ..]) parts <&> \(n, pp) ->
goldenVsString n ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
BL.fromStrict . encodeUtf8 . pp <$> input
data Puzzle = forall input. Puzzle
{ number :: Word
, parser :: Parsec Void Text input
, parts :: [input -> Text]
}
puzzle1 :: Puzzle
puzzle1 =
Puzzle
{ number = 1
, parser = flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> Lex.decimal)
, parts =
[ T.show
. sum
. flip evalState 50
. traverse \(d, i) -> state \p ->
let (_, p') = step i d p
in (Count if p' == 0 then 1 else 0, p')
, T.show
. sum
. flip evalState 50
. traverse \(d, i) -> state \p ->
let (c, p') = step i d p
c' = case d of
R -> abs c
L ->
if
| p == 0 -> abs c - 1
| p' == 0 -> abs c + 1
| otherwise -> abs c
in (c', p')
]
}
data Direction = L | R
deriving (Eq, Ord, Show)
newtype Pos = Pos Int
deriving newtype (Eq, Ord, Show, Num)
newtype Inc = Inc Int
deriving newtype (Eq, Ord, Show, Num)
newtype Count = Count Int
deriving newtype (Eq, Ord, Show, Num)
step :: Inc -> Direction -> Pos -> (Count, Pos)
step (Inc i) d (Pos p) = bimap Count Pos case d of
L -> (p - i) `divMod` 100
R -> (p + i) `divMod` 100
puzzle2 :: Puzzle
puzzle2 =
Puzzle
{ number = 2
, parser = (<* newline) $ flip sepBy (char ',') $ (,) <$> (Lex.decimal <* char '-') <*> Lex.decimal
, parts =
[ T.show
. sum
. concatMap
(mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo)
, T.show
. sum
. concatMap
(mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo)
]
}
newtype ID = ID Int
deriving newtype (Eq, Ord, Show, Num, Enum)
isRepetition2 :: ID -> Bool
isRepetition2 (T.show -> n) = case T.length n `divMod` 2 of
(d, 0) -> equalChunks n d
_ -> False
isRepetitionN :: ID -> Bool
isRepetitionN (T.show -> n) = flip any [1 .. T.length n `div` 2] $ equalChunks n
equalChunks :: Text -> Int -> Bool
equalChunks n i = case T.chunksOf i n of
[] -> True
x : xs -> all (== x) xs

11
haskell/Puzzle.hs Normal file
View File

@ -0,0 +1,11 @@
module Puzzle where
import Data.Text (Text)
import Data.Void
import Text.Megaparsec
data Puzzle = forall input. Puzzle
{ number :: Word
, parser :: Parsec Void Text input
, parts :: [input -> Text]
}

55
haskell/Puzzles/Day1.hs Normal file
View File

@ -0,0 +1,55 @@
module Puzzles.Day1 (puzzle1) where
import Control.Monad.State
import Data.Bifunctor
import Data.Functor
import Data.Text qualified as T
import Puzzle
import Text.Megaparsec hiding (Pos)
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as Lex
puzzle1 :: Puzzle
puzzle1 =
Puzzle
{ number = 1
, parser = flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> Lex.decimal)
, parts =
[ T.show
. sum
. flip evalState 50
. traverse \(d, i) -> state \p ->
let (_, p') = step i d p
in (Count if p' == 0 then 1 else 0, p')
, T.show
. sum
. flip evalState 50
. traverse \(d, i) -> state \p ->
let (c, p') = step i d p
c' = case d of
R -> abs c
L ->
if
| p == 0 -> abs c - 1
| p' == 0 -> abs c + 1
| otherwise -> abs c
in (c', p')
]
}
data Direction = L | R
deriving (Eq, Ord, Show)
newtype Pos = Pos Int
deriving newtype (Eq, Ord, Show, Num)
newtype Inc = Inc Int
deriving newtype (Eq, Ord, Show, Num)
newtype Count = Count Int
deriving newtype (Eq, Ord, Show, Num)
step :: Inc -> Direction -> Pos -> (Count, Pos)
step (Inc i) d (Pos p) = bimap Count Pos case d of
L -> (p - i) `divMod` 100
R -> (p + i) `divMod` 100

44
haskell/Puzzles/Day2.hs Normal file
View File

@ -0,0 +1,44 @@
module Puzzles.Day2 (puzzle2) where
import Control.Monad
import Data.Functor
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import Puzzle
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer qualified as Lex
puzzle2 :: Puzzle
puzzle2 =
Puzzle
{ number = 2
, parser = (<* newline) $ flip sepBy (char ',') $ (,) <$> (Lex.decimal <* char '-') <*> Lex.decimal
, parts =
[ T.show
. sum
. concatMap
(mapMaybe (\n -> guard (isRepetition2 n) $> n) . uncurry enumFromTo)
, T.show
. sum
. concatMap
(mapMaybe (\n -> guard (isRepetitionN n) $> n) . uncurry enumFromTo)
]
}
newtype ID = ID Int
deriving newtype (Eq, Ord, Show, Num, Enum)
isRepetition2 :: ID -> Bool
isRepetition2 (T.show -> n) = case T.length n `divMod` 2 of
(d, 0) -> equalChunks n d
_ -> False
isRepetitionN :: ID -> Bool
isRepetitionN (T.show -> n) = flip any [1 .. T.length n `div` 2] $ equalChunks n
equalChunks :: Text -> Int -> Bool
equalChunks n i = case T.chunksOf i n of
[] -> True
x : xs -> all (== x) xs

4
haskell/aoc.cabal
View File

@ -8,6 +8,10 @@ maintainer: georgefsthomas@gmail.com
executable aoc
main-is: Main.hs
hs-source-dirs: .
other-modules:
Puzzle
Puzzles.Day1
Puzzles.Day2
default-language: GHC2024
default-extensions:
BlockArguments