{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Data.Medea.Parser.Primitive
  ( Identifier (..),
    MedeaString (..),
    Natural,
    PrimTypeIdentifier (..),
    ReservedIdentifier (..),
    identFromReserved,
    isReserved,
    isStartIdent,
    parseIdentifier,
    parseKeyVal,
    parseLine,
    parseNatural,
    parseReserved,
    parseString,
    tryPrimType,
  )
where

import Control.Monad (replicateM_, when)
import qualified Data.ByteString as BS
import Data.Char (isControl, isDigit, isSeparator)
import Data.Hashable (Hashable (..))
import Data.Maybe (isJust)
import Data.Medea.JSONType (JSONType (..))
import Data.Medea.Parser.Types (MedeaParser, ParseError (..))
import Data.Text (Text, head, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Text.Megaparsec
  ( customFailure,
    manyTill,
    takeWhile1P,
  )
import Text.Megaparsec.Char (char, eol)
import Text.Megaparsec.Char.Lexer (charLiteral)
import Prelude hiding (head)

-- Identifier
newtype Identifier = Identifier {Identifier -> Text
toText :: Text}
  deriving newtype (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Eq Identifier
Eq Identifier
-> (Identifier -> Identifier -> Ordering)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Identifier)
-> (Identifier -> Identifier -> Identifier)
-> Ord Identifier
Identifier -> Identifier -> Bool
Identifier -> Identifier -> Ordering
Identifier -> Identifier -> Identifier
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Identifier -> Identifier -> Identifier
$cmin :: Identifier -> Identifier -> Identifier
max :: Identifier -> Identifier -> Identifier
$cmax :: Identifier -> Identifier -> Identifier
>= :: Identifier -> Identifier -> Bool
$c>= :: Identifier -> Identifier -> Bool
> :: Identifier -> Identifier -> Bool
$c> :: Identifier -> Identifier -> Bool
<= :: Identifier -> Identifier -> Bool
$c<= :: Identifier -> Identifier -> Bool
< :: Identifier -> Identifier -> Bool
$c< :: Identifier -> Identifier -> Bool
compare :: Identifier -> Identifier -> Ordering
$ccompare :: Identifier -> Identifier -> Ordering
$cp1Ord :: Eq Identifier
Ord, Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show)

parseIdentifier :: MedeaParser Identifier
parseIdentifier :: MedeaParser Identifier
parseIdentifier = do
  Text
ident <- Maybe String
-> (Token Text -> Bool)
-> ParsecT ParseError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"Non-separator") (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSeparatorOrControl)
  (Text -> Identifier) -> Text -> MedeaParser Identifier
forall a. (Text -> a) -> Text -> MedeaParser a
checkedConstruct Text -> Identifier
Identifier Text
ident

data ReservedIdentifier
  = RSchema
  | RStart
  | RType
  | RStringValues
  | RProperties
  | RPropertyName
  | RPropertySchema
  | RAdditionalPropertiesAllowed
  | RAdditionalPropertySchema
  | ROptionalProperty
  | RMinLength
  | RMaxLength
  | RElementType
  | RTuple
  | RArray
  | RBoolean
  | RNull
  | RNumber
  | RObject
  | RString
  deriving stock (ReservedIdentifier -> ReservedIdentifier -> Bool
(ReservedIdentifier -> ReservedIdentifier -> Bool)
-> (ReservedIdentifier -> ReservedIdentifier -> Bool)
-> Eq ReservedIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReservedIdentifier -> ReservedIdentifier -> Bool
$c/= :: ReservedIdentifier -> ReservedIdentifier -> Bool
== :: ReservedIdentifier -> ReservedIdentifier -> Bool
$c== :: ReservedIdentifier -> ReservedIdentifier -> Bool
Eq, Int -> ReservedIdentifier -> ShowS
[ReservedIdentifier] -> ShowS
ReservedIdentifier -> String
(Int -> ReservedIdentifier -> ShowS)
-> (ReservedIdentifier -> String)
-> ([ReservedIdentifier] -> ShowS)
-> Show ReservedIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReservedIdentifier] -> ShowS
$cshowList :: [ReservedIdentifier] -> ShowS
show :: ReservedIdentifier -> String
$cshow :: ReservedIdentifier -> String
showsPrec :: Int -> ReservedIdentifier -> ShowS
$cshowsPrec :: Int -> ReservedIdentifier -> ShowS
Show)

