{-# LANGUAGE CPP                   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

{-| This module contains Dhall's parser combinators
-}

module Dhall.Parser.Combinators
    ( Parser(..)
    , SourcedException(..)
    , laxSrcEq
    , count
    , range
    , option
    , star
    , plus
    , satisfy
    , Dhall.Parser.Combinators.takeWhile
    , takeWhile1
    , toMap
    , toMapWith
    , base
    ) where


import Control.Applicative     (Alternative (..), liftA2)
import Control.Exception       (Exception)
import Control.Monad           (MonadPlus (..))
import Data.String             (IsString (..))
import Data.Text               (Text)
import Data.Void               (Void)
import Dhall.Map               (Map)
import Dhall.Src               (Src (..))
import Prettyprinter           (Pretty (..))
import Text.Parser.Combinators (try, (<?>))
import Text.Parser.Token       (TokenParsing (..))

import qualified Control.Monad.Fail
import qualified Data.Char                   as Char
import qualified Data.Text
import qualified Dhall.Map
import qualified Dhall.Pretty
import qualified Prettyprinter.Render.String as Pretty
import qualified Text.Megaparsec
import qualified Text.Megaparsec.Char
import qualified Text.Parser.Char
import qualified Text.Parser.Combinators
import qualified Text.Parser.Token.Style

-- | An exception annotated with a `Src` span
data SourcedException e = SourcedException Src e

instance Exception e => Exception (SourcedException e)

instance Show e => Show (SourcedException e) where
    show :: SourcedException e -> String
show (SourcedException Src
source e
exception) =
            forall a. Show a => a -> String
show e
exception
        forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        forall a. Semigroup a => a -> a -> a
<>  forall ann. SimpleDocStream ann -> String
Pretty.renderString
                (forall ann. Doc ann -> SimpleDocStream ann
Dhall.Pretty.layout (forall a ann. Pretty a => a -> Doc ann
pretty Src
source))

-- | Doesn't force the 'Data.Text.Text' part
laxSrcEq :: Src -> Src -> Bool
laxSrcEq :: Src -> Src -> Bool
laxSrcEq (Src SourcePos
p SourcePos
q Text
_) (Src SourcePos
p' SourcePos
q' Text
_) = SourcePos -> SourcePos -> Bool
eq SourcePos
p SourcePos
p' Bool -> Bool -> Bool
&& SourcePos -> SourcePos -> Bool
eq SourcePos
q SourcePos
q'
  where
    -- Don't compare filename (which is FilePath = String)
    eq  :: Text.Megaparsec.SourcePos -> Text.Megaparsec.SourcePos -> Bool
    eq :: SourcePos -> SourcePos -> Bool
eq (Text.Megaparsec.SourcePos String
_ Pos
a Pos
b) (Text.Megaparsec.SourcePos String
_ Pos
a' Pos
b') =
        Pos
a forall a. Eq a => a -> a -> Bool
== Pos
a' Bool -> Bool -> Bool
&& Pos
b forall a. Eq a => a -> a -> Bool
== Pos
b'
{-# INLINE laxSrcEq #-}

{-| A `Parser` that is almost identical to
    @"Text.Megaparsec".`Text.Megaparsec.Parsec`@ except treating Haskell-style
    comments as whitespace
-}
newtype Parser a = Parser { forall a. Parser a -> Parsec Void Text a
unParser :: Text.Megaparsec.Parsec Void Text a }

instance Functor Parser where
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser Parsec Void Text a
x) = forall a. Parsec Void Text a -> Parser a
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parsec Void Text a
x)
    {-# INLINE fmap #-}

    a
f <$ :: forall a b. a -> Parser b -> Parser a
<$ Parser Parsec Void Text b
x = forall a. Parsec Void Text a -> Parser a
Parser (a
f forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parsec Void Text b
x)
    {-# INLINE (<$) #-}

instance Applicative Parser where
    pure :: forall a. a -> Parser a
pure = forall a. Parsec Void Text a -> Parser a
Parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE pure #-}

    Parser Parsec Void Text (a -> b)
f <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser Parsec Void Text a
x = forall a. Parsec Void Text a -> Parser a
Parser (Parsec Void Text (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parsec Void Text a
x)
    {-# INLINE (<*>) #-}

    Parser Parsec Void Text a
a <* :: forall a b. Parser a -> Parser b -> Parser a
<* Parser Parsec Void Text b
b = forall a. Parsec Void Text a -> Parser a
Parser (Parsec Void Text a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text b
b)
    {-# INLINE (<*) #-}

    Parser Parsec Void Text a
a *> :: forall a b. Parser a -> Parser b -> Parser b
*> Parser Parsec Void Text b
b = forall a. Parsec Void Text a -> Parser a
Parser (Parsec Void Text a
a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text b
b)
    {-# INLINE (*>) #-}

instance Monad Parser where
    return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}

    >> :: forall a b. Parser a -> Parser b -> Parser b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}

    Parser Parsec Void Text a
n >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k = forall a. Parsec Void Text a -> Parser a
Parser (Parsec Void Text a
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Parser a -> Parsec Void Text a
unParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser b
k)
    {-# INLINE (>>=) #-}

#if !(MIN_VERSION_base(4,13,0))
    fail = Control.Monad.Fail.fail
    {-# INLINE fail #-}
#endif

instance Control.Monad.Fail.MonadFail Parser where
    fail :: forall a. String -> Parser a
fail = forall a. Parsec Void Text a -> Parser a
Parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail
    {-# INLINE fail #-}

instance Alternative Parser where
    empty :: forall a. Parser a
empty = forall a. Parsec Void Text a -> Parser a
Parser forall (f :: * -> *) a. Alternative f => f a
empty
    -- {-# INLINE empty #-}

    Parser Parsec Void Text a
a <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser Parsec Void Text a
b = forall a. Parsec Void Text a -> Parser a
Parser (Parsec Void Text a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text a
b)
    -- {-# INLINE (<|>) #-}

    some :: forall a. Parser a -> Parser [a]
some (Parser Parsec Void Text a
a) = forall a. Parsec Void Text a -> Parser a
Parser (forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parsec Void Text a
a)
    -- {-# INLINE some #-}

    many :: forall a. Parser a -> Parser [a]
many (Parser Parsec Void Text a
a) = forall a. Parsec Void Text a -> Parser a
Parser (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parsec Void Text a
a)
    -- {-# INLINE many #-}

instance MonadPlus Parser where
    mzero :: forall a. Parser a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
    -- {-# INLINE mzero #-}

    mplus :: forall a. Parser a -> Parser a -> Parser a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    -- {-# INLINE mplus #-}

instance Text.Megaparsec.MonadParsec Void Text Parser where
    parseError :: forall a. ParseError Text Void -> Parser a
parseError ParseError Text Void
e = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
Text.Megaparsec.parseError ParseError Text Void
e)

    label :: forall a. String -> Parser a -> Parser a
label String
l (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
Text.Megaparsec.label String
l Parsec Void Text a
p)

    hidden :: forall a. Parser a -> Parser a
hidden (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.hidden Parsec Void Text a
p)

    try :: forall a. Parser a -> Parser a
try (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.try Parsec Void Text a
p)

    lookAhead :: forall a. Parser a -> Parser a
lookAhead (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.lookAhead Parsec Void Text a
p)

    notFollowedBy :: forall a. Parser a -> Parser ()
notFollowedBy (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy Parsec Void Text a
p)

    withRecovery :: forall a.
(ParseError Text Void -> Parser a) -> Parser a -> Parser a
withRecovery ParseError Text Void -> Parser a
e (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a.
MonadParsec e s m =>
(ParseError s e -> m a) -> m a -> m a
Text.Megaparsec.withRecovery (forall a. Parser a -> Parsec Void Text a
unParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError Text Void -> Parser a
e) Parsec Void Text a
p)

    observing :: forall a. Parser a -> Parser (Either (ParseError Text Void) a)
observing (Parser Parsec Void Text a
p) = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
Text.Megaparsec.observing Parsec Void Text a
p)

    eof :: Parser ()
eof = forall a. Parsec Void Text a -> Parser a
Parser forall e s (m :: * -> *). MonadParsec e s m => m ()
Text.Megaparsec.eof

    token :: forall a.
(Token Text -> Maybe a) -> Set (ErrorItem (Token Text)) -> Parser a
token Token Text -> Maybe a
f Set (ErrorItem (Token Text))
e = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *) a.
MonadParsec e s m =>
(Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> m a
Text.Megaparsec.token Token Text -> Maybe a
f Set (ErrorItem (Token Text))
e)

    tokens :: (Tokens Text -> Tokens Text -> Bool)
-> Tokens Text -> Parser (Tokens Text)
tokens Tokens Text -> Tokens Text -> Bool
f Tokens Text
ts = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
(Tokens s -> Tokens s -> Bool) -> Tokens s -> m (Tokens s)
Text.Megaparsec.tokens Tokens Text -> Tokens Text -> Bool
f Tokens Text
ts)

    takeWhileP :: Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
takeWhileP Maybe String
s Token Text -> Bool
f = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhileP Maybe String
s Token Text -> Bool
f)

    takeWhile1P :: Maybe String -> (Token Text -> Bool) -> Parser (Tokens Text)
takeWhile1P Maybe String
s Token Text -> Bool
f = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P Maybe String
s Token Text -> Bool
f)

    takeP :: Maybe String -> Int -> Parser (Tokens Text)
takeP Maybe String
s Int
n = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
Text.Megaparsec.takeP Maybe String
s Int
n)

    getParserState :: Parser (State Text Void)
getParserState = forall a. Parsec Void Text a -> Parser a
Parser forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
Text.Megaparsec.getParserState
    {-# INLINE getParserState #-}

    updateParserState :: (State Text Void -> State Text Void) -> Parser ()
updateParserState State Text Void -> State Text Void
f = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
(State s e -> State s e) -> m ()
Text.Megaparsec.updateParserState State Text Void -> State Text Void
f)

instance Semigroup a => Semigroup (Parser a) where
    <> :: Parser a -> Parser a -> Parser a
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup a, Monoid a) => Monoid (Parser a) where
    mempty :: Parser a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

instance IsString a => IsString (Parser a) where
    fromString :: String -> Parser a
fromString String
x = forall a. IsString a => String -> a
fromString String
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Text.Megaparsec.Char.string (forall a. IsString a => String -> a
fromString String
x)

instance Text.Parser.Combinators.Parsing Parser where
  try :: forall a. Parser a -> Parser a
try = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Text.Megaparsec.try

  <?> :: forall a. Parser a -> String -> Parser a
(<?>) = forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
(Text.Megaparsec.<?>)

  skipMany :: forall a. Parser a -> Parser ()
skipMany = forall (m :: * -> *) a. MonadPlus m => m a -> m ()
Text.Megaparsec.skipMany

  skipSome :: forall a. Parser a -> Parser ()
skipSome = forall (m :: * -> *) a. MonadPlus m => m a -> m ()
Text.Megaparsec.skipSome

  unexpected :: forall a. String -> Parser a
unexpected = forall (m :: * -> *) a. MonadFail m => String -> m a
fail

  eof :: Parser ()
eof = forall a. Parsec Void Text a -> Parser a
Parser forall e s (m :: * -> *). MonadParsec e s m => m ()
Text.Megaparsec.eof

  notFollowedBy :: forall a. Show a => Parser a -> Parser ()
notFollowedBy = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Text.Megaparsec.notFollowedBy

instance Text.Parser.Char.CharParsing Parser where
  satisfy :: (Char -> Bool) -> Parser Char
satisfy = forall a. Parsec Void Text a -> Parser a
Parser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy

  char :: Char -> Parser Char
char = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Text.Megaparsec.Char.char

  notChar :: Char -> Parser Char
notChar = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Text.Megaparsec.Char.char

  anyChar :: Parser Char
anyChar = forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
Text.Megaparsec.anySingle

  string :: String -> Parser String
string = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
Data.Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Text.Megaparsec.Char.string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

  text :: Text -> Parser Text
text = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Text.Megaparsec.Char.string

instance TokenParsing Parser where
    someSpace :: Parser ()
someSpace =
        forall (m :: * -> *). CharParsing m => m () -> CommentStyle -> m ()
Text.Parser.Token.Style.buildSomeSpaceParser
            (forall a. Parsec Void Text a -> Parser a
Parser (forall (m :: * -> *) a. MonadPlus m => m a -> m ()
Text.Megaparsec.skipSome (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Text.Megaparsec.satisfy Char -> Bool
Char.isSpace)))
            CommentStyle
Text.Parser.Token.Style.haskellCommentStyle

    highlight :: forall a. Highlight -> Parser a -> Parser a
highlight Highlight
_ = forall a. a -> a
id

    semi :: Parser Char
semi = forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Text.Megaparsec.Char.char Char
';' forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
";")

-- | @count n p@ parses @n@ occurrences of @p@
count :: (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count :: forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
n Parser a
parser = forall a. Monoid a => [a] -> a
mconcat (forall a. Int -> a -> [a]
replicate Int
n Parser a
parser)

-- | @range lo hi p@ parses @n@ ocurrences of @p@ where @lo <= n <= hi@
range :: (Semigroup a, Monoid a) => Int -> Int -> Parser a -> Parser a
range :: forall a.
(Semigroup a, Monoid a) =>
Int -> Int -> Parser a -> Parser a
range Int
minimumBound Int
maximumMatches Parser a
parser =
    forall a. (Semigroup a, Monoid a) => Int -> Parser a -> Parser a
count Int
minimumBound Parser a
parser forall a. Semigroup a => a -> a -> a
<> forall {t}. (Eq t, Num t) => t -> Parser a
loop Int
maximumMatches
  where
    loop :: t -> Parser a
loop t
0 = forall a. Monoid a => a
mempty
    loop t
n = (Parser a
parser forall a. Semigroup a => a -> a -> a
<> t -> Parser a
loop (t
n forall a. Num a => a -> a -> a
- t
1)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Monoid a => a
mempty

-- | @option p@ tries to apply parser @p@ returning @mempty@ if parsing failed
option :: (Alternative f, Monoid a) => f a -> f a
option :: forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
option f a
p = f a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

-- | @star p@ tries to apply a parser @0@ or more times
star :: (Alternative f, Monoid a) => f a -> f a
star :: forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star f a
p = forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus f a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

-- | @plus p@ tries to apply a parser @1@ or more times
plus :: (Alternative f, Monoid a) => f a -> f a
plus :: forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
plus f a
p = forall a. Monoid a => a -> a -> a
mappend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
star f a
p

-- | @satisfy p@ creates a parser that consumes and return the next character
--   if it satisfies the predicate @p@
satisfy :: (Char -> Bool) -> Parser Text
satisfy :: (Char -> Bool) -> Parser Text
satisfy = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Text
Data.Text.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
Text.Parser.Char.satisfy

-- | @takeWhile p@ creates a parser that accepts the longest sequence of characters
--   that match the given predicate possibly returning an empty sequence
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile :: (Char -> Bool) -> Parser Text
takeWhile Char -> Bool
predicate = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhileP forall a. Maybe a
Nothing Char -> Bool
predicate)

-- | @takeWhile1 p@ creates a parser that accepts the longest sequence of characters
--   that match the given predicate. It fails when no character was consumed
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 :: (Char -> Bool) -> Parser Text
takeWhile1 Char -> Bool
predicate = forall a. Parsec Void Text a -> Parser a
Parser (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
Text.Megaparsec.takeWhile1P forall a. Maybe a
Nothing Char -> Bool
predicate)

-- | Creates a map with the given key-value pairs, failing if there was a
--   duplicate key.
toMap :: [(Text, a)] -> Parser (Map Text a)
toMap :: forall a. [(Text, a)] -> Parser (Map Text a)
toMap [(Text, a)]
kvs = forall k (f :: * -> *) a b.
(Ord k, Applicative f) =>
(k -> a -> f b) -> Map k a -> f (Map k b)
Dhall.Map.unorderedTraverseWithKey (\Text
_k Parser a
v -> Parser a
v) Map Text (Parser a)
m
  where
    m :: Map Text (Parser a)
m = forall k v. Ord k => (k -> v -> v -> v) -> [(k, v)] -> Map k v
Dhall.Map.fromListWithKey forall {m :: * -> *} {p} {p} {a}.
Parsing m =>
Text -> p -> p -> m a
err (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, a
v) -> (Text
k, forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v)) [(Text, a)]
kvs)

    err :: Text -> p -> p -> m a
err Text
k p
_v1 p
_v2 = forall (m :: * -> *) a. Parsing m => String -> m a
Text.Parser.Combinators.unexpected
                        (String
"duplicate field: " forall a. [a] -> [a] -> [a]
++ Text -> String
Data.Text.unpack Text
k)

-- | Creates a 'Map Text a' using the provided combining function and the
--   key-value pairs
toMapWith
    :: (Text -> Parser a -> Parser a -> Parser a)
    -> [(Text, a)]
    -> Parser (Map Text a)
toMapWith :: forall a.
(Text -> Parser a -> Parser a -> Parser a)
-> [(Text, a)] -> Parser (Map Text a)
toMapWith Text -> Parser a -> Parser a -> Parser a
combine [(Text, a)]
kvs = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence Map Text (Parser a)
m
  where
    m :: Map Text (Parser a)
m = forall k v. Ord k => (k -> v -> v -> v) -> [(k, v)] -> Map k v
Dhall.Map.fromListWithKey Text -> Parser a -> Parser a -> Parser a
combine (forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, a
v) -> (Text
k, forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v)) [(Text, a)]
kvs)

-- | Convert a list of digits to the equivalent number
base :: Num n => [Char] -> n -> n
String
digits base :: forall n. Num n => String -> n -> n
`base` n
b = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl n -> n -> n
snoc n
0 (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToNumber) String
digits)
  where
    snoc :: n -> n -> n
snoc n
result n
number = n
result forall a. Num a => a -> a -> a
* n
b forall a. Num a => a -> a -> a
+ n
number

    digitToNumber :: Char -> Int
digitToNumber Char
c
        | Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' = Int
0x0 forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'0'
        | Char
'A' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F' = Int
0xA forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'A'
        | Char
'a' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f' = Int
0xa forall a. Num a => a -> a -> a
+ Char -> Int
Char.ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'a'
        | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Invalid hexadecimal digit"