clean up some code

mstksg · Dec 3, 2024 · 8cd2bce · 8cd2bce
1 parent 1bbc9c1
commit 8cd2bce
Show file tree

Hide file tree

Showing 5 changed files with 19 additions and 12 deletions.
diff --git a/2023/AOC2023/Day08.hs b/2023/AOC2023/Day08.hs
@@ -20,6 +20,7 @@ import AOC.Common.Parser (
   pTok,
   pWord,
   parseMaybe',
+  sequenceSepBy,
   tokenAssoc,
  )
 import AOC.Solver (noFail, (:~>) (..))
@@ -31,6 +32,7 @@ import qualified Data.Map as M
 import Data.Maybe (mapMaybe)
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
+import Linear.V2 (V2 (..))
 import qualified Text.Megaparsec.Char as P
 
 puzzleParse :: CharParser ([Bool], [(String, String, String)])
@@ -40,7 +42,7 @@ puzzleParse = do
   rules <- P.many . fullLine $ do
     x <- pWord
     pTok "="
-    (y, z) <- between' "(" ")" $ (,) <$> pAlphaWord <* "," <*> pAlphaWord
+    V2 y z <- between' "(" ")" $ pure pAlphaWord `sequenceSepBy` ","
     pure (x, y, z)
   pure (ts, rules)
 

diff --git a/2023/AOC2023/Day19.hs b/2023/AOC2023/Day19.hs
@@ -12,7 +12,7 @@ module AOC2023.Day19 (
 )
 where
 
-import AOC.Common (countTrue)
+import AOC.Common (chooseEither, countTrue)
 import AOC.Common.Parser (
   CharParser,
   fullLine,
@@ -85,7 +85,7 @@ workflowParser = do
   key <- manyTillWithout P.anySingle "{"
   workflow <- P.between "{" "}" do
     (wfRules, wfDefault : _) <-
-      partitionEithers <$> sepBy' (Left <$> parseRule <|> Right <$> parseResult) ","
+      partitionEithers <$> sepBy' (parseRule `chooseEither` parseResult) ","
     pure Workflow{..}
   pure (key, workflow)
   where

diff --git a/2024/AOC2024/Day03.hs b/2024/AOC2024/Day03.hs
@@ -12,14 +12,14 @@ module AOC2024.Day03 (
 )
 where
 
-import AOC.Common.Parser (CharParser, pDropUntil, parseMaybe')
+import AOC.Common.Parser (CharParser, pDropUntil, parseMaybe', sequenceSepBy)
 import AOC.Solver (type (:~>) (..))
 import Control.Applicative (Alternative (many))
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Char.Lexer as PL
 
 parseMul :: CharParser Int
-parseMul = product <$> P.between "mul(" ")" (PL.decimal `P.sepBy` ",")
+parseMul = product <$> P.between "mul(" ")" (replicate 2 PL.decimal `sequenceSepBy` ",")
 
 day03a :: String :~> Int
 day03a =

diff --git a/common/AOC/Common.hs b/common/AOC/Common.hs
@@ -19,7 +19,6 @@ module AOC.Common (
   trace',
   traceShowIdMsg,
   traceShowMsg,
-  asString,
 
   -- * Loops and searches
   iterateMaybe,
@@ -107,7 +106,7 @@ module AOC.Common (
   parseBinary,
   caeser,
   eitherItem,
-  -- , getDown
+  chooseEither,
   toNatural,
   factorial,
   integerFactorial,
@@ -119,6 +118,7 @@ module AOC.Common (
   unfoldedIterate,
   memo4,
   LCM (..),
+  asString,
 
   -- * Normal simple line-based
   mapMaybeLines,
@@ -384,8 +384,8 @@ eitherItem :: Lens' (Either a a) a
 eitherItem f (Left x) = Left <$> f x
 eitherItem f (Right x) = Right <$> f x
 
--- getDown :: Down a -> a
--- getDown (Down x) = x
+chooseEither :: Alternative f => f a -> f b -> f (Either a b)
+chooseEither x y = (Left <$> x) <|> (Right <$> y)
 
 splitWord :: Word8 -> (Finite 16, Finite 16)
 splitWord = swap . separateProduct . F.toFinite

diff --git a/common/AOC/Common/Parser.hs b/common/AOC/Common/Parser.hs
@@ -24,6 +24,7 @@ module AOC.Common.Parser (
   sepBy',
   sepByLines,
   sepBy1',
+  sequenceSepBy,
   manyTillWithout,
   someTillWithout,
   pDropUntil,
@@ -58,6 +59,7 @@ import Data.Void
 import GHC.Generics (Generic)
 import qualified Text.Megaparsec as P
 import qualified Text.Megaparsec.Char as P
+import Data.Traversable
 import qualified Text.Megaparsec.Char.Lexer as PL
 
 -- | Use a stream of tokens @a@ as the underlying parser stream.  Note that
@@ -171,9 +173,12 @@ sepByLines = flip sepBy' (P.char '\n')
 sepBy1' :: (P.Stream s, Ord e) => P.Parsec e s a -> P.Parsec e s sep -> P.Parsec e s (NonEmpty a)
 sepBy1' x sep = PNE.sepBy1 (P.notFollowedBy sep *> P.try x) sep
 
--- can we make this work for potentially finite traversals?
--- sequenceSepBy :: (P.Stream s, Ord e) => t (P.Parsec e s a) -> P.Parsec e s sep -> P.Parsec e s (t a)
--- sequenceSepBy xs sep = _
+sequenceSepBy :: (Traversable t, P.Stream s, Ord e) => t (P.Parsec e s a) -> P.Parsec e s sep -> P.Parsec e s (t a)
+sequenceSepBy xs sep = sequenceA . snd $ mapAccumR go False xs
+  where
+    go addSep x = (True, if addSep then x' <* sep else x')
+      where
+        x' = P.notFollowedBy sep *> P.try x
 
 optionalEnd :: (P.Stream s, Ord e) => P.Parsec e s a -> P.Parsec e s end -> P.Parsec e s a
 optionalEnd x end = P.try x <* P.optional (P.try end)