fromReserved :: ReservedIdentifier -> Text
fromReserved :: ReservedIdentifier -> Text
fromReserved ReservedIdentifier
RSchema = Text
"$schema"
fromReserved ReservedIdentifier
RStart = Text
"$start"
fromReserved ReservedIdentifier
RType = Text
"$type"
fromReserved ReservedIdentifier
RStringValues = Text
"$string-values"
fromReserved ReservedIdentifier
RProperties = Text
"$properties"
fromReserved ReservedIdentifier
RPropertyName = Text
"$property-name"
fromReserved ReservedIdentifier
RPropertySchema = Text
"$property-schema"
fromReserved ReservedIdentifier
RAdditionalPropertiesAllowed = Text
"$additional-properties-allowed"
fromReserved ReservedIdentifier
RAdditionalPropertySchema = Text
"$additional-property-schema"
fromReserved ReservedIdentifier
ROptionalProperty = Text
"$optional-property"
fromReserved ReservedIdentifier
RMinLength = Text
"$min-length"
fromReserved ReservedIdentifier
RMaxLength = Text
"$max-length"
fromReserved ReservedIdentifier
RElementType = Text
"$element-type"
fromReserved ReservedIdentifier
RTuple = Text
"$tuple"
fromReserved ReservedIdentifier
RArray = Text
"$array"
fromReserved ReservedIdentifier
RBoolean = Text
"$boolean"
fromReserved ReservedIdentifier
RNull = Text
"$null"
fromReserved ReservedIdentifier
RNumber = Text
"$number"
fromReserved ReservedIdentifier
RObject = Text
"$object"
fromReserved ReservedIdentifier
RString = Text
"$string"

identFromReserved :: ReservedIdentifier -> Identifier
identFromReserved :: ReservedIdentifier -> Identifier
identFromReserved = Text -> Identifier
Identifier (Text -> Identifier)
-> (ReservedIdentifier -> Text) -> ReservedIdentifier -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReservedIdentifier -> Text
fromReserved

tryReserved :: Text -> Maybe ReservedIdentifier
tryReserved :: Text -> Maybe ReservedIdentifier
tryReserved Text
"$schema" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RSchema
tryReserved Text
"$start" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RStart
tryReserved Text
"$type" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RType
tryReserved Text
"$string-values" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RStringValues
tryReserved Text
"$properties" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RProperties
tryReserved Text
"$property-name" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RPropertyName
tryReserved Text
"$property-schema" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RPropertySchema
tryReserved Text
"$additional-properties-allowed" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RAdditionalPropertiesAllowed
tryReserved Text
"$additional-property-schema" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RAdditionalPropertySchema
tryReserved Text
"$optional-property" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
ROptionalProperty
tryReserved Text
"$min-length" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RMinLength
tryReserved Text
"$max-length" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RMaxLength
tryReserved Text
"$element-type" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RElementType
tryReserved Text
"$tuple" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RTuple
tryReserved Text
"$array" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RArray
tryReserved Text
"$boolean" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RBoolean
tryReserved Text
"$null" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RNull
tryReserved Text
"$number" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RNumber
tryReserved Text
"$object" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RObject
tryReserved Text
"$string" = ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RString
tryReserved Text
_ = Maybe ReservedIdentifier
forall a. Maybe a
Nothing

parseReserved :: ReservedIdentifier -> MedeaParser Identifier
parseReserved :: ReservedIdentifier -> MedeaParser Identifier
parseReserved ReservedIdentifier
reserved = do
  Text
ident <- Maybe String
-> (Token Text -> Bool)
-> ParsecT ParseError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSeparatorOrControl)
  let reservedText :: Text
