Move code out to separate modules
This commit is contained in:
parent
b7c17c2d32
commit
f0c2b8ca02
@ -1,22 +1,16 @@
|
|||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Control.Monad
|
|
||||||
import Control.Monad.State
|
|
||||||
import Data.Bifunctor
|
|
||||||
import Data.ByteString.Lazy qualified as BL
|
import Data.ByteString.Lazy qualified as BL
|
||||||
import Data.Functor
|
import Data.Functor
|
||||||
import Data.Maybe
|
|
||||||
import Data.Text (Text)
|
|
||||||
import Data.Text qualified as T
|
|
||||||
import Data.Text.Encoding (encodeUtf8)
|
import Data.Text.Encoding (encodeUtf8)
|
||||||
import Data.Text.IO qualified as T
|
import Data.Text.IO qualified as T
|
||||||
import Data.Void
|
import Puzzle
|
||||||
|
import Puzzles.Day1
|
||||||
|
import Puzzles.Day2
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.Golden (goldenVsString)
|
import Test.Tasty.Golden (goldenVsString)
|
||||||
import Test.Tasty.Ingredients.ConsoleReporter
|
import Test.Tasty.Ingredients.ConsoleReporter
|
||||||
import Text.Megaparsec hiding (Pos)
|
import Text.Megaparsec hiding (Pos)
|
||||||
import Text.Megaparsec.Char
|
|
||||||
import Text.Megaparsec.Char.Lexer qualified as Lex
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main =
|
main =
|
||||||
@ -41,87 +35,3 @@ main =
|
|||||||
zip (map show [1 :: Int ..]) parts <&> \(n, pp) ->
|
zip (map show [1 :: Int ..]) parts <&> \(n, pp) ->
|
||||||
goldenVsString n ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
|
goldenVsString n ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
|
||||||
BL.fromStrict . encodeUtf8 . pp <$> input
|
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
11
haskell/Puzzle.hs
Normal 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
55
haskell/Puzzles/Day1.hs
Normal 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
44
haskell/Puzzles/Day2.hs
Normal 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
|
||||||
@ -8,6 +8,10 @@ maintainer: georgefsthomas@gmail.com
|
|||||||
executable aoc
|
executable aoc
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
hs-source-dirs: .
|
hs-source-dirs: .
|
||||||
|
other-modules:
|
||||||
|
Puzzle
|
||||||
|
Puzzles.Day1
|
||||||
|
Puzzles.Day2
|
||||||
default-language: GHC2024
|
default-language: GHC2024
|
||||||
default-extensions:
|
default-extensions:
|
||||||
BlockArguments
|
BlockArguments
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user