{-# LANGUAGE DefaultSignatures #-}

module Cfg.Parser where

import Control.Error (note)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BL
import Data.Functor (void, ($>))
import Data.Int
import Data.List.NonEmpty (NonEmpty, fromList)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy qualified as TL
import Data.Tree (Tree (..))
import Data.Void (Void)
import Data.Word
import GHC.Generics (Generic)
import Text.Megaparsec (Parsec, anySingle, between, empty, option, parseMaybe, sepBy, sepBy1, some, takeRest, try, (<|>))
import Text.Megaparsec.Char (char, digitChar, space1, string, string')
import Text.Megaparsec.Char.Lexer qualified as L

type Parser = Parsec Void Text

data ConfigParseError
  = UnmatchedFields [Tree Text]
  | MismatchedRootKey Text Text
  | MismatchedKeyAndField Text (Text, Text)
  | MissingKeys [Text]
  | MissingValue Text
  | UnexpectedKeys Text [Tree Text]
  | ValueParseError Text
  deriving (ConfigParseError -> ConfigParseError -> Bool
(ConfigParseError -> ConfigParseError -> Bool)
-> (ConfigParseError -> ConfigParseError -> Bool)
-> Eq ConfigParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigParseError -> ConfigParseError -> Bool
== :: ConfigParseError -> ConfigParseError -> Bool
$c/= :: ConfigParseError -> ConfigParseError -> Bool
/= :: ConfigParseError -> ConfigParseError -> Bool
Eq, Int -> ConfigParseError -> ShowS
[ConfigParseError] -> ShowS
ConfigParseError -> String
(Int -> ConfigParseError -> ShowS)
-> (ConfigParseError -> String)
-> ([ConfigParseError] -> ShowS)
-> Show ConfigParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigParseError -> ShowS
showsPrec :: Int -> ConfigParseError -> ShowS
$cshow :: ConfigParseError -> String
show :: ConfigParseError -> String
$cshowList :: [ConfigParseError] -> ShowS
showList :: [ConfigParseError] -> ShowS
Show, (forall x. ConfigParseError -> Rep ConfigParseError x)
-> (forall x. Rep ConfigParseError x -> ConfigParseError)
-> Generic ConfigParseError
forall x. Rep ConfigParseError x -> ConfigParseError
forall x. ConfigParseError -> Rep ConfigParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfigParseError -> Rep ConfigParseError x
from :: forall x. ConfigParseError -> Rep ConfigParseError x
$cto :: forall x. Rep ConfigParseError x -> ConfigParseError
to :: forall x. Rep ConfigParseError x -> ConfigParseError
Generic)

class RootParser a where
  parseRootConfig :: Tree Text -> Either ConfigParseError a

class NestedParser a where
  parseNestedConfig :: Tree Text -> Either ConfigParseError a
  default parseNestedConfig :: (ValueParser a) => Tree Text -> Either ConfigParseError a
  parseNestedConfig (Node Text
val []) = ConfigParseError -> Maybe a -> Either ConfigParseError a
forall a b. a -> Maybe b -> Either a b
note (Text -> ConfigParseError
ValueParseError Text
val) (Maybe a -> Either ConfigParseError a)
-> Maybe a -> Either ConfigParseError a
forall a b. (a -> b) -> a -> b
$ Parsec Void Text a -> Text -> Maybe a
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text a
forall a. ValueParser a => Parser a
parser Text
val
  parseNestedConfig (Node Text
label [Tree Text]
xs) = ConfigParseError -> Either ConfigParseError a
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError a)
-> ConfigParseError -> Either ConfigParseError a
forall a b. (a -> b) -> a -> b
$ Text -> [Tree Text] -> ConfigParseError
UnexpectedKeys Text
label [Tree Text]
xs

sp :: Parsec Void Text ()
sp :: Parsec Void Text ()
sp = Parsec Void Text ()
-> Parsec Void Text ()
-> Parsec Void Text ()
-> Parsec Void Text ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
L.space Parsec Void Text ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space1 Parsec Void Text ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty Parsec Void Text ()
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty

class ValueParser a where
  parser :: Parser a

-- | @since 0.0.1.0
instance ValueParser () where
  parser :: Parsec Void Text ()
parser = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"()" ParsecT Void Text Identity (Tokens Text)
-> Parsec Void Text () -> Parsec Void Text ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parsec Void Text ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | @since 0.0.1.0
instance NestedParser ()

-- | @since 0.0.1.0
instance ValueParser Bool where
  parser :: Parser Bool
parser = Parser Bool -> Parser Bool
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"true" ParsecT Void Text Identity (Tokens Text)
-> Parser Bool -> Parser Bool
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Parser Bool -> Parser Bool -> Parser Bool
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
"false" ParsecT Void Text Identity (Tokens Text)
-> Parser Bool -> Parser Bool
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)