reservedText = ReservedIdentifier -> Text
fromReserved ReservedIdentifier
reserved
  Bool
-> ParsecT ParseError Text Identity ()
-> ParsecT ParseError Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
reservedText) (ParsecT ParseError Text Identity ()
 -> ParsecT ParseError Text Identity ())
-> ParsecT ParseError Text Identity ()
-> ParsecT ParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParseError -> ParsecT ParseError Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (ParseError -> ParsecT ParseError Text Identity ())
-> (Text -> ParseError)
-> Text
-> ParsecT ParseError Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseError
ExpectedReservedIdentifier (Text -> ParsecT ParseError Text Identity ())
-> Text -> ParsecT ParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text
reservedText
  (Text -> Identifier) -> Text -> MedeaParser Identifier
forall a. (Text -> a) -> Text -> MedeaParser a
checkedConstruct Text -> Identifier
Identifier Text
ident

newtype PrimTypeIdentifier = PrimTypeIdentifier {PrimTypeIdentifier -> JSONType
typeOf :: JSONType}
  deriving newtype (PrimTypeIdentifier -> PrimTypeIdentifier -> Bool
(PrimTypeIdentifier -> PrimTypeIdentifier -> Bool)
-> (PrimTypeIdentifier -> PrimTypeIdentifier -> Bool)
-> Eq PrimTypeIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimTypeIdentifier -> PrimTypeIdentifier -> Bool
$c/= :: PrimTypeIdentifier -> PrimTypeIdentifier -> Bool
== :: PrimTypeIdentifier -> PrimTypeIdentifier -> Bool
$c== :: PrimTypeIdentifier -> PrimTypeIdentifier -> Bool
Eq)

tryPrimType :: Identifier -> Maybe PrimTypeIdentifier
tryPrimType :: Identifier -> Maybe PrimTypeIdentifier
tryPrimType (Identifier Text
ident) = Text -> Maybe ReservedIdentifier
tryReserved Text
ident Maybe ReservedIdentifier
-> (ReservedIdentifier -> Maybe PrimTypeIdentifier)
-> Maybe PrimTypeIdentifier
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReservedIdentifier -> Maybe PrimTypeIdentifier
reservedToPrim

reservedToPrim :: ReservedIdentifier -> Maybe PrimTypeIdentifier
reservedToPrim :: ReservedIdentifier -> Maybe PrimTypeIdentifier
reservedToPrim ReservedIdentifier
RNull = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONNull
reservedToPrim ReservedIdentifier
RBoolean = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONBoolean
reservedToPrim ReservedIdentifier
RObject = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONObject
reservedToPrim ReservedIdentifier
RArray = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONArray
reservedToPrim ReservedIdentifier
RNumber = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONNumber
reservedToPrim ReservedIdentifier
RString = PrimTypeIdentifier -> Maybe PrimTypeIdentifier
forall a. a -> Maybe a
Just (PrimTypeIdentifier -> Maybe PrimTypeIdentifier)
-> (JSONType -> PrimTypeIdentifier)
-> JSONType
-> Maybe PrimTypeIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONType -> PrimTypeIdentifier
PrimTypeIdentifier (JSONType -> Maybe PrimTypeIdentifier)
-> JSONType -> Maybe PrimTypeIdentifier
forall a b. (a -> b) -> a -> b
$ JSONType
JSONString
reservedToPrim ReservedIdentifier
_ = Maybe PrimTypeIdentifier
forall a. Maybe a
Nothing

isReserved :: Identifier -> Bool
isReserved :: Identifier -> Bool
isReserved = Maybe ReservedIdentifier -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ReservedIdentifier -> Bool)
-> (Identifier -> Maybe ReservedIdentifier) -> Identifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ReservedIdentifier
tryReserved (Text -> Maybe ReservedIdentifier)
-> (Identifier -> Text) -> Identifier -> Maybe ReservedIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
toText

