diff --git a/hs/src/Aoc/Parse.hs b/hs/src/Aoc/Parse.hs index 7307c3b..372ca07 100644 --- a/hs/src/Aoc/Parse.hs +++ b/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 - , untilSpace - , untilEol + , lineWhile + , lineUntil + , 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 -oneSpace = label "whitespace character" $ satisfy isSpace +onLine :: (Char -> Bool) -> Char -> Bool +onLine _ '\n' = False +onLine p c = p c -untilSpace :: Parser T.Text -untilSpace = takeWhileP (Just "non-whitespace character") (not . isSpace) +lineWhile :: (Char -> Bool) -> Parser T.Text +lineWhile = takeWhileP Nothing . onLine -untilEol :: Parser T.Text -untilEol = takeWhileP (Just "non-newline character") (/= '\n') +lineUntil :: (Char -> Bool) -> Parser T.Text +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 diff --git a/hs/src/Aoc/Y2020/D02.hs b/hs/src/Aoc/Y2020/D02.hs index 88fdb7d..05c15f5 100644 --- a/hs/src/Aoc/Y2020/D02.hs +++ b/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 diff --git a/hs/src/Aoc/Y2020/D04.hs b/hs/src/Aoc/Y2020/D04.hs index d512fea..6226f27 100644 --- a/hs/src/Aoc/Y2020/D04.hs +++ b/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 diff --git a/hs/src/Aoc/Y2020/D16.hs b/hs/src/Aoc/Y2020/D16.hs index 8a3fad3..5fed37e 100644 --- a/hs/src/Aoc/Y2020/D16.hs +++ b/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 - fields <- many (fieldLine <* newline) - void $ string "\nyour ticket:\n" - myTicket <- ticket <* newline - void $ string "\nnearby tickets:\n" - nearbyTickets <- many (ticket <* newline) - pure $ Input fields myTicket nearbyTickets +parser = Input + <$> many (field <* newline) + <*> (string "\nyour ticket:\n" *> ticket) + <*> (string "\nnearby tickets:\n" *> many ticket) where - fieldLine = do - name <- takeWhileP Nothing $ \c -> (c /= ':') && (c /= '\n') - void $ string ": " - (a, b) <- (,) <$> (decimal <* string "-") <*> decimal - void $ string " or " - (c, d) <- (,) <$> (decimal <* string "-") <*> decimal + bound = around (string "-") decimal decimal + field = do + name <- lineUntil (==':') <* string ": " + ((a, b), (c, d)) <- around (string " or ") bound bound 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