module Text.Pandoc.Filter.EmphasizeCode.Parser
( Parser
, ParseError(..)
, parseRanges
, runParser
) where
import Control.Monad.Except
import Data.Text (Text)
import qualified Data.Text as Text
import Text.Read (readMaybe)
import Text.Pandoc.Filter.EmphasizeCode.Position
import Text.Pandoc.Filter.EmphasizeCode.Range
type Parser a = ExceptT ParseError Maybe a
data ParseError
= InvalidRange Position
Position
| InvalidRanges RangesError
| InvalidRangeFormat Text
| InvalidPosition Line
Column
| InvalidPositionFormat Text
| InvalidLineNumber Text
| InvalidColumnNumber Text
deriving (Show, Eq)
parseMaybe :: Read a => Text -> (Text -> ParseError) -> Parser a
parseMaybe t mkError =
case readMaybe (Text.unpack t) of
Just x -> pure x
Nothing -> throwError (mkError t)
split2 :: MonadError e m => Text -> Text -> (Text -> e) -> m (Text, Text)
split2 sep t err =
case Text.splitOn sep t of
[before, after] -> return (before, after)
_ -> throwError (err t)
parsePosition :: Text -> Parser Position
parsePosition t = do
(line, col) <- split2 ":" t InvalidPositionFormat
line' <- Line <$> parseMaybe line InvalidLineNumber
col' <- Column <$> parseMaybe col InvalidColumnNumber
case mkPosition line' col' of
Just position -> pure position
Nothing -> throwError (InvalidPosition line' col')
parseRange :: Text -> Parser Range
parseRange t = do
(startStr, endStr) <- split2 "-" t InvalidRangeFormat
start <- parsePosition startStr
end <- parsePosition endStr
case mkRange start end of
Just range -> pure range
Nothing -> throwError (InvalidRange start end)
parseRanges :: Text -> Parser Ranges
parseRanges t = do
let strs = filter (not . Text.null) (map Text.strip (Text.splitOn "," t))
rs <- mapM parseRange strs
case mkRanges rs of
Left err -> throwError (InvalidRanges err)
Right ranges -> pure ranges
runParser :: Parser a -> Maybe (Either ParseError a)
runParser = runExceptT