isStartIdent :: Identifier -> Bool
isStartIdent :: Identifier -> Bool
isStartIdent = (Maybe ReservedIdentifier -> Maybe ReservedIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== ReservedIdentifier -> Maybe ReservedIdentifier
forall a. a -> Maybe a
Just ReservedIdentifier
RStart) (Maybe ReservedIdentifier -> Bool)
-> (Identifier -> Maybe ReservedIdentifier) -> Identifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ReservedIdentifier
tryReserved (Text -> Maybe ReservedIdentifier)
-> (Identifier -> Text) -> Identifier -> Maybe ReservedIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
toText

-- Natural Number
type Natural = Word

parseNatural :: MedeaParser Natural
parseNatural :: MedeaParser Natural
parseNatural = do
  Text
digits <- Maybe String
-> (Token Text -> Bool)
-> ParsecT ParseError Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"digits") Char -> Bool
Token Text -> Bool
isDigit
  Bool
-> ParsecT ParseError Text Identity ()
-> ParsecT ParseError Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Char
head Text
digits Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0')
    (ParsecT ParseError Text Identity ()
 -> ParsecT ParseError Text Identity ())
-> ParsecT ParseError Text Identity ()
-> ParsecT ParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParseError -> ParsecT ParseError Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (ParseError -> ParsecT ParseError Text Identity ())
-> (Text -> ParseError)
-> Text
-> ParsecT ParseError Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseError
LeadingZero
    (Text -> ParsecT ParseError Text Identity ())
-> Text -> ParsecT ParseError Text Identity ()
forall a b. (a -> b) -> a -> b
$ Text
digits
  Natural -> MedeaParser Natural
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Natural -> MedeaParser Natural)
-> (Text -> Natural) -> Text -> MedeaParser Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Natural
forall a. Read a => String -> a
read (String -> Natural) -> (Text -> String) -> Text -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> MedeaParser Natural) -> Text -> MedeaParser Natural
forall a b. (a -> b) -> a -> b
$ Text
digits

-- String
newtype MedeaString = MedeaString {MedeaString -> Text
unwrap :: Text}
  deriving newtype (MedeaString -> MedeaString -> Bool
(MedeaString -> MedeaString -> Bool)
-> (MedeaString -> MedeaString -> Bool) -> Eq MedeaString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MedeaString -> MedeaString -> Bool
$c/= :: MedeaString -> MedeaString -> Bool
== :: MedeaString -> MedeaString -> Bool
$c== :: MedeaString -> MedeaString -> Bool
Eq, Eq MedeaString
Eq MedeaString
-> (MedeaString -> MedeaString -> Ordering)
-> (MedeaString -> MedeaString -> Bool)
-> (MedeaString -> MedeaString -> Bool)
-> (MedeaString -> MedeaString -> Bool)
-> (MedeaString -> MedeaString -> Bool)
-> (MedeaString -> MedeaString -> MedeaString)
-> (MedeaString -> MedeaString -> MedeaString)
-> Ord MedeaString
MedeaString -> MedeaString -> Bool
MedeaString -> MedeaString -> Ordering
MedeaString -> MedeaString -> MedeaString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MedeaString -> MedeaString -> MedeaString
$cmin :: MedeaString -> MedeaString -> MedeaString
max :: MedeaString -> MedeaString -> MedeaString
$cmax :: MedeaString -> MedeaString -> MedeaString
>= :: MedeaString -> MedeaString -> Bool
$c>= :: MedeaString -> MedeaString -> Bool
> :: MedeaString -> MedeaString -> Bool
$c> :: MedeaString -> MedeaString -> Bool
<= :: MedeaString -> MedeaString -> Bool
$c<= :: MedeaString -> MedeaString -> Bool
< :: MedeaString -> MedeaString -> Bool
$c< :: MedeaString -> MedeaString -> Bool
compare :: MedeaString -> MedeaString -> Ordering
$ccompare :: MedeaString -> MedeaString -> Ordering
$cp1Ord :: Eq MedeaString
Ord, Int -> MedeaString -> ShowS
[MedeaString] -> ShowS
MedeaString -> String
(Int -> MedeaString -> ShowS)
-> (MedeaString -> String)
-> ([MedeaString] -> ShowS)
-> Show MedeaString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MedeaString] -> ShowS
$cshowList :: [MedeaString] -> ShowS
show :: MedeaString -> String
$cshow :: MedeaString -> String
showsPrec :: Int -> MedeaString -> ShowS
$cshowsPrec :: Int -> MedeaString -> ShowS
Show, Int -> MedeaString -> Int
MedeaString -> Int
(Int -> MedeaString -> Int)
-> (MedeaString -> Int) -> Hashable MedeaString
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MedeaString -> Int
$chash :: MedeaString -> Int
hashWithSalt :: Int -> MedeaString -> Int
$chashWithSalt :: Int -> MedeaString -> Int
Hashable)

