module Currycarbon.ParserHelpers where

import qualified Text.Parsec        as P
import qualified Text.Parsec.Error  as P
import qualified Text.Parsec.String as P

-- * High level building blocks

parseRecordType :: String -> P.Parser a -> P.Parser a
parseRecordType :: forall a. String -> Parser a -> Parser a
parseRecordType String
typeName Parser a
parser = do
    String
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
typeName
    forall b. Parser b -> Parser b
parseInParens Parser a
parser

parseNamedVector :: P.Parser a -> P.Parser b -> P.Parser [(a,b)]
parseNamedVector :: forall a b. Parser a -> Parser b -> Parser [(a, b)]
parseNamedVector Parser a
parseKey Parser b
parseValue =
    forall a. Parser a -> Parser [a]
parseVector forall a b. (a -> b) -> a -> b
$ forall a b. Parser a -> Parser b -> Parser (a, b)
parseKeyValuePair Parser a
parseKey Parser b
parseValue

parseVector :: P.Parser a -> P.Parser [a]
parseVector :: forall a. Parser a -> Parser [a]
parseVector Parser a
parser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'c'
    forall b. Parser b -> Parser b
parseInParens (forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
P.sepBy Parser a
parser Parser ()
consumeCommaSep)

parseArgumentWithDefault :: String -> P.Parser b -> b -> P.Parser b
parseArgumentWithDefault :: forall b. String -> Parser b -> b -> Parser b
parseArgumentWithDefault String
argumentName Parser b
parseValue b
defaultValue =
    forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option b
defaultValue (forall a. String -> Parser a -> Parser a
parseArgument String
argumentName Parser b
parseValue)

parseArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b)
parseArgumentOptional :: forall b. String -> Parser b -> Parser (Maybe b)
parseArgumentOptional String
argumentName Parser b
parseValue =
    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (forall a. String -> Parser a -> Parser a
parseArgument String
argumentName Parser b
parseValue)

parseArgument :: String -> P.Parser b -> P.Parser b
parseArgument :: forall a. String -> Parser a -> Parser a
parseArgument String
argumentName Parser b
parseValue = do
    b
res <- forall a. String -> Parser a -> Parser a
parseArgumentWithoutComma String
argumentName Parser b
parseValue
    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
P.optional Parser ()
consumeCommaSep
    forall (m :: * -> *) a. Monad m => a -> m a
return b
res

parseNamedArgumentOptional :: String -> P.Parser b -> P.Parser (Maybe b)
parseNamedArgumentOptional :: forall b. String -> Parser b -> Parser (Maybe b)
parseNamedArgumentOptional String
argumentName Parser b
parseValue =
    forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (forall a. String -> Parser a -> Parser a
parseNamedArgument String
argumentName Parser b
parseValue)

-- * Low level blocks

parseArgumentWithoutComma :: String -> P.Parser b -> P.Parser b
parseArgumentWithoutComma :: forall a. String -> Parser a -> Parser a
parseArgumentWithoutComma String
argumentName Parser b
parseValue =
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (forall a. String -> Parser a -> Parser a
parseNamedArgument String
argumentName Parser b
parseValue) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall b. Parser b -> Parser b
parseUnnamedArgument Parser b
parseValue

parseNamedArgument :: String -> P.Parser b -> P.Parser b
parseNamedArgument :: forall a. String -> Parser a -> Parser a
parseNamedArgument String
argumentName Parser b
parseValue = do
    (String
_,b
b) <- forall a b. Parser a -> Parser b -> Parser (a, b)
parseKeyValuePair (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
P.string String
argumentName) Parser b
parseValue
    forall (m :: * -> *) a. Monad m => a -> m a
return b
b

parseUnnamedArgument :: P.Parser b -> P.Parser b
parseUnnamedArgument :: forall b. Parser b -> Parser b
parseUnnamedArgument Parser b
parseValue = Parser b
parseValue

parseKeyValuePair :: P.Parser a -> P.Parser b -> P.Parser (a,b)
parseKeyValuePair :: forall a b. Parser a -> Parser b -> Parser (a, b)
parseKeyValuePair Parser a
parseKey Parser b
parseValue = do
    a
key <- Parser a
parseKey
    Parser ()
consumeEqualSep
    b
value <- Parser b
parseValue
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
key, b
value)

parseInParens :: P.Parser b -> P.Parser b
parseInParens :: forall b. Parser b -> Parser b
parseInParens Parser b
parser = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'('
    ()
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
    b
res <- Parser b
parser
    ()
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
')'
    forall (m :: * -> *) a. Monad m => a -> m a
return b
res

