{-# LANGUAGE OverloadedStrings #-}
module Data.EDN.AST.Parser
( parseText
, parseDoc
, parseTagged
, parseValue
, parseDiscard
, parseNil
, parseBool
, parseNumber
, parseKeyword
, parseSymbol
, parseCollections
, tagChars
, keywordInitialChars
, keywordChars
, symbolInitialChars
, symbolChars
, digitChars
, lowerChars
, upperChars
, miscChars
) where
import Control.Applicative ((<|>))
import Data.Char (chr)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import Data.EDN.AST.Types (Parser, Tagged(..), TaggedValue, Value(..))
import qualified Data.EDN.AST.Lexer as L
import qualified Data.EDN.AST.Types as EDN
parseText
:: String
-> Text
-> Either String TaggedValue
parseText :: String -> Text -> Either String TaggedValue
parseText String
sourceName =
(ParseErrorBundle Text Void -> Either String TaggedValue)
-> (TaggedValue -> Either String TaggedValue)
-> Either (ParseErrorBundle Text Void) TaggedValue
-> Either String TaggedValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String TaggedValue
forall a b. a -> Either a b
Left (String -> Either String TaggedValue)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Either String TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
P.errorBundlePretty) TaggedValue -> Either String TaggedValue
forall a b. b -> Either a b
Right (Either (ParseErrorBundle Text Void) TaggedValue
-> Either String TaggedValue)
-> (Text -> Either (ParseErrorBundle Text Void) TaggedValue)
-> Text
-> Either String TaggedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Parsec Void Text TaggedValue
-> String
-> Text
-> Either (ParseErrorBundle Text Void) TaggedValue
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec Void Text TaggedValue
parseDoc String
sourceName
parseDoc :: Parser TaggedValue
parseDoc :: Parsec Void Text TaggedValue
parseDoc = do
Parser ()
L.dropWS
Parsec Void Text TaggedValue
parseTagged Parsec Void Text TaggedValue
-> Parser () -> Parsec Void Text TaggedValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof
parseTagged :: Parser TaggedValue
parseTagged :: Parsec Void Text TaggedValue
parseTagged = [Parsec Void Text TaggedValue] -> Parsec Void Text TaggedValue
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
[ Parsec Void Text TaggedValue -> Parsec Void Text TaggedValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parsec Void Text TaggedValue
withNS
, Parsec Void Text TaggedValue -> Parsec Void Text TaggedValue
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parsec Void Text TaggedValue
withoutNS
, Parsec Void Text TaggedValue
forall tag. ParsecT Void Text Identity (Tagged tag Value)
withoutTag
]
where
withNS :: Parsec Void Text TaggedValue
withNS = Text -> Text -> Value -> TaggedValue
forall tag a. tag -> tag -> a -> Tagged tag a
Tagged
(Text -> Text -> Value -> TaggedValue)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> Value -> TaggedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
parseIdent)
ParsecT Void Text Identity (Text -> Value -> TaggedValue)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Value -> TaggedValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'/' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
parseIdent)
ParsecT Void Text Identity (Value -> TaggedValue)
-> ParsecT Void Text Identity Value -> Parsec Void Text TaggedValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
L.dropWS Parser ()
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Value
parseValue)
withoutNS :: Parsec Void Text TaggedValue
withoutNS = Text -> Text -> Value -> TaggedValue
forall tag a. tag -> tag -> a -> Tagged tag a
Tagged
(Text -> Text -> Value -> TaggedValue)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Text -> Value -> TaggedValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParsecT Void Text Identity Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
ParsecT Void Text Identity (Text -> Value -> TaggedValue)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Value -> TaggedValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Text
parseIdent)
ParsecT Void Text Identity (Value -> TaggedValue)
-> ParsecT Void Text Identity Value -> Parsec Void Text TaggedValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
L.dropWS Parser ()
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Value
parseValue)
withoutTag :: ParsecT Void Text Identity (Tagged tag Value)
withoutTag = Value -> Tagged tag Value
forall tag a. a -> Tagged tag a
NoTag
(Value -> Tagged tag Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity (Tagged tag Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Value
parseValue
parseIdent :: Parser Text
parseIdent :: ParsecT Void Text Identity Text
parseIdent =
Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"tag") (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
tagChars)
parseValue :: Parser Value
parseValue :: ParsecT Void Text Identity Value
parseValue = do
Parser () -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany Parser ()
parseDiscard
[ParsecT Void Text Identity Value]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
[ ParsecT Void Text Identity Value
parseNil
, ParsecT Void Text Identity Value
parseBool
, ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity Value
parseNumber
, ParsecT Void Text Identity Value
parseSymbol
, ParsecT Void Text Identity Value
parseCharacter
, ParsecT Void Text Identity Value
parseString
, ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity Value
parseKeyword
, ParsecT Void Text Identity Value
parseCollections
]
parseDiscard :: Parser ()
parseDiscard :: Parser ()
parseDiscard = do
Text
_ <- ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b. (a -> b) -> a -> b
$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"#_"
() () -> ParsecT Void Text Identity Value -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Value
parseValue
parseCollections :: Parser Value
parseCollections :: ParsecT Void Text Identity Value
parseCollections = ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a. Parser a -> Parser a
L.lexeme (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$ do
Char
start <- [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
P.oneOf [Char
'#', Char
'{', Char
'[', Char
'(']
case Char
start of
Char
'#' -> do
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'{'
[TaggedValue] -> Value
forall (f :: * -> *). Foldable f => f TaggedValue -> Value
EDN.mkSet ([TaggedValue] -> Value)
-> ParsecT Void Text Identity [TaggedValue]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> Parsec Void Text TaggedValue
-> ParsecT Void Text Identity [TaggedValue]
forall a.
Char
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
parseItemsTill Char
'}' Parsec Void Text TaggedValue
parseTagged
Char
'{' -> do
let pairs :: ParsecT Void Text Identity (TaggedValue, TaggedValue)
pairs = (,) (TaggedValue -> TaggedValue -> (TaggedValue, TaggedValue))
-> Parsec Void Text TaggedValue
-> ParsecT
Void Text Identity (TaggedValue -> (TaggedValue, TaggedValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text TaggedValue
parseTagged ParsecT
Void Text Identity (TaggedValue -> (TaggedValue, TaggedValue))
-> Parsec Void Text TaggedValue
-> ParsecT Void Text Identity (TaggedValue, TaggedValue)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text TaggedValue
parseTagged
[(TaggedValue, TaggedValue)] -> Value
forall (f :: * -> *).
Foldable f =>
f (TaggedValue, TaggedValue) -> Value
EDN.mkMap ([(TaggedValue, TaggedValue)] -> Value)
-> ParsecT Void Text Identity [(TaggedValue, TaggedValue)]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> ParsecT Void Text Identity (TaggedValue, TaggedValue)
-> ParsecT Void Text Identity [(TaggedValue, TaggedValue)]
forall a.
Char
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
parseItemsTill Char
'}' ParsecT Void Text Identity (TaggedValue, TaggedValue)
pairs
Char
'[' ->
[TaggedValue] -> Value
forall (f :: * -> *). Foldable f => f TaggedValue -> Value
EDN.mkVec ([TaggedValue] -> Value)
-> ParsecT Void Text Identity [TaggedValue]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> Parsec Void Text TaggedValue
-> ParsecT Void Text Identity [TaggedValue]
forall a.
Char
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
parseItemsTill Char
']' Parsec Void Text TaggedValue
parseTagged
Char
'(' ->
[TaggedValue] -> Value
forall (f :: * -> *). Foldable f => f TaggedValue -> Value
EDN.mkList ([TaggedValue] -> Value)
-> ParsecT Void Text Identity [TaggedValue]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char
-> Parsec Void Text TaggedValue
-> ParsecT Void Text Identity [TaggedValue]
forall a.
Char
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
parseItemsTill Char
')' Parsec Void Text TaggedValue
parseTagged
Char
_ ->
String -> ParsecT Void Text Identity Value
forall a. HasCallStack => String -> a
error String
"assert: start is one of the collection openers"
where
parseItemsTill :: Char
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity [a]
parseItemsTill Char
end ParsecT Void Text Identity a
p = do
Parser ()
L.dropWS
ParsecT Void Text Identity a
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill (Parser ()
L.dropWS Parser ()
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity a
p) (Parser ()
L.dropWS Parser ()
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
end)
parseNil :: Parser Value
parseNil :: ParsecT Void Text Identity Value
parseNil = Value
Nil Value
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"nil"
parseBool :: Parser Value
parseBool :: ParsecT Void Text Identity Value
parseBool = [ParsecT Void Text Identity Value]
-> ParsecT Void Text Identity Value
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
[ Bool -> Value
Boolean Bool
True Value
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"true"
, Bool -> Value
Boolean Bool
False Value
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"false"
]
parseSymbol :: Parser Value
parseSymbol :: ParsecT Void Text Identity Value
parseSymbol = String
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"symbol" (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a. Parser a -> Parser a
L.lexeme (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$ do
Either Char Char
initial <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Either Char Char)
forall (m :: * -> *) a b.
Alternative m =>
m a -> m b -> m (Either a b)
P.eitherP (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'/') ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
P.oneOf String
[Token Text]
symbolInitialChars)
(Text
ns, Text
name) <- case Either Char Char
initial of
Left Char
_slash ->
(Text, Text) -> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", Text
"/")
Right Char
char ->
ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Char -> ParsecT Void Text Identity (Text, Text)
withNS Char
char) ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
-> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Void Text Identity (Text, Text)
withoutNS Char
char
Value -> ParsecT Void Text Identity Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ParsecT Void Text Identity Value)
-> Value -> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Value
Symbol Text
ns Text
name
where
withNS :: Char -> Parser (Text, Text)
withNS :: Char -> ParsecT Void Text Identity (Text, Text)
withNS Char
nsInitial = do
Text
ns <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"symbol namespace") (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
symbolChars)
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'/'
Char
nameInitial <- [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
P.oneOf String
[Token Text]
symbolInitialChars
Text
name <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"symbol name") (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
symbolChars)
(Text, Text) -> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Text -> Text
Text.cons Char
nsInitial Text
ns, Char -> Text -> Text
Text.cons Char
nameInitial Text
name)
withoutNS :: Char -> Parser (Text, Text)
withoutNS :: Char -> ParsecT Void Text Identity (Text, Text)
withoutNS Char
nameInitial = do
Text
name <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just String
"symbol name") (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
symbolChars)
(Text, Text) -> ParsecT Void Text Identity (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"", Char -> Text -> Text
Text.cons Char
nameInitial Text
name)
parseCharacter :: Parser Value
parseCharacter :: ParsecT Void Text Identity Value
parseCharacter = do
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'\\'
(Char -> Value)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Value
Character (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity Char
unicode ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
named ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a. Parser a -> Parser a
L.lexeme ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
P.printChar)
where
unicode :: ParsecT Void Text Identity Char
unicode = String
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"hex-encoded unicode character" (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ do
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'u'
(Int -> Char)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
chr ParsecT Void Text Identity Int
L.hexadecimal
named :: ParsecT Void Text Identity Char
named = String
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"whitespace character name" (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ [ParsecT Void Text Identity Char]
-> ParsecT Void Text Identity Char
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
[ Char
'\n' Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"newline"
, Char
'\r' Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"return"
, Char
' ' Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"space"
, Char
'\t' Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParsecT Void Text Identity Text
L.symbol Text
"tab"
]
parseString :: Parser Value
parseString :: ParsecT Void Text Identity Value
parseString = ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a. Parser a -> Parser a
L.lexeme (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$
ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"') (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$
Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Value)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (ParsecT Void Text Identity Char
escaped ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
plain)
where
escaped :: Parser Char
escaped :: ParsecT Void Text Identity Char
escaped = do
Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'\\'
Char
c <- ParsecT Void Text Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle
Char -> ParsecT Void Text Identity Char
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> ParsecT Void Text Identity Char)
-> Char -> ParsecT Void Text Identity Char
forall a b. (a -> b) -> a -> b
$ case Char
c of
Char
'n' -> Char
'\n'
Char
't' -> Char
'\t'
Char
'r' -> Char
'\r'
Char
_ -> Char
c
plain :: ParsecT Void Text Identity (Token Text)
plain = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.anySingleBut Char
Token Text
'"'
parseNumber :: Parser Value
parseNumber :: ParsecT Void Text Identity Value
parseNumber = ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try ParsecT Void Text Identity Value
parseFloating ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Value
parseInteger
where
parseFloating :: ParsecT Void Text Identity Value
parseFloating = Double -> Value
Floating (Double -> Value)
-> ParsecT Void Text Identity Double
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Double
L.floating
parseInteger :: ParsecT Void Text Identity Value
parseInteger = Int -> Value
Integer (Int -> Value)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Int
L.integer
parseKeyword :: Parser Value
parseKeyword :: ParsecT Void Text Identity Value
parseKeyword = String
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"keyword" (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a. Parser a -> Parser a
L.lexeme (ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value)
-> ParsecT Void Text Identity Value
-> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$ do
Char
c <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
':' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
keywordInitialChars)
Text
cs <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP Maybe String
forall a. Maybe a
Nothing (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
keywordChars)
Value -> ParsecT Void Text Identity Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ParsecT Void Text Identity Value)
-> Value -> ParsecT Void Text Identity Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Keyword (Char -> Text -> Text
Text.cons Char
c Text
cs)
tagChars :: [Char]
tagChars :: String
tagChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
lowerChars
, String
upperChars
, String
digitChars
, String
"-"
]
keywordInitialChars :: [Char]
keywordInitialChars :: String
keywordInitialChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
lowerChars
, String
upperChars
, String
miscChars
]
keywordChars :: [Char]
keywordChars :: String
keywordChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
keywordInitialChars
, String
digitChars
, String
"/#:"
]
symbolInitialChars :: [Char]
symbolInitialChars :: String
symbolInitialChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
lowerChars
, String
upperChars
, String
miscChars
]
symbolChars :: [Char]
symbolChars :: String
symbolChars = [String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
symbolInitialChars
, String
digitChars
, String
"#:"
]
digitChars :: [Char]
digitChars :: String
digitChars = [Char
'0' .. Char
'9']
upperChars :: [Char]
upperChars :: String
upperChars = [Char
'A' .. Char
'Z']
lowerChars :: [Char]
lowerChars :: String
lowerChars = [Char
'a' .. Char
'z']
miscChars :: [Char]
miscChars :: String
miscChars = String
".*<>!?$%&=+_-"