parseString :: MedeaParser MedeaString
parseString :: MedeaParser MedeaString
parseString = do
  String
string <- Token Text -> ParsecT ParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"' ParsecT ParseError Text Identity Char
-> ParsecT ParseError Text Identity String
-> ParsecT ParseError Text Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseError Text Identity Char
-> ParsecT ParseError Text Identity Char
-> ParsecT ParseError Text Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT ParseError Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
charLiteral (Token Text -> ParsecT ParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'"')
  MedeaString -> MedeaParser MedeaString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MedeaString -> MedeaParser MedeaString)
-> (String -> MedeaString) -> String -> MedeaParser MedeaString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MedeaString
MedeaString (Text -> MedeaString) -> (String -> Text) -> String -> MedeaString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> MedeaParser MedeaString)
-> String -> MedeaParser MedeaString
forall a b. (a -> b) -> a -> b
$ String
string

{-# INLINE parseLine #-}
parseLine :: Int -> MedeaParser a -> MedeaParser a
parseLine :: Int -> MedeaParser a -> MedeaParser a
parseLine Int
spaces MedeaParser a
p = Int
-> ParsecT ParseError Text Identity Char
-> ParsecT ParseError Text Identity ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
spaces (Token Text -> ParsecT ParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ') ParsecT ParseError Text Identity ()
-> MedeaParser a -> MedeaParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> MedeaParser a
p MedeaParser a
-> ParsecT ParseError Text Identity Text -> MedeaParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ParseError Text Identity Text
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol

parseKeyVal :: ReservedIdentifier -> MedeaParser a -> MedeaParser a
parseKeyVal :: ReservedIdentifier -> MedeaParser a -> MedeaParser a
parseKeyVal ReservedIdentifier
key = (ReservedIdentifier -> MedeaParser Identifier
parseReserved ReservedIdentifier
key MedeaParser Identifier
-> ParsecT ParseError Text Identity Char
-> ParsecT ParseError Text Identity Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Token Text -> ParsecT ParseError Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' ' ParsecT ParseError Text Identity Char
-> MedeaParser a -> MedeaParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>)

-- Helpers
checkedConstruct ::
  (Text -> a) -> Text -> MedeaParser a
checkedConstruct :: (Text -> a) -> Text -> MedeaParser a
checkedConstruct Text -> a
f Text
t =
  if (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
32) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int) -> (Text -> ByteString) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text
t
    then ParseError -> MedeaParser a
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (ParseError -> MedeaParser a)
-> (Text -> ParseError) -> Text -> MedeaParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParseError
IdentifierTooLong (Text -> MedeaParser a) -> Text -> MedeaParser a
forall a b. (a -> b) -> a -> b
$ Text
t
    else a -> MedeaParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> MedeaParser a) -> (Text -> a) -> Text -> MedeaParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
f (Text -> MedeaParser a) -> Text -> MedeaParser a
forall a b. (a -> b) -> a -> b
$ Text
t

isSeparatorOrControl :: Char -> Bool
isSeparatorOrControl :: Char -> Bool
isSeparatorOrControl Char
c = Char -> Bool
isSeparator Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c