[hs] Make parsing logic more modular

This commit is contained in:
Joscha 2020-12-18 15:32:24 +00:00
parent 098214e56e
commit ba07bdfadb
2 changed files with 17 additions and 14 deletions

View file

@ -9,11 +9,8 @@ module Aoc.Day
, dayParse
) where
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Text.Megaparsec
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Aoc.Parse
@ -37,15 +34,13 @@ dayPure = DayPure
dayFile :: (FilePath -> IO ()) -> Day
dayFile = DayFile
dayString :: (String -> IO ()) -> Day
dayString f = dayFile $ f <=< readFile
dayString :: (FilePath -> String -> IO ()) -> Day
dayString f = dayFile $ \path -> f path =<< readFile path
dayText :: (T.Text -> IO ()) -> Day
dayText f = dayFile $ f <=< T.readFile
dayText :: (FilePath -> T.Text -> IO ()) -> Day
dayText f = dayFile $ \path -> f path =<< T.readFile path
dayParse :: Parser a -> (a -> IO ()) -> Day
dayParse p f = dayFile $ \path -> do
text <- T.readFile path
case parse (p <* eof) path text of
Right a -> f a
Left e -> putStrLn $ errorBundlePretty e
parseAndSolve path text p f

View file

@ -3,6 +3,7 @@ module Aoc.Parse
, module Text.Megaparsec.Char
, module Text.Megaparsec.Char.Lexer
, Parser
, parseAndSolve
, around
, manyLines
, lineWhile
@ -27,14 +28,21 @@ import Text.Megaparsec.Char.Lexer (binary, decimal, float,
hexadecimal, octal, scientific,
signed)
-- The parser and applying it
type Parser = Parsec Void T.Text
parseAndSolve :: FilePath -> T.Text -> Parser a -> (a -> IO ()) -> IO ()
parseAndSolve path text parser solver = case parse (parser <* eof) path text of
Right a -> solver a
Left e -> putStrLn $ errorBundlePretty e
-- 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]