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

Minor refactor

Browse Source
This commit is contained in:
George Thomas 2026-01-06 17:39:18 +00:00
parent cd292d4580
commit f213cdb6c3
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
haskell/Main.hs
View File

@ -43,7 +43,7 @@ main =
. runParser (parser isRealData <* eof) fp . runParser (parser isRealData <* eof) fp
=<< T.readFile fp =<< T.readFile fp
let (rs, os) = let (rs, os) =
(lookupHList (fst . getCompose) &&& foldHListF (flip withConstrained HConsC . snd . getCompose) HNilC) $ (lookupHList (fst . getCompose) &&& foldHListF (withConstrained HConsC . snd . getCompose) HNilC) $
mapHListF (\(Compose (Fanout (f, Op o))) -> Compose $ (o &&& id) $ f input) parts mapHListF (\(Compose (Fanout (f, Op o))) -> Compose $ (o &&& id) $ f input) parts
in pure (input, rs, os) in pure (input, rs, os)
) )

8
haskell/Pre.hs
View File

@ -161,10 +161,10 @@ sortPair (a, b) = if a <= b then (a, b) else (b, a)
type PuzzleParts input = HListF (Compose (Fanout ((->) input) (Op Text)) (Constrained NFData)) type PuzzleParts input = HListF (Compose (Fanout ((->) input) (Op Text)) (Constrained NFData))
infixr 9 /\\ infixr 9 /\\
(/\\) :: (NFData output) => (input -> output, output -> Text) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs) (/\\) :: (NFData output) => (input -> output, output -> Text) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs)
(/\\) (f, o) = HConsF $ Compose $ Fanout (Constrained . f, Op $ flip withConstrained o) (/\\) (f, o) = HConsF $ Compose $ Fanout (Constrained . f, Op $ withConstrained o)
infixr 9 /\ infixr 9 /\
(/\) :: (Show output, NFData output) => (input -> output) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs) (/\) :: (Show output, NFData output) => (input -> output) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs)
(/\) f = HConsF $ Compose $ Fanout (Constrained . f, Op $ flip withConstrained T.show) (/\) f = HConsF $ Compose $ Fanout (Constrained . f, Op $ withConstrained T.show)
nil :: PuzzleParts input '[] nil :: PuzzleParts input '[]
nil = HNilF nil = HNilF
@ -211,8 +211,8 @@ lookupHList f = \case
data Constrained c a where data Constrained c a where
Constrained :: (c a) => a -> Constrained c a Constrained :: (c a) => a -> Constrained c a
withConstrained :: Constrained c a -> ((c a) => a -> b) -> b withConstrained :: ((c a) => a -> b) -> Constrained c a -> b
withConstrained (Constrained x) f = f x withConstrained f (Constrained x) = f x
newtype Fanout f g a = Fanout (f a, g a) newtype Fanout f g a = Fanout (f a, g a)