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

Move some utilities out of Day4.hs

Browse Source
This commit is contained in:
George Thomas 2026-01-06 22:32:11 +00:00
parent 99de1c4d40
commit 41f0b8d511
2 changed files with 11 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
haskell/Pre.hs
View File

@ -39,6 +39,9 @@ module Pre (
module Text.Megaparsec.Char.Lexer, module Text.Megaparsec.Char.Lexer,
module Text.Pretty.Simple, module Text.Pretty.Simple,
Puzzle (..), Puzzle (..),
(<<$>>),
(<<&>>),
takeUntil,
digit, digit,
digitsToInt, digitsToInt,
listIndex, listIndex,
@ -138,6 +141,14 @@ data Puzzle = forall input outputs. (KnownNat (Length outputs), NFData input) =>
, extraTests :: Bool -> FilePath -> [TestTree IO (input, HList outputs)] , extraTests :: Bool -> FilePath -> [TestTree IO (input, HList outputs)]
} }
(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
(<<$>>) = fmap . fmap
(<<&>>) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b)
(<<&>>) = flip (<<$>>)
takeUntil :: (Foldable t) => (a -> Bool) -> t a -> [a]
takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []
digit :: (Token s ~ Char, Num b, MonadParsec e s f) => f b digit :: (Token s ~ Char, Num b, MonadParsec e s f) => f b
digit = fromIntegral . digitToInt <$> digitChar digit = fromIntegral . digitToInt <$> digitChar

8
haskell/Puzzles/Day4.hs
View File

@ -123,13 +123,5 @@ noneAccessible (Grid g) = not $ any (elem OutAccessible . fmap snd) g
countRolls :: Grid InTile -> Int countRolls :: Grid InTile -> Int
countRolls (Grid g) = length $ concatMap (filter (== InRoll) . toList . fmap snd) g countRolls (Grid g) = length $ concatMap (filter (== InRoll) . toList . fmap snd) g
(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
(<<$>>) = fmap . fmap
(<<&>>) :: (Functor f1, Functor f2) => f1 (f2 a) -> (a -> b) -> f1 (f2 b)
(<<&>>) = flip (<<$>>)
takeUntil :: (Foldable t) => (a -> Bool) -> t a -> [a]
takeUntil p = foldr (\x xs -> x : if p x then [] else xs) []
unfoldMutual :: (a -> b) -> (b -> a) -> a -> Stream (a, b) unfoldMutual :: (a -> b) -> (b -> a) -> a -> Stream (a, b)
unfoldMutual f g a = let b = f a in (a, b) :> unfoldMutual f g (g b) unfoldMutual f g a = let b = f a in (a, b) :> unfoldMutual f g (g b)