-- | @since 0.0.1.0
instance NestedParser Bool

-- | @since 0.0.1.0
instance ValueParser Char where
  parser :: Parser Char
parser = Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

-- | @since 0.0.1.0
instance NestedParser Char

-- | @since 0.0.1.0
instance ValueParser TL.Text where
  parser :: Parser Text
parser = Text -> Text
TL.fromStrict (Text -> Text) -> ParsecT Void Text Identity Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest

-- | @since 0.0.1.0
instance NestedParser TL.Text

-- | @since 0.0.1.0
instance ValueParser BL.ByteString where
  parser :: Parser ByteString
parser = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> ParsecT Void Text Identity Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest

-- | @since 0.0.1.0
instance NestedParser BL.ByteString

-- | @since 0.0.1.0
instance ValueParser BS.ByteString where
  parser :: Parser ByteString
parser = Text -> ByteString
encodeUtf8 (Text -> ByteString)
-> ParsecT Void Text Identity Text -> Parser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest

-- | @since 0.0.1.0
instance NestedParser BS.ByteString

-- @since 0.0.1.0
instance ValueParser Text where
  parser :: ParsecT Void Text Identity Text
parser = ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
takeRest

-- | @since 0.0.1.0
instance NestedParser Text

-- | @since 0.0.1.0
instance ValueParser a => ValueParser [a] where
  parser :: Parser [a]
parser = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> Parser [a]
-> Parser [a]
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"[") (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"]") (Parser [a] -> Parser [a]) -> Parser [a] -> Parser [a]
forall a b. (a -> b) -> a -> b
$ forall a. ValueParser a => Parser a
parser @a Parser a -> ParsecT Void Text Identity (Tokens Text) -> Parser [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
",")

-- | @since 0.0.1.0
instance ValueParser a => NestedParser [a]

-- | @since 0.0.1.0
instance ValueParser a => ValueParser (NonEmpty a) where
  parser :: Parser (NonEmpty a)