consumeEqualSep :: P.Parser ()
consumeEqualSep :: Parser ()
consumeEqualSep = do
    Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
    forall (m :: * -> *) a. Monad m => a -> m a
return ()
consumeCommaSep :: P.Parser ()
consumeCommaSep :: Parser ()
consumeCommaSep = do
    Char
_ <- forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

parseCharInSpace :: Char -> P.Parser Char
parseCharInSpace :: Char -> ParsecT String () Identity Char
parseCharInSpace Char
c = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
P.spaces (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
c)

parseAnyString :: P.Parser String
parseAnyString :: Parser String
parseAnyString =
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall {u}. ParsecT String u Identity String
inDoubleQuotes forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall {u}. ParsecT String u Identity String
inSingleQuotes forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> forall {u}. ParsecT String u Identity String
inNoQuotes
    where
        inDoubleQuotes :: ParsecT String u Identity String
inDoubleQuotes = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"') (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar)
        inSingleQuotes :: ParsecT String u Identity String
inSingleQuotes = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\'') (forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'\'') (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar)
        inNoQuotes :: ParsecT String u Identity String
inNoQuotes = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
",):")

-- * Sequence parsers

parseDoubleSequence :: P.Parser [Double]
parseDoubleSequence :: Parser [Double]
parseDoubleSequence = do
    Double
start <- Parser Double
parseDouble
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
":"
    Double
stop <- Parser Double
parseDouble
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
":"
    Double
by <- Parser Double
parsePositiveFloatNumber
    forall (m :: * -> *) a. Monad m => a -> m a
return [Double
start,(Double
startforall a. Num a => a -> a -> a
+Double
by)..Double
stop]

-- * Number parsers

parseDouble :: P.Parser Double
parseDouble :: Parser Double
parseDouble = do
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser Double
parseNegativeFloatNumber forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser Double
parsePositiveFloatNumber

parseNegativeFloatNumber :: P.Parser Double
parseNegativeFloatNumber :: Parser Double
parseNegativeFloatNumber = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"-"
    Double
i <- Parser Double
parsePositiveFloatNumber
    forall (m :: * -> *) a. Monad m => a -> m a
return (-Double
i)

parseFraction :: P.Parser Double
parseFraction :: Parser Double
parseFraction = do
    Double
num <- Parser Double
parsePositiveFloatNumber
    if Double
num forall a. Ord a => a -> a -> Bool
> Double
1
    then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"must be between zero and one"
    else forall (m :: * -> *) a. Monad m => a -> m a
return Double
num

parsePositiveFloatNumber :: P.Parser Double
parsePositiveFloatNumber :: Parser Double
parsePositiveFloatNumber = do
    String
num <- Parser String
parseNumber
    String
optionalMore <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option String
"" forall a b. (a -> b) -> a -> b
$ (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'.' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
parseNumber
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ String
num forall a. [a] -> [a] -> [a]
++ String
optionalMore

parseIntegerSequence :: P.Parser [Int]
parseIntegerSequence :: Parser [Int]
parseIntegerSequence = do
    Int
start <- Parser Int
parseInt
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
":"
    Int
stop <- Parser Int
parseInt
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
":"
    Int
by <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Int
parsePositiveInt
    forall (m :: * -> *) a. Monad m => a -> m a
return [Int
start,(Int
startforall a. Num a => a -> a -> a
+Int
by)..Int
stop]

parseInt :: P.Parser Int
parseInt :: Parser Int
parseInt = do
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try Parser Int
parseNegativeInt forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
P.<|> Parser Int
parsePositiveInt

parseNegativeInt :: P.Parser Int
parseNegativeInt :: Parser Int
parseNegativeInt = do
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"-"
    Int
i <- Parser Int
parsePositiveInt
    forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
i)

parsePositiveInt :: P.Parser Int
parsePositiveInt :: Parser Int
parsePositiveInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word
parseWord

-- https://hackage.haskell.org/package/base-4.19.0.0/docs/Data-Word.html
parseWord :: P.Parser Word
parseWord :: Parser Word
parseWord = do
    forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseNumber

parsePositiveDouble :: P.Parser Double
parsePositiveDouble :: Parser Double
parsePositiveDouble = do
    forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseNumber

parseNumber :: P.Parser [Char]
parseNumber :: Parser String
parseNumber = forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit

-- * Error helpers

showParsecErr :: P.ParseError -> String
showParsecErr :: ParseError -> String
showParsecErr ParseError
err =
    String
-> String -> String -> String -> String -> [Message] -> String
P.showErrorMessages
        String
"or" String
"unknown parse error"
        String
"expecting" String
"unexpected" String
"end of input"
        (ParseError -> [Message]
P.errorMessages ParseError
err)