{-# LANGUAGE DefaultSignatures #-}

-- |
--  Module      : Cfg.Parser
--  Copyright   : © Jonathan Lorimer, 2023
--  License     : MIT
--  Maintainer  : jonathanlorimer@pm.me
--  Stability   : stable
--
-- @since 0.0.2.0
--
-- This module contains the type classes for parsing a configuration type from
-- a source, as well as instances for most basic Haskell types. One important
-- interaction to note is that we use a default instance for 'ConfigParser'
-- that dispatches to a 'ValueParser' instances. This is how we distinguish
-- between a \"parser\" that just navigates the tree representation of our
-- configuration and a parser that actually converts from text to our Haskell
-- type.
module Cfg.Parser
  ( -- * Parser Typeclasses
    ConfigParser (..)
  , ValueParser (..)

    -- * Parser Types
  , Parser
  , ConfigParseError (..)
  )
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.Map.Strict qualified as M
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Lazy qualified as TL
import Data.Void (Void)
import Data.Word
import GHC.Generics (Generic)
import KeyTree
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 alias for our megaparsec parser
--
-- @since 0.0.1.0
type Parser = Parsec Void Text

-- | Type errors we can encounter when parsing
--
-- @since 0.0.2.0
data ConfigParseError
  = -- | We encountered a 'Data.Map.Map' that was missing a key.
    MissingKey
      Text
      -- ^ The record field name that was missing.
      (KeyTree Text Text)
      -- ^ The subtree that was missing an entry.
  | -- | Expected to find a subtree aka a 'Free' with a map in it, but instead
    -- we found a 'Pure'.
    ExpectedKeyFoundValue
      Text
      -- ^ The key that was missing
      Text
      -- ^ The value that was found
  | -- | Expected to find a 'Pure' with a value but instead found a subtree
    ExpectedValueFoundForest
      (KeyTree Text Text)
      -- ^ The subtree that was found instead
  | -- | Ran a 'parser' and was unable to parse value
    ValueParseError
      Text
      -- ^ The parser error
  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)

-- | This is the instance that allows us to parse a result from our
-- configuration source after we have retrieved it.
--
-- @since 0.0.2.0
class ConfigParser a where
  -- | Takes in the tree representation of our configuration and parses out our Haskell type
  --
  --  The default instance allows us to wrap a 'ValueParser' in a
  --  'ConfigParser', this allows us to use a uniform typeclass for parsing,
  --  but at the same time distinguish between traversing the key structure and
  --  actually parsing the textual value.
  parseConfig :: KeyTree Text Text -> Either ConfigParseError a
  default parseConfig :: (ValueParser a) => KeyTree Text Text -> Either ConfigParseError a
  parseConfig (Pure 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
  parseConfig KeyTree Text Text
kt = 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
$ KeyTree Text Text -> ConfigParseError
ExpectedValueFoundForest KeyTree Text Text
kt

-- | This is a text parser that we use to parse the eventual values we get from a
-- configuration.
--
-- @since 0.0.2.0
class ValueParser a where
  parser :: Parser a

-- | Lexer parser helper.
--
-- @since 0.0.2.0
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

-- | @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 ConfigParser ()

-- | @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 ConfigParser 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 ConfigParser 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 ConfigParser TL.Text

-- | @since 0.0.1.0
instance ValueParser BL.ByteString where
  parser :: Parser ByteString
parser = StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> ByteString)
-> (Text -> StrictByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
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 ConfigParser BL.ByteString

-- | @since 0.0.1.0
instance ValueParser BS.ByteString where
  parser :: Parser StrictByteString
parser = Text -> StrictByteString
encodeUtf8 (Text -> StrictByteString)
-> ParsecT Void Text Identity Text -> Parser StrictByteString
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 ConfigParser 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 ConfigParser 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) => ConfigParser [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) => ConfigParser (NonEmpty a)

-- | @since 0.0.1.0
instance (ValueParser a) => ConfigParser (Maybe a) where
  parseConfig :: KeyTree Text Text -> Either ConfigParseError (Maybe a)
parseConfig (Free Map Text (KeyTree Text Text)
m) =
    if Map Text (KeyTree Text Text)
m Map Text (KeyTree Text Text)
-> Map Text (KeyTree Text Text) -> Bool
forall a. Eq a => a -> a -> Bool
== Map Text (KeyTree Text Text)
forall k a. Map k a
M.empty
      then Maybe a -> Either ConfigParseError (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
      else ConfigParseError -> Either ConfigParseError (Maybe a)
forall a b. a -> Either a b
Left (ConfigParseError -> Either ConfigParseError (Maybe a))
-> ConfigParseError -> Either ConfigParseError (Maybe a)
forall a b. (a -> b) -> a -> b
$ KeyTree Text Text -> ConfigParseError
ExpectedValueFoundForest (Map Text (KeyTree Text Text) -> KeyTree Text Text
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free Map Text (KeyTree Text Text)
m)
  parseConfig (Pure Text
v) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Either ConfigParseError a -> Either ConfigParseError (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConfigParseError -> Maybe a -> Either ConfigParseError a
forall a b. a -> Maybe b -> Either a b
note (Text -> ConfigParseError
ValueParseError Text
v) (Parsec Void Text a -> Text -> Maybe a
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe (forall a. ValueParser a => Parser a
parser @a) Text
v)

-- Numeric parser helpers

-- | @since 0.0.2.0
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

-- | @since 0.0.2.0
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

-- | @since 0.0.2.0
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

-- | @since 0.0.2.0
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

-- | @since 0.0.2.0
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

-- | @since 0.0.2.0
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)

-- | @since 0.0.2.0
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

-- | @since 0.0.1.0
instance ConfigParser Double

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

-- | @since 0.0.1.0
instance ConfigParser Float

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

-- | @since 0.0.1.0
instance ConfigParser Int

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

-- | @since 0.0.1.0
instance ConfigParser Int8

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

-- | @since 0.0.1.0
instance ConfigParser Int16

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

-- | @since 0.0.1.0
instance ConfigParser Int32

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

-- | @since 0.0.1.0
instance ConfigParser Int64

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

-- | @since 0.0.1.0
instance ConfigParser 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

-- | @since 0.0.1.0
instance ConfigParser 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

-- | @since 0.0.1.0
instance ConfigParser 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

-- | @since 0.0.1.0
instance ConfigParser 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

-- | @since 0.0.1.0
instance ConfigParser 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

-- | @since 0.0.1.0
instance ConfigParser 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) => ConfigParser (a, b)