parser = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> Parser (NonEmpty a)
-> Parser (NonEmpty a)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"[") (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"]") (Parser (NonEmpty a) -> Parser (NonEmpty a))
-> Parser (NonEmpty a) -> Parser (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
fromList ([a] -> NonEmpty a)
-> ParsecT Void Text Identity [a] -> Parser (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueParser a => Parser a
parser @a Parser a
-> ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [a]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy1` (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
",")

-- | @since 0.0.1.0
instance ValueParser a => NestedParser (NonEmpty a)

-- | @since 0.0.1.0
instance ValueParser a => ValueParser (Maybe a) where
  parser :: Parser (Maybe a)
parser =
    (ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Nothing") ParsecT Void Text Identity (Tokens Text)
-> Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe a
forall a. Maybe a
Nothing)
      Parser (Maybe a) -> Parser (Maybe a) -> Parser (Maybe a)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"Just" ParsecT Void Text Identity (Tokens Text)
-> Parser (Maybe a) -> Parser (Maybe a)
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> ParsecT Void Text Identity a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueParser a => Parser a
parser @a))

instance ValueParser a => NestedParser (Maybe a)

-- Numeric Types

rd :: Read a => Text -> a
rd :: forall a. Read a => Text -> a
rd = String -> a
forall a. Read a => String -> a
read (String -> a) -> (Text -> String) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

plus :: Parser Text
plus :: ParsecT Void Text Identity Text
plus = Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' Parser Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Text
number

minus :: Parser Text
minus :: ParsecT Void Text Identity Text
minus = (Char -> Text -> Text)
-> Parser Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b c.
(a -> b -> c)
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity b
-> ParsecT Void Text Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Char -> Text -> Text
T.cons) (Token Text -> ParsecT Void 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 Void Text Identity Text
number

number :: Parser Text
number :: ParsecT Void Text Identity Text
number = String -> Text
T.pack (String -> Text)
-> ParsecT Void Text Identity String
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar

decimal :: Parser Text
decimal :: ParsecT Void Text Identity Text
decimal = Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" (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
$ (Char -> Text -> Text
T.cons) (Char -> Text -> Text)
-> Parser Char -> ParsecT Void Text Identity (Text -> Text)
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)
char Char
Token Text
'.' ParsecT Void Text Identity (Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Text
number

integral :: (Read a) => Parser a
integral :: forall a. Read a => Parser a
integral = Text -> a
forall a. Read a => Text -> a
rd (Text -> a)
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
plus ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text -> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Text
minus ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Text
number)

fractional :: (Read a) => Parser a
fractional :: forall a. Read a => Parser a
fractional = (Text -> a)
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> a
forall a. Read a => Text -> a
rd (ParsecT Void Text Identity Text -> ParsecT Void Text Identity a)
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity a
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall a b c.
(a -> b -> c)
-> ParsecT Void Text Identity a
-> ParsecT Void Text Identity b
-> ParsecT Void Text Identity c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) ParsecT Void Text Identity Text
forall a. Read a => Parser a
integral ParsecT Void Text Identity Text
decimal

-- | @since 0.0.1.0
instance ValueParser Double where
  parser :: Parser Double
parser = Parser Double
forall a. Read a => Parser a
fractional

instance NestedParser Double

-- | @since 0.0.1.0
instance ValueParser Float where
  parser :: Parser Float
parser = Parser Float
forall a. Read a => Parser a
fractional

instance NestedParser Float

-- @since 0.0.1.0
instance ValueParser Int where
  parser :: Parser Int
parser = Parser Int
forall a. Read a => Parser a
integral

instance NestedParser Int

-- | @since 0.0.1.0
instance ValueParser Int8 where
  parser :: Parser Int8
parser = Parser Int8
forall a. Read a => Parser a
integral

instance NestedParser Int8

-- | @since 0.0.1.0
instance ValueParser Int16 where
  parser :: Parser Int16
parser = Parser Int16
forall a. Read a => Parser a
integral

instance NestedParser Int16

-- | @since 0.0.1.0
instance ValueParser Int32 where
  parser :: Parser Int32
parser = Parser Int32
forall a. Read a => Parser a
integral

instance NestedParser Int32

-- | @since 0.0.1.0
instance ValueParser Int64 where
  parser :: Parser Int64
parser = Parser Int64
forall a. Read a => Parser a
integral

instance NestedParser Int64

-- | @since 0.0.1.0
instance ValueParser Integer where
  parser :: Parser Integer
parser = Parser Integer
forall a. Read a => Parser a
integral

instance NestedParser Integer

-- | @since 0.0.1.0
instance ValueParser Word where
  parser :: Parser Word
parser = Text -> Word
forall a. Read a => Text -> a
rd (Text -> Word) -> ParsecT Void Text Identity Text -> Parser Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
number

instance NestedParser Word

-- | @since 0.0.1.0
instance ValueParser Word8 where
  parser :: Parser Word8
parser = Text -> Word8
forall a. Read a => Text -> a
rd (Text -> Word8) -> ParsecT Void Text Identity Text -> Parser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
number

instance NestedParser Word8

-- | @since 0.0.1.0
instance ValueParser Word16 where
  parser :: Parser Word16
parser = Text -> Word16
forall a. Read a => Text -> a
rd (Text -> Word16)
-> ParsecT Void Text Identity Text -> Parser Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
number

instance NestedParser Word16

-- | @since 0.0.1.0
instance ValueParser Word32 where
  parser :: Parser Word32
parser = Text -> Word32
forall a. Read a => Text -> a
rd (Text -> Word32)
-> ParsecT Void Text Identity Text -> Parser Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
number

instance NestedParser Word32

-- | @since 0.0.1.0
instance ValueParser Word64 where
  parser :: Parser Word64
parser = Text -> Word64
forall a. Read a => Text -> a
rd (Text -> Word64)
-> ParsecT Void Text Identity Text -> Parser Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
number

instance NestedParser Word64

-- | @since 0.0.1.0
instance (ValueParser a, ValueParser b) => ValueParser (a, b) where
  parser :: Parser (a, b)
parser = ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity (Tokens Text)
-> Parser (a, b)
-> Parser (a, b)
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
"(") (Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
")") (Parser (a, b) -> Parser (a, b)) -> Parser (a, b) -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ do
    a
a <- forall a. ValueParser a => Parser a
parser @a
    ParsecT Void Text Identity (Tokens Text) -> Parsec Void Text ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity (Tokens Text) -> Parsec Void Text ())
-> ParsecT Void Text Identity (Tokens Text) -> Parsec Void Text ()
forall a b. (a -> b) -> a -> b
$ Parsec Void Text ()
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
L.symbol Parsec Void Text ()
sp Tokens Text
","
    b
b <- forall a. ValueParser a => Parser a
parser @b
    (a, b) -> Parser (a, b)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)

-- | @since 0.0.1.0
instance (ValueParser a, ValueParser b) => NestedParser (a, b)