[hs] Clean up parsing a bit

hs/src/Aoc/Parse.hs

@@ -3,10 +3,12 @@ module Aoc.Parse
   , module Text.Megaparsec.Char
   , module Text.Megaparsec.Char.Lexer
   , Parser
+  , around
   , manyLines
-  , oneSpace
+  , lineWhile
-  , untilSpace
+  , lineUntil
-  , untilEol
+  , lineSatisfy
+  , line
   , lineChar
   , word
   , digit
@@ -25,22 +27,37 @@ import           Text.Megaparsec.Char.Lexer (binary, decimal, float,
                                              hexadecimal, octal, scientific,
                                              signed)
 
+-- General combinators
+
+-- | Like 'between', but keeps the outer results instead of the inner result
+around :: Applicative m => m i -> m l -> m r -> m (l, r)
+around inner left right = (,) <$> (left <* inner) <*> right
+
 type Parser = Parsec Void T.Text
 
+-- AoC-specific parsers
+
 manyLines :: Parser a -> Parser [a]
 manyLines p = endBy (try p) newline
 
-oneSpace :: Parser Char
+onLine :: (Char -> Bool) -> Char -> Bool
-oneSpace = label "whitespace character" $ satisfy isSpace
+onLine _ '\n' = False
+onLine p c    = p c
 
-untilSpace :: Parser T.Text
+lineWhile :: (Char -> Bool) -> Parser T.Text
-untilSpace = takeWhileP (Just "non-whitespace character") (not . isSpace)
+lineWhile = takeWhileP Nothing . onLine
 
-untilEol :: Parser T.Text
+lineUntil :: (Char -> Bool) -> Parser T.Text
-untilEol = takeWhileP (Just "non-newline character") (/= '\n')
+lineUntil p = lineWhile (not . p)
+
+lineSatisfy :: (Char -> Bool) -> Parser Char
+lineSatisfy = satisfy . onLine
+
+line :: Parser T.Text
+line = lineWhile (const True)
 
 lineChar :: Parser Char
-lineChar = label "non-newline character" $ satisfy (/= '\n')
+lineChar = lineSatisfy (const True)
 
 word :: Parser T.Text
 word = takeWhileP (Just "alphanumeric character") isAlphaNum

hs/src/Aoc/Y2020/D02.hs

@@ -19,7 +19,7 @@ parser = manyLines $ Line
   <$> (decimal <* char '-')
   <*> (decimal <* space)
   <*> (anySingle <* char ':' <* space)
-  <*> untilEol
+  <*> line
 
 validCount :: Line -> Bool
 validCount l = n >= lMin l && n <= lMax l

hs/src/Aoc/Y2020/D04.hs

@@ -72,10 +72,10 @@ mapFieldsExceptCid f p = [f $ byr p, f $ iyr p, f $ eyr p, f $ hgt p, f $ hcl p,
 
 pField :: T.Text -> Parser a -> Parser (Field a)
 pField name p = do
-  notFollowedBy oneSpace
+  notFollowedBy spaceChar
   void $ string name
   void $ char ':'
-  (Valid <$> try p) <|> (Invalid <$> untilSpace)
+  (Valid <$> try p) <|> (Invalid <$> lineUntil isSpace)
 
 nDigits :: Int -> Parser Int
 nDigits n = do
@@ -115,7 +115,7 @@ pHcl :: Parser Passport
 pHcl = do
   f <- pField "hcl" $ do
     void $ char '#'
-    t <- untilSpace
+    t <- lineUntil isSpace
     guard $ T.length t == 6 && T.all isHexDigit t
     pure t
   pure mempty{hcl = f}
@@ -138,7 +138,7 @@ pCid = do
 parser :: Parser [Passport]
 parser = passport `sepBy` newline
   where
-    passport = mconcat <$> field `endBy1` oneSpace
+    passport = mconcat <$> field `endBy1` spaceChar
     field = pByr <|> pIyr <|> pEyr <|> pHgt <|> pHcl <|> pEcl <|> pPid <|> pCid
 
 hasRequiredKeys :: Passport -> Bool

hs/src/Aoc/Y2020/D16.hs

@@ -4,7 +4,6 @@ module Aoc.Y2020.D16
   ( day
   ) where
 
-import           Control.Monad
 import           Data.Bifunctor
 import           Data.List
 
@@ -16,22 +15,17 @@ import           Aoc.Parse
 data Input = Input [(T.Text, Int -> Bool)] [Int] [[Int]]
 
 parser :: Parser Input
-parser = do
+parser = Input
-  fields <- many (fieldLine <* newline)
+  <$> many (field <* newline)
-  void $ string "\nyour ticket:\n"
+  <*> (string "\nyour ticket:\n" *> ticket)
-  myTicket <- ticket <* newline
+  <*> (string "\nnearby tickets:\n" *> many ticket)
-  void $ string "\nnearby tickets:\n"
-  nearbyTickets <- many (ticket <* newline)
-  pure $ Input fields myTicket nearbyTickets
   where
-    fieldLine = do
+    bound = around (string "-") decimal decimal
-      name <- takeWhileP Nothing $ \c -> (c /= ':') && (c /= '\n')
+    field = do
-      void $ string ": "
+      name <- lineUntil (==':') <* string ": "
-      (a, b) <- (,) <$> (decimal <* string "-") <*> decimal
+      ((a, b), (c, d)) <- around (string " or ") bound bound
-      void $ string " or "
-      (c, d) <- (,) <$> (decimal <* string "-") <*> decimal
       pure (name, \n -> (a <= n && n <= b) || (c <= n && n <= d))
-    ticket = decimal `sepBy` string ","
+    ticket = (decimal `sepBy` string ",") <* newline
 
 anyValid :: [(T.Text, Int -> Bool)] -> Int -> Bool
 anyValid fields n = any (($ n) . snd) fields