{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ViewPatterns      #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| This module contains logic for converting Dhall expressions to and from
    CBOR expressions which can in turn be converted to and from a binary
    representation
-}

module Dhall.Binary
    ( -- * Encoding and decoding
      encodeExpression
    , decodeExpression

      -- * Exceptions
    , DecodingFailure(..)
    ) where

import Codec.CBOR.Decoding  (Decoder, TokenType (..))
import Codec.CBOR.Encoding  (Encoding)
import Codec.Serialise      (Serialise (decode, encode))
import Control.Applicative  (empty, (<|>))
import Control.Exception    (Exception)
import Data.ByteString.Lazy (ByteString)
import Dhall.Syntax
    ( Binding (..)
    , Chunks (..)
    , Const (..)
    , DhallDouble (..)
    , Directory (..)
    , Expr (..)
    , File (..)
    , FilePrefix (..)
    , FunctionBinding (..)
    , Import (..)
    , ImportHashed (..)
    , ImportMode (..)
    , ImportType (..)
    , MultiLet (..)
    , PreferAnnotation (..)
    , RecordField (..)
    , Scheme (..)
    , URL (..)
    , Var (..)
    , WithComponent (..)
    )

import Data.Foldable (toList)
import Data.Ratio    ((%))
import Data.Void     (Void, absurd)
import GHC.Float     (double2Float, float2Double)
import Numeric.Half  (fromHalf, toHalf)
import Prelude       hiding (exponent)

import qualified Codec.CBOR.ByteArray
import qualified Codec.CBOR.Decoding   as Decoding
import qualified Codec.CBOR.Encoding   as Encoding
import qualified Codec.CBOR.Read       as Read
import qualified Codec.Serialise       as Serialise
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
import qualified Data.ByteString.Short
import qualified Data.Foldable         as Foldable
import qualified Data.List.NonEmpty    as NonEmpty
import qualified Data.Sequence
import qualified Data.Time             as Time
import qualified Dhall.Crypto
import qualified Dhall.Map
import qualified Dhall.Syntax          as Syntax
import qualified Text.Printf           as Printf

{-| Convert a function applied to multiple arguments to the base function and
    the list of arguments
-}
unApply :: Expr s a -> (Expr s a, [Expr s a])
unApply :: forall s a. Expr s a -> (Expr s a, [Expr s a])
unApply Expr s a
e₀ = (Expr s a
baseFunction₀, [Expr s a] -> [Expr s a]
diffArguments₀ [])
  where
    ~(Expr s a
baseFunction₀, [Expr s a] -> [Expr s a]
diffArguments₀) = forall {s} {a}. Expr s a -> (Expr s a, [Expr s a] -> [Expr s a])
go Expr s a
e₀

    go :: Expr s a -> (Expr s a, [Expr s a] -> [Expr s a])
go (App Expr s a
f Expr s a
a) = (Expr s a
baseFunction, [Expr s a] -> [Expr s a]
diffArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr s a
a forall a. a -> [a] -> [a]
:))
      where
        ~(Expr s a
baseFunction, [Expr s a] -> [Expr s a]
diffArguments) = Expr s a -> (Expr s a, [Expr s a] -> [Expr s a])
go Expr s a
f

    go (Note s
_ Expr s a
e) = Expr s a -> (Expr s a, [Expr s a] -> [Expr s a])
go Expr s a
e

    go Expr s a
baseFunction = (Expr s a
baseFunction, forall a. a -> a
id)

decodeExpressionInternal :: (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal :: forall s a t. (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal Int -> Decoder s a
decodeEmbed = forall {s}. Decoder s (Expr s a)
go
  where
    go :: Decoder s (Expr s a)
go = do
        let die :: String -> m a
die String
message = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeExpressionInternal: " forall a. Semigroup a => a -> a -> a
<> String
message)

        TokenType
tokenType₀ <- forall s. Decoder s TokenType
Decoding.peekTokenType

        case TokenType
tokenType₀ of
            TokenType
TypeUInt -> do
                !Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeWord

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"_" Int
n))

            TokenType
TypeUInt64 -> do
                !Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeWord64

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"_" Int
n))

            TokenType
TypeFloat16 -> do
                !Double
n <- Float -> Double
float2Double forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Float
Decoding.decodeFloat

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))

            TokenType
TypeFloat32 -> do
                !Double
n <- Float -> Double
float2Double forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Float
Decoding.decodeFloat

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))

            TokenType
TypeFloat64 -> do
                !Double
n <- forall s. Decoder s Double
Decoding.decodeDouble

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))

            TokenType
TypeBool -> do
                !Bool
b <- forall s. Decoder s Bool
Decoding.decodeBool

                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Bool -> Expr s a
BoolLit Bool
b)

            TokenType
TypeString -> do
                !ByteArray
ba <- forall s. Decoder s ByteArray
Decoding.decodeUtf8ByteArray

                let sb :: ShortByteString
sb = ByteArray -> ShortByteString
Codec.CBOR.ByteArray.toShortByteString ByteArray
ba

                case ShortByteString -> Int
Data.ByteString.Short.length ShortByteString
sb of
                    Int
4  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Bool"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Bool
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Date"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Date
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
List
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"None"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
None
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Text"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Text
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Time"              -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Time
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Type"              -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Const -> Expr s a
Const Const
Type)
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Kind"              -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Const -> Expr s a
Const Const
Kind)
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Sort"              -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Const -> Expr s a
Const Const
Sort)
                    Int
5  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Bytes"             -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Bytes
                    Int
6  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Double"            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Double
                    Int
7  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Integer"           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Integer
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural"           -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Natural
                    Int
8  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Optional"          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
Optional
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"TimeZone"          -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
TimeZone
                    Int
9  | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Date/show"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
DateShow
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/fold"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListFold
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/head"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListHead
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/last"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListLast
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Text/show"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
TextShow
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Time/show"         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
TimeShow
                    Int
10 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/build"        -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListBuild
                    Int
11 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Double/show"       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
DoubleShow
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/length"       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListLength
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/odd"       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalOdd
                    Int
12 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Integer/show"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
IntegerShow
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/indexed"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListIndexed
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"List/reverse"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
ListReverse
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/even"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalEven
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/fold"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalFold
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/show"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalShow
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Text/replace"      -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
TextReplace
                    Int
13 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Integer/clamp"     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
IntegerClamp
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/build"     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalBuild
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"TimeZone/show"     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
TimeZoneShow
                    Int
14 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Integer/negate"    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
IntegerNegate
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/isZero"    -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalIsZero
                    Int
16 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Integer/toDouble"  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
IntegerToDouble
                       | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/subtract"  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalSubtract
                    Int
17 | ShortByteString
sb forall a. Eq a => a -> a -> Bool
== ShortByteString
"Natural/toInteger" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a
NaturalToInteger
                    Int
_                              -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unrecognized built-in: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ShortByteString
sb)

            TokenType
TypeListLen -> do
                Int
len <- forall s. Decoder s Int
Decoding.decodeListLen

                case Int
len of
                    Int
0 -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Missing tag"
                    Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

                TokenType
tokenType₁ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                case TokenType
tokenType₁ of
                    TokenType
TypeString -> do
                        Text
x <- forall s. Decoder s Text
Decoding.decodeString

                        if Text
x forall a. Eq a => a -> a -> Bool
== Text
"_"
                            then forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Non-standard encoding of an α-normalized variable"
                            else forall (m :: * -> *) a. Monad m => a -> m a
return ()

                        TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                        case TokenType
tokenType₂ of
                            TokenType
TypeUInt -> do
                                !Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeWord

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
n))

                            TokenType
TypeUInt64 -> do
                                !Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeWord64

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
n))

                            TokenType
_ ->
                                forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected token type for variable index: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₂)

                    TokenType
TypeUInt -> do
                        Word
tag <- forall s. Decoder s Word
Decoding.decodeWord

                        case Word
tag of
                            Word
0 -> do
                                !Expr s a
f <- Decoder s (Expr s a)
go

                                let loop :: t -> Expr s a -> Decoder s (Expr s a)
loop t
n !Expr s a
acc
                                        | t
n forall a. Ord a => a -> a -> Bool
<= t
0    = forall (m :: * -> *) a. Monad m => a -> m a
return Expr s a
acc
                                        | Bool
otherwise = do
                                              !Expr s a
x <- Decoder s (Expr s a)
go
                                              t -> Expr s a -> Decoder s (Expr s a)
loop (t
n forall a. Num a => a -> a -> a
- t
1) (forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
acc Expr s a
x)

                                let nArgs :: Int
nArgs = Int
len forall a. Num a => a -> a -> a
- Int
2

                                if Int
nArgs forall a. Ord a => a -> a -> Bool
<= Int
0
                                    then forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Non-standard encoding of a function with no arguments"
                                    else forall {t}. (Ord t, Num t) => t -> Expr s a -> Decoder s (Expr s a)
loop Int
nArgs Expr s a
f

                            Word
1 ->
                                case Int
len of
                                    Int
3 -> do
                                        Expr s a
_A <- Decoder s (Expr s a)
go

                                        Expr s a
b <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam forall a. Monoid a => a
mempty (forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
"_" Expr s a
_A) Expr s a
b)

                                    Int
4 -> do
                                        Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                        if Text
x forall a. Eq a => a -> a -> Bool
== Text
"_"
                                            then forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Non-standard encoding of a λ expression"
                                            else forall (m :: * -> *) a. Monad m => a -> m a
return ()

                                        Expr s a
_A <- Decoder s (Expr s a)
go

                                        Expr s a
b <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam forall a. Monoid a => a
mempty (forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
x Expr s a
_A) Expr s a
b)

                                    Int
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Incorrect number of tokens used to encode a λ expression: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len)

                            Word
2 ->
                                case Int
len of
                                    Int
3 -> do
                                        Expr s a
_A <- Decoder s (Expr s a)
go

                                        Expr s a
_B <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
"_" Expr s a
_A Expr s a
_B)

                                    Int
4 -> do
                                        Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                        if Text
x forall a. Eq a => a -> a -> Bool
== Text
"_"
                                            then forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Non-standard encoding of a ∀ expression"
                                            else forall (m :: * -> *) a. Monad m => a -> m a
return ()

                                        Expr s a
_A <- Decoder s (Expr s a)
go

                                        Expr s a
_B <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi forall a. Monoid a => a
mempty Text
x Expr s a
_A Expr s a
_B)

                                    Int
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Incorrect number of tokens used to encode a ∀ expression: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len)

                            Word
3 -> do
                                Word
opcode <- forall s. Decoder s Word
Decoding.decodeWord

                                Expr s a -> Expr s a -> Expr s a
op <- case Word
opcode of
                                    Word
0  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
BoolOr
                                    Word
1  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
BoolAnd
                                    Word
2  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
BoolEQ
                                    Word
3  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
BoolNE
                                    Word
4  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
NaturalPlus
                                    Word
5  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
NaturalTimes
                                    Word
6  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
TextAppend
                                    Word
7  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
ListAppend
                                    Word
8  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet
-> Maybe Text -> Expr s a -> Expr s a -> Expr s a
Combine forall a. Monoid a => a
mempty forall a. Maybe a
Nothing)
                                    Word
9  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe CharacterSet
-> PreferAnnotation -> Expr s a -> Expr s a -> Expr s a
Prefer forall a. Monoid a => a
mempty PreferAnnotation
PreferFromSource)
                                    Word
10 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
CombineTypes forall a. Monoid a => a
mempty)
                                    Word
11 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
ImportAlt
                                    Word
12 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe CharacterSet -> Expr s a -> Expr s a -> Expr s a
Equivalent forall a. Monoid a => a
mempty)
                                    Word
13 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall s a. Expr s a -> Expr s a -> Expr s a
RecordCompletion
                                    Word
_  -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unrecognized operator code: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
opcode)

                                Expr s a
l <- Decoder s (Expr s a)
go

                                Expr s a
r <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a -> Expr s a
op Expr s a
l Expr s a
r)

                            Word
4 ->
                                case Int
len of
                                    Int
2 -> do
                                        Expr s a
_T <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (forall a. a -> Maybe a
Just (forall s a. Expr s a -> Expr s a -> Expr s a
App forall s a. Expr s a
List Expr s a
_T)) forall (f :: * -> *) a. Alternative f => f a
empty)

                                    Int
_ -> do
                                        forall s. Decoder s ()
Decoding.decodeNull

                                        Seq (Expr s a)
xs <- forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
Data.Sequence.replicateA (Int
len forall a. Num a => a -> a -> a
- Int
2) Decoder s (Expr s a)
go
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit forall a. Maybe a
Nothing Seq (Expr s a)
xs)

                            Word
5 -> do
                                forall s. Decoder s ()
Decoding.decodeNull

                                Expr s a
t <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a
Some Expr s a
t)

                            Word
6 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Expr s a
u <- Decoder s (Expr s a)
go

                                case Int
len of
                                    Int
3 ->
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr s a
t Expr s a
u forall a. Maybe a
Nothing)

                                    Int
4 -> do
                                        Expr s a
_T <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge Expr s a
t Expr s a
u (forall a. a -> Maybe a
Just Expr s a
_T))

                                    Int
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Incorrect number of tokens used to encode a `merge` expression: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len)

                            Word
7 -> do
                                Int
mapLength <- forall s. Decoder s Int
Decoding.decodeMapLen

                                [(Text, RecordField s a)]
xTs <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength forall a b. (a -> b) -> a -> b
$ do
                                    Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                    Expr s a
_T <- Decoder s (Expr s a)
go

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, forall s a. Expr s a -> RecordField s a
Syntax.makeRecordField Expr s a
_T)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
Record (forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, RecordField s a)]
xTs))

                            Word
8 -> do
                                Int
mapLength <- forall s. Decoder s Int
Decoding.decodeMapLen

                                [(Text, RecordField s a)]
xts <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength forall a b. (a -> b) -> a -> b
$ do
                                    Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                    Expr s a
t <- Decoder s (Expr s a)
go

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, forall s a. Expr s a -> RecordField s a
Syntax.makeRecordField Expr s a
t)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit (forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, RecordField s a)]
xts))

                            Word
9 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s a
t (forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
x))

                            Word
10 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Either [Text] (Expr s a)
xs <- case Int
len of
                                    Int
3 -> do
                                        TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                        case TokenType
tokenType₂ of
                                            TokenType
TypeListLen -> do
                                                Int
_ <- forall s. Decoder s Int
Decoding.decodeListLen

                                                Expr s a
_T <- Decoder s (Expr s a)
go

                                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Expr s a
_T)

                                            TokenType
TypeString -> do
                                                Text
x <- forall s. Decoder s Text
Decoding.decodeString
                                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Text
x])

                                            TokenType
_ ->
                                                forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected token type for projection: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₂)

                                    Int
_ -> do
                                        [Text]
xs <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder (Int
len forall a. Num a => a -> a -> a
- Int
2) forall s. Decoder s Text
Decoding.decodeString

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [Text]
xs)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
t Either [Text] (Expr s a)
xs)

                            Word
11 -> do
                                Int
mapLength <- forall s. Decoder s Int
Decoding.decodeMapLen

                                [(Text, Maybe (Expr s a))]
xTs <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength forall a b. (a -> b) -> a -> b
$ do
                                    Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                    TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                    Maybe (Expr s a)
mT <- case TokenType
tokenType₂ of
                                        TokenType
TypeNull -> do
                                            forall s. Decoder s ()
Decoding.decodeNull

                                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

                                        TokenType
_ -> do
                                            Expr s a
_T <- Decoder s (Expr s a)
go

                                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Expr s a
_T)

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Maybe (Expr s a)
mT)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union (forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, Maybe (Expr s a))]
xTs))

                            Word
14 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Expr s a
l <- Decoder s (Expr s a)
go

                                Expr s a
r <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Expr s a -> Expr s a
BoolIf Expr s a
t Expr s a
l Expr s a
r)

                            Word
15 -> do
                                TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                case TokenType
tokenType₂ of
                                    TokenType
TypeUInt -> do
                                        !Natural
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeWord

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Natural -> Expr s a
NaturalLit Natural
n)

                                    TokenType
TypeUInt64 -> do
                                        !Natural
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeWord64

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Natural -> Expr s a
NaturalLit Natural
n)

                                    TokenType
TypeInteger -> do
                                        !Natural
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Integer
Decoding.decodeInteger
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Natural -> Expr s a
NaturalLit Natural
n)

                                    TokenType
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected token type for Natural literal: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₂)

                            Word
16 -> do
                                TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                case TokenType
tokenType₂ of
                                    TokenType
TypeUInt -> do
                                        !Integer
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeWord

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit Integer
n)

                                    TokenType
TypeUInt64 -> do
                                        !Integer
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeWord64

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit Integer
n)

                                    TokenType
TypeNInt -> do
                                        !Integer
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeNegWord

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit forall a b. (a -> b) -> a -> b
$! (-Integer
1 forall a. Num a => a -> a -> a
- Integer
n))

                                    TokenType
TypeNInt64 -> do
                                        !Integer
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeNegWord64

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit forall a b. (a -> b) -> a -> b
$! (-Integer
1 forall a. Num a => a -> a -> a
- Integer
n))
                                    TokenType
TypeInteger -> do
                                        Integer
n <- forall s. Decoder s Integer
Decoding.decodeInteger
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Integer -> Expr s a
IntegerLit Integer
n)

                                    TokenType
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected token type for Integer literal: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₂)

                            Word
18 -> do
                                [(Text, Expr s a)]
xys <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder ((Int
len forall a. Num a => a -> a -> a
- Int
2) forall a. Integral a => a -> a -> a
`quot` Int
2) forall a b. (a -> b) -> a -> b
$ do
                                    Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                    Expr s a
y <- Decoder s (Expr s a)
go

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Expr s a
y)

                                Text
z <- forall s. Decoder s Text
Decoding.decodeString

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Chunks s a -> Expr s a
TextLit (forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text, Expr s a)]
xys Text
z))

                            Word
19 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a
Assert Expr s a
t)

                            Word
24 ->
                                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s a. a -> Expr s a
Embed (Int -> Decoder s a
decodeEmbed Int
len)

                            Word
25 -> do
                                [Binding s a]
bindings <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder ((Int
len forall a. Num a => a -> a -> a
- Int
2) forall a. Integral a => a -> a -> a
`quot` Int
3) forall a b. (a -> b) -> a -> b
$ do
                                    Text
x <- forall s. Decoder s Text
Decoding.decodeString

                                    TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                    Maybe (Maybe s, Expr s a)
mA <- case TokenType
tokenType₂ of
                                        TokenType
TypeNull -> do
                                            forall s. Decoder s ()
Decoding.decodeNull

                                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

                                        TokenType
_ -> do
                                            Expr s a
_A <- Decoder s (Expr s a)
go

                                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just (forall a. Maybe a
Nothing, Expr s a
_A))

                                    Expr s a
a <- Decoder s (Expr s a)
go

                                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding forall a. Maybe a
Nothing Text
x forall a. Maybe a
Nothing Maybe (Maybe s, Expr s a)
mA forall a. Maybe a
Nothing Expr s a
a)

                                Expr s a
b <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall s a. Binding s a -> Expr s a -> Expr s a
Let Expr s a
b [Binding s a]
bindings)

                            Word
26 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Expr s a
_T <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a -> Expr s a
Annot Expr s a
t Expr s a
_T)

                            Word
27 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go

                                Maybe (Expr s a)
mT <- case Int
len of
                                    Int
2 ->
                                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

                                    Int
3 -> do
                                        Expr s a
_T <- Decoder s (Expr s a)
go

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Expr s a
_T)

                                    Int
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Incorrect number of tokens used to encode a type annotation: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
len)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr s a
t Maybe (Expr s a)
mT)

                            Word
28 -> do
                                Expr s a
_T <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (forall a. a -> Maybe a
Just Expr s a
_T) forall (f :: * -> *) a. Alternative f => f a
empty)

                            Word
29 -> do
                                Expr s a
l <- Decoder s (Expr s a)
go

                                Int
n <- forall s. Decoder s Int
Decoding.decodeListLen

                                let decodeWithComponent :: Decoder s WithComponent
decodeWithComponent = do
                                        TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType
                                        case TokenType
tokenType₂ of
                                            TokenType
TypeString -> do
                                                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> WithComponent
WithLabel forall s. Decoder s Text
Decoding.decodeString
                                            TokenType
_ -> do
                                                Int
m <- forall s. Decoder s Int
Decoding.decodeInt

                                                case Int
m of
                                                    Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return WithComponent
WithQuestion
                                                    Int
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected integer encoding a with expression: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)
                                [WithComponent]
ks₀ <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
n forall {s}. Decoder s WithComponent
decodeWithComponent

                                NonEmpty WithComponent
ks₁ <- case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [WithComponent]
ks₀ of
                                    Maybe (NonEmpty WithComponent)
Nothing ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"0 field labels in decoded with expression"
                                    Just NonEmpty WithComponent
ks₁ ->
                                        forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty WithComponent
ks₁

                                Expr s a
r <- Decoder s (Expr s a)
go

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With Expr s a
l NonEmpty WithComponent
ks₁ Expr s a
r)

                            Word
30 -> do
                                Int
_YYYY <- forall s. Decoder s Int
Decoding.decodeInt
                                Int
_MM   <- forall s. Decoder s Int
Decoding.decodeInt
                                Int
_HH   <- forall s. Decoder s Int
Decoding.decodeInt

                                case Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
_YYYY) Int
_MM Int
_HH of
                                    Maybe Day
Nothing ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die String
"Invalid date"
                                    Just Day
day ->
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Day -> Expr s a
DateLiteral Day
day)
                            Word
31 -> do
                                Int
hh <- forall s. Decoder s Int
Decoding.decodeInt
                                Int
mm <- forall s. Decoder s Int
Decoding.decodeInt
                                Word
tag₂ <- forall s. Decoder s Word
Decoding.decodeTag

                                case Word
tag₂ of
                                    Word
4 -> do
                                        forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                    Word
_ -> do
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected tag for decimal fraction: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
tag)
                                Int
n <- forall s. Decoder s Int
Decoding.decodeListLen

                                case Int
n of
                                    Int
2 -> do
                                        forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                    Int
_ -> do
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Invalid list length for decimal fraction: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
n)

                                Int
exponent <- forall s. Decoder s Int
Decoding.decodeInt

                                TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

                                Integer
mantissa <- case TokenType
tokenType₂ of
                                    TokenType
TypeUInt -> do
                                        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeWord

                                    TokenType
TypeUInt64 -> do
                                        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeWord64

                                    TokenType
TypeNInt -> do
                                        !Integer
i <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word
Decoding.decodeNegWord

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1 forall a. Num a => a -> a -> a
- Integer
i)

                                    TokenType
TypeNInt64 -> do
                                        !Integer
i <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Decoding.decodeNegWord64

                                        forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1 forall a. Num a => a -> a -> a
- Integer
i)
                                    TokenType
TypeInteger -> do
                                        forall s. Decoder s Integer
Decoding.decodeInteger
                                    TokenType
_ ->
                                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected token type for mantissa: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₂)
                                let precision :: Word
precision = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Num a => a -> a
negate Int
exponent)

                                let ss :: Pico
ss = forall a. Fractional a => Rational -> a
fromRational (Integer
mantissa forall a. Integral a => a -> a -> Ratio a
% (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision))

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral (Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Int
hh Int
mm Pico
ss) Word
precision)
                            Word
32 -> do
                                Bool
b   <- forall s. Decoder s Bool
Decoding.decodeBool
                                Int
_HH <- forall s. Decoder s Int
Decoding.decodeInt
                                Int
_MM <- forall s. Decoder s Int
Decoding.decodeInt

                                let sign :: Int -> Int
sign = if Bool
b then forall a. a -> a
id else forall a. Num a => a -> a
negate

                                let minutes :: Int
minutes = Int -> Int
sign (Int
_HH forall a. Num a => a -> a -> a
* Int
60 forall a. Num a => a -> a -> a
+ Int
_MM)

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. TimeZone -> Expr s a
TimeZoneLiteral (Int -> Bool -> String -> TimeZone
Time.TimeZone Int
minutes Bool
False String
""))

                            Word
33 -> do
                                ByteString
b <- forall s. Decoder s ByteString
Decoding.decodeBytes

                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. ByteString -> Expr s a
BytesLit ByteString
b)

                            Word
34 -> do
                                Expr s a
t <- Decoder s (Expr s a)
go
                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall s a. Expr s a -> Expr s a
ShowConstructor Expr s a
t)
                            Word
_ ->
                                forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected tag: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
tag)

                    TokenType
_ ->
                        forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected tag type: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₁)

            TokenType
_ ->
                forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected initial token: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₀)

encodeExpressionInternal :: (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal :: forall a. (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal a -> Encoding
encodeEmbed = forall {s}. Expr s a -> Encoding
go
  where
    go :: Expr s a -> Encoding
go Expr s a
e = case Expr s a
e of
        Var (V Text
"_" Int
n) ->
            Int -> Encoding
Encoding.encodeInt Int
n

        Var (V Text
x Int
n) ->
                Word -> Encoding
Encoding.encodeListLen Word
2
            forall a. Semigroup a => a -> a -> a
<>  Text -> Encoding
Encoding.encodeString Text
x
            forall a. Semigroup a => a -> a -> a
<>  Int -> Encoding
Encoding.encodeInt Int
n

        Expr s a
NaturalBuild ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/build"

        Expr s a
NaturalFold ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/fold"

        Expr s a
NaturalIsZero ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/isZero"

        Expr s a
NaturalEven ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/even"

        Expr s a
NaturalOdd ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/odd"

        Expr s a
NaturalToInteger ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/toInteger"

        Expr s a
NaturalShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/show"

        Expr s a
NaturalSubtract ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural/subtract"

        Expr s a
IntegerToDouble ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Integer/toDouble"

        Expr s a
IntegerClamp ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Integer/clamp"

        Expr s a
IntegerNegate ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Integer/negate"

        Expr s a
IntegerShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Integer/show"

        Expr s a
DoubleShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Double/show"

        Expr s a
ListBuild ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/build"

        Expr s a
ListFold ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/fold"

        Expr s a
ListLength ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/length"

        Expr s a
ListHead ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/head"

        Expr s a
ListLast ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/last"

        Expr s a
ListIndexed ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/indexed"

        Expr s a
ListReverse ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List/reverse"

        Expr s a
Bool ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Bool"

        Expr s a
Bytes ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Bytes"

        Expr s a
Optional ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Optional"

        Expr s a
None ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"None"

        Expr s a
Natural ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Natural"

        Expr s a
Integer ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Integer"

        Expr s a
Double ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Double"

        Expr s a
Text ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Text"

        Expr s a
TextReplace ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Text/replace"

        Expr s a
TextShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Text/show"

        Expr s a
Date ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Date"

        Expr s a
DateShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Date/show"

        Expr s a
Time ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Time"

        Expr s a
TimeShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Time/show"

        Expr s a
TimeZone ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"TimeZone"

        Expr s a
TimeZoneShow ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"TimeZone/show"

        Expr s a
List ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"List"

        Const Const
Type ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Type"

        Const Const
Kind ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Kind"

        Const Const
Sort ->
            SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Sort"

        a :: Expr s a
a@App{} ->
            forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr s a]
arguments)
                ( Int -> Encoding
Encoding.encodeInt Int
0
                forall a. a -> [a] -> [a]
: Expr s a -> Encoding
go Expr s a
function
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Expr s a -> Encoding
go [Expr s a]
arguments
                )
          where
            (Expr s a
function, [Expr s a]
arguments) = forall s a. Expr s a -> (Expr s a, [Expr s a])
unApply Expr s a
a

        Lam Maybe CharacterSet
_ (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
"_", functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s a
_A }) Expr s a
b ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
1)
                (Expr s a -> Encoding
go Expr s a
_A)
                (Expr s a -> Encoding
go Expr s a
b)

        Lam Maybe CharacterSet
_ (FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s a
_A }) Expr s a
b ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
1)
                (Text -> Encoding
Encoding.encodeString Text
x)
                (Expr s a -> Encoding
go Expr s a
_A)
                (Expr s a -> Encoding
go Expr s a
b)

        Pi Maybe CharacterSet
_ Text
"_" Expr s a
_A Expr s a
_B ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
2)
                (Expr s a -> Encoding
go Expr s a
_A)
                (Expr s a -> Encoding
go Expr s a
_B)

        Pi Maybe CharacterSet
_ Text
x Expr s a
_A Expr s a
_B ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
2)
                (Text -> Encoding
Encoding.encodeString Text
x)
                (Expr s a -> Encoding
go Expr s a
_A)
                (Expr s a -> Encoding
go Expr s a
_B)

        BoolOr Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
0 Expr s a
l Expr s a
r

        BoolAnd Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
1 Expr s a
l Expr s a
r

        BoolEQ Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
2 Expr s a
l Expr s a
r

        BoolNE Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
3 Expr s a
l Expr s a
r

        BytesLit ByteString
b ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
33)
                (ByteString -> Encoding
Encoding.encodeBytes ByteString
b)

        NaturalPlus Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
4 Expr s a
l Expr s a
r

        NaturalTimes Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
5 Expr s a
l Expr s a
r

        TextAppend Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
6 Expr s a
l Expr s a
r

        ListAppend Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
7 Expr s a
l Expr s a
r

        Combine Maybe CharacterSet
_ Maybe Text
_ Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
8 Expr s a
l Expr s a
r

        Prefer Maybe CharacterSet
_ PreferAnnotation
_ Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
9 Expr s a
l Expr s a
r

        CombineTypes Maybe CharacterSet
_ Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
10 Expr s a
l Expr s a
r

        ImportAlt Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
11 Expr s a
l Expr s a
r

        Equivalent Maybe CharacterSet
_ Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
12 Expr s a
l Expr s a
r

        RecordCompletion Expr s a
l Expr s a
r ->
            Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
13 Expr s a
l Expr s a
r

        ListLit Maybe (Expr s a)
_T₀ Seq (Expr s a)
xs
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (Expr s a)
xs ->
                Encoding -> Encoding -> Encoding
encodeList2 (Int -> Encoding
Encoding.encodeInt Int
label) Encoding
_T₁
            | Bool
otherwise ->
                forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                    (Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Expr s a)
xs)
                    ( Int -> Encoding
Encoding.encodeInt Int
4
                    forall a. a -> [a] -> [a]
: Encoding
Encoding.encodeNull
                    forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Expr s a -> Encoding
go (forall (t :: * -> *) a. Foldable t => t a -> [a]
Data.Foldable.toList Seq (Expr s a)
xs)
                    )
          where
            (Int
label, Encoding
_T₁) = case Maybe (Expr s a)
_T₀ of
                Maybe (Expr s a)
Nothing           -> (Int
4 , Encoding
Encoding.encodeNull)
                Just (App Expr s a
List Expr s a
t) -> (Int
4 , Expr s a -> Encoding
go Expr s a
t               )
                Just  Expr s a
t           -> (Int
28, Expr s a -> Encoding
go Expr s a
t               )

        Some Expr s a
t ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
5)
                Encoding
Encoding.encodeNull
                (Expr s a -> Encoding
go Expr s a
t)

        Merge Expr s a
t Expr s a
u Maybe (Expr s a)
Nothing ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
6)
                (Expr s a -> Encoding
go Expr s a
t)
                (Expr s a -> Encoding
go Expr s a
u)

        Merge Expr s a
t Expr s a
u (Just Expr s a
_T) ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
6)
                (Expr s a -> Encoding
go Expr s a
t)
                (Expr s a -> Encoding
go Expr s a
u)
                (Expr s a -> Encoding
go Expr s a
_T)

        Record Map Text (RecordField s a)
xTs ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
7)
                (forall {t}. (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith (Expr s a -> Encoding
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. RecordField s a -> Expr s a
recordFieldValue) Map Text (RecordField s a)
xTs)

        RecordLit Map Text (RecordField s a)
xts ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
8)
                (forall {t}. (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith (Expr s a -> Encoding
goforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. RecordField s a -> Expr s a
recordFieldValue) Map Text (RecordField s a)
xts)

        Field Expr s a
t (forall s. FieldSelection s -> Text
Syntax.fieldSelectionLabel -> Text
x) ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
9)
                (Expr s a -> Encoding
go Expr s a
t)
                (Text -> Encoding
Encoding.encodeString Text
x)

        Project Expr s a
t (Left [Text]
xs) ->
            forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs)
                ( Int -> Encoding
Encoding.encodeInt Int
10
                forall a. a -> [a] -> [a]
: Expr s a -> Encoding
go Expr s a
t
                forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Text -> Encoding
Encoding.encodeString [Text]
xs
                )

        Project Expr s a
t (Right Expr s a
_T) ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
10)
                (Expr s a -> Encoding
go Expr s a
t)
                (Encoding -> Encoding
encodeList1 (Expr s a -> Encoding
go Expr s a
_T))

        Union Map Text (Maybe (Expr s a))
xTs ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
11)
                (forall {t}. (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith Maybe (Expr s a) -> Encoding
encodeValue Map Text (Maybe (Expr s a))
xTs)
          where
            encodeValue :: Maybe (Expr s a) -> Encoding
encodeValue  Maybe (Expr s a)
Nothing  = Encoding
Encoding.encodeNull
            encodeValue (Just Expr s a
_T) = Expr s a -> Encoding
go Expr s a
_T

        BoolLit Bool
b ->
            Bool -> Encoding
Encoding.encodeBool Bool
b

        BoolIf Expr s a
t Expr s a
l Expr s a
r ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
14)
                (Expr s a -> Encoding
go Expr s a
t)
                (Expr s a -> Encoding
go Expr s a
l)
                (Expr s a -> Encoding
go Expr s a
r)

        NaturalLit Natural
n ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
15)
                (Integer -> Encoding
Encoding.encodeInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))

        IntegerLit Integer
n ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
16)
                (Integer -> Encoding
Encoding.encodeInteger (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n))

        DoubleLit (DhallDouble Double
n64)
            | Bool
useHalf   -> Float -> Encoding
Encoding.encodeFloat16 Float
n32
            | Bool
useFloat  -> Float -> Encoding
Encoding.encodeFloat Float
n32
            | Bool
otherwise -> Double -> Encoding
Encoding.encodeDouble Double
n64
          where
            n32 :: Float
n32 = Double -> Float
double2Float Double
n64

            n16 :: Half
n16 = Float -> Half
toHalf Float
n32

            useFloat :: Bool
useFloat = Double
n64 forall a. Eq a => a -> a -> Bool
== Float -> Double
float2Double Float
n32

            useHalf :: Bool
useHalf = Double
n64 forall a. Eq a => a -> a -> Bool
== (Float -> Double
float2Double forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
n16)

        -- Fast path for the common case of an uninterpolated string
        TextLit (Chunks [] Text
z) ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
18)
                (Text -> Encoding
Encoding.encodeString Text
z)

        TextLit (Chunks [(Text, Expr s a)]
xys Text
z) ->
            forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Expr s a)]
xys)
                ( Int -> Encoding
Encoding.encodeInt Int
18
                forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Expr s a) -> [Encoding]
encodePair [(Text, Expr s a)]
xys forall a. [a] -> [a] -> [a]
++ [ Text -> Encoding
Encoding.encodeString Text
z ]
                )
          where
            encodePair :: (Text, Expr s a) -> [Encoding]
encodePair (Text
x, Expr s a
y) = [ Text -> Encoding
Encoding.encodeString Text
x, Expr s a -> Encoding
go Expr s a
y ]

        Assert Expr s a
t ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
19)
                (Expr s a -> Encoding
go Expr s a
t)

        Embed a
x ->
            a -> Encoding
encodeEmbed a
x

        Let Binding s a
a₀ Expr s a
b₀ ->
            forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 forall a. Num a => a -> a -> a
+ Int
3 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Binding s a)
as)
                ( Int -> Encoding
Encoding.encodeInt Int
25
                forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binding s a -> [Encoding]
encodeBinding (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Binding s a)
as) forall a. [a] -> [a] -> [a]
++ [ Expr s a -> Encoding
go Expr s a
b₁ ]
                )
          where
            MultiLet NonEmpty (Binding s a)
as Expr s a
b₁ = forall s a. Binding s a -> Expr s a -> MultiLet s a
Syntax.multiLet Binding s a
a₀ Expr s a
b₀

            encodeBinding :: Binding s a -> [Encoding]
encodeBinding (Binding Maybe s
_ Text
x Maybe s
_ Maybe (Maybe s, Expr s a)
mA₀ Maybe s
_ Expr s a
a) =
                [ Text -> Encoding
Encoding.encodeString Text
x
                , Encoding
mA₁
                , Expr s a -> Encoding
go Expr s a
a
                ]
              where
                mA₁ :: Encoding
mA₁ = case Maybe (Maybe s, Expr s a)
mA₀ of
                    Maybe (Maybe s, Expr s a)
Nothing      -> Encoding
Encoding.encodeNull
                    Just (Maybe s
_, Expr s a
_A) -> Expr s a -> Encoding
go Expr s a
_A

        Annot Expr s a
t Expr s a
_T ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
26)
                (Expr s a -> Encoding
go Expr s a
t)
                (Expr s a -> Encoding
go Expr s a
_T)

        ToMap Expr s a
t Maybe (Expr s a)
Nothing ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
27)
                (Expr s a -> Encoding
go Expr s a
t)

        ToMap Expr s a
t (Just Expr s a
_T) ->
            Encoding -> Encoding -> Encoding -> Encoding
encodeList3
                (Int -> Encoding
Encoding.encodeInt Int
27)
                (Expr s a -> Encoding
go Expr s a
t)
                (Expr s a -> Encoding
go Expr s a
_T)

        With Expr s a
l NonEmpty WithComponent
ks Expr s a
r ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
29)
                (Expr s a -> Encoding
go Expr s a
l)
                (forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComponent -> Encoding
encodeWithComponent NonEmpty WithComponent
ks))
                (Expr s a -> Encoding
go Expr s a
r)
          where
            encodeWithComponent :: WithComponent -> Encoding
encodeWithComponent  WithComponent
WithQuestion  = Int -> Encoding
Encoding.encodeInt Int
0
            encodeWithComponent (WithLabel Text
k ) = Text -> Encoding
Encoding.encodeString Text
k

        DateLiteral Day
day ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
30)
                (Int -> Encoding
Encoding.encodeInt (forall a. Num a => Integer -> a
fromInteger Integer
_YYYY))
                (Int -> Encoding
Encoding.encodeInt Int
_MM)
                (Int -> Encoding
Encoding.encodeInt Int
_DD)
          where
            (Integer
_YYYY, Int
_MM, Int
_DD) = Day -> (Integer, Int, Int)
Time.toGregorian Day
day

        TimeLiteral (Time.TimeOfDay Int
hh Int
mm Pico
ss) Word
precision ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
31)
                (Int -> Encoding
Encoding.encodeInt Int
hh)
                (Int -> Encoding
Encoding.encodeInt Int
mm)
                (   Word -> Encoding
Encoding.encodeTag Word
4
                forall a. Semigroup a => a -> a -> a
<>  Encoding -> Encoding -> Encoding
encodeList2
                        (Int -> Encoding
Encoding.encodeInt Int
exponent)
                        Encoding
encodedMantissa
                )
          where
            exponent :: Int
exponent = forall a. Num a => a -> a
negate (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
precision)

            mantissa :: Integer
            mantissa :: Integer
mantissa = forall a b. (RealFrac a, Integral b) => a -> b
truncate (Pico
ss forall a. Num a => a -> a -> a
* Pico
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Word
precision)

            encodedMantissa :: Encoding
encodedMantissa
                |  forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int) forall a. Ord a => a -> a -> Bool
<= Integer
mantissa
                Bool -> Bool -> Bool
&& Integer
mantissa forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int) =
                    Int -> Encoding
Encoding.encodeInt (forall a. Num a => Integer -> a
fromInteger Integer
mantissa)
                | Bool
otherwise =
                    Integer -> Encoding
Encoding.encodeInteger Integer
mantissa

        TimeZoneLiteral (Time.TimeZone Int
minutes Bool
_ String
_) ->
            Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
                (Int -> Encoding
Encoding.encodeInt Int
32)
                (Bool -> Encoding
Encoding.encodeBool Bool
sign)
                (Int -> Encoding
Encoding.encodeInt Int
_HH)
                (Int -> Encoding
Encoding.encodeInt Int
_MM)
          where
            sign :: Bool
sign = Int
0 forall a. Ord a => a -> a -> Bool
<= Int
minutes

            (Int
_HH, Int
_MM) = forall a. Num a => a -> a
abs Int
minutes forall a. Integral a => a -> a -> (a, a)
`divMod` Int
60

        ShowConstructor Expr s a
t ->
            Encoding -> Encoding -> Encoding
encodeList2
                (Int -> Encoding
Encoding.encodeInt Int
34)
                (Expr s a -> Encoding
go Expr s a
t)

        Note s
_ Expr s a
b ->
            Expr s a -> Encoding
go Expr s a
b

    encodeOperator :: Int -> Expr s a -> Expr s a -> Encoding
encodeOperator Int
n Expr s a
l Expr s a
r =
        Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4
            (Int -> Encoding
Encoding.encodeInt Int
3)
            (Int -> Encoding
Encoding.encodeInt Int
n)
            (Expr s a -> Encoding
go Expr s a
l)
            (Expr s a -> Encoding
go Expr s a
r)

    encodeMapWith :: (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith t -> Encoding
encodeValue Map Text t
m =
            Word -> Encoding
Encoding.encodeMapLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k v. Map k v -> Int
Dhall.Map.size Map Text t
m))
        forall a. Semigroup a => a -> a -> a
<>  forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, t) -> Encoding
encodeKeyValue (forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList (forall k v. Map k v -> Map k v
Dhall.Map.sort Map Text t
m))
      where
        encodeKeyValue :: (Text, t) -> Encoding
encodeKeyValue (Text
k, t
v) = Text -> Encoding
Encoding.encodeString Text
k forall a. Semigroup a => a -> a -> a
<> t -> Encoding
encodeValue t
v

encodeList1 :: Encoding -> Encoding
encodeList1 :: Encoding -> Encoding
encodeList1 Encoding
a = Word -> Encoding
Encoding.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> Encoding
a
{-# INLINE encodeList1 #-}

encodeList2 :: Encoding -> Encoding -> Encoding
encodeList2 :: Encoding -> Encoding -> Encoding
encodeList2 Encoding
a Encoding
b = Word -> Encoding
Encoding.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Encoding
a forall a. Semigroup a => a -> a -> a
<> Encoding
b
{-# INLINE encodeList2 #-}

encodeList3 :: Encoding -> Encoding -> Encoding -> Encoding
encodeList3 :: Encoding -> Encoding -> Encoding -> Encoding
encodeList3 Encoding
a Encoding
b Encoding
c = Word -> Encoding
Encoding.encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> Encoding
a forall a. Semigroup a => a -> a -> a
<> Encoding
b forall a. Semigroup a => a -> a -> a
<> Encoding
c
{-# INLINE encodeList3 #-}

encodeList4 :: Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4 :: Encoding -> Encoding -> Encoding -> Encoding -> Encoding
encodeList4 Encoding
a Encoding
b Encoding
c Encoding
d = Word -> Encoding
Encoding.encodeListLen Word
4 forall a. Semigroup a => a -> a -> a
<> Encoding
a forall a. Semigroup a => a -> a -> a
<> Encoding
b forall a. Semigroup a => a -> a -> a
<> Encoding
c forall a. Semigroup a => a -> a -> a
<> Encoding
d
{-# INLINE encodeList4 #-}

encodeListN :: Foldable f => Int -> f Encoding -> Encoding
encodeListN :: forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN Int
len f Encoding
xs =
    Word -> Encoding
Encoding.encodeListLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold f Encoding
xs
{-# INLINE encodeListN #-}

encodeList :: Foldable f => f Encoding -> Encoding
encodeList :: forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList f Encoding
xs = forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN (forall (t :: * -> *) a. Foldable t => t a -> Int
length f Encoding
xs) f Encoding
xs
{-# INLINE encodeList #-}

decodeImport :: Int -> Decoder s Import
decodeImport :: forall s. Int -> Decoder s Import
decodeImport Int
len = do
    let die :: String -> m a
die String
message = forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeImport: " forall a. Semigroup a => a -> a -> a
<> String
message)

    TokenType
tokenType₀ <- forall s. Decoder s TokenType
Decoding.peekTokenType

    Maybe SHA256Digest
hash <- case TokenType
tokenType₀ of
        TokenType
TypeNull -> do
            forall s. Decoder s ()
Decoding.decodeNull

            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

        TokenType
TypeBytes -> do
            ByteString
bytes <- forall s. Decoder s ByteString
Decoding.decodeBytes

            let (ByteString
prefix, ByteString
suffix) = Int -> ByteString -> (ByteString, ByteString)
Data.ByteString.splitAt Int
2 ByteString
bytes

            case ByteString
prefix of
                ByteString
"\x12\x20" -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                ByteString
_          -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unrecognized multihash prefix: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
prefix)
            case ByteString -> Maybe SHA256Digest
Dhall.Crypto.sha256DigestFromByteString ByteString
suffix of
                Maybe SHA256Digest
Nothing     -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Invalid sha256 digest: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
bytes)
                Just SHA256Digest
digest -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just SHA256Digest
digest)

        TokenType
_ ->
            forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected hash token: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
tokenType₀)

    Word
m <- forall s. Decoder s Word
Decoding.decodeWord

    ImportMode
importMode <- case Word
m of
        Word
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
Code
        Word
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
RawText
        Word
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
Location
        Word
3 -> forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
RawBytes
        Word
_ -> forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected code for import mode: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
m)

    let remote :: Scheme -> Decoder s ImportType
remote Scheme
scheme = do
            TokenType
tokenType₁ <- forall s. Decoder s TokenType
Decoding.peekTokenType

            Maybe (Expr Src Import)
headers <- case TokenType
tokenType₁ of
                TokenType
TypeNull -> do
                    forall s. Decoder s ()
Decoding.decodeNull
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

                TokenType
_ -> do
                    Expr Src Import
headers <- forall s a t. (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal forall s. Int -> Decoder s Import
decodeImport

                    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Expr Src Import
headers)

            Text
authority <- forall s. Decoder s Text
Decoding.decodeString

            [Text]
paths <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder (Int
len forall a. Num a => a -> a -> a
- Int
8) forall s. Decoder s Text
Decoding.decodeString

            Text
file <- forall s. Decoder s Text
Decoding.decodeString

            TokenType
tokenType₂ <- forall s. Decoder s TokenType
Decoding.peekTokenType

            Maybe Text
query <- case TokenType
tokenType₂ of
                TokenType
TypeNull -> do
                    forall s. Decoder s ()
Decoding.decodeNull
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                TokenType
_ ->
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall s. Decoder s Text
Decoding.decodeString

            let components :: [Text]
components = forall a. [a] -> [a]
reverse [Text]
paths
            let directory :: Directory
directory  = Directory {[Text]
components :: [Text]
components :: [Text]
..}
            let path :: File
path       = File {Text
Directory
file :: Text
directory :: Directory
directory :: Directory
file :: Text
..}

            forall (m :: * -> *) a. Monad m => a -> m a
return (URL -> ImportType
Remote (URL {Maybe Text
Maybe (Expr Src Import)
Text
Scheme
File
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
authority :: Text
scheme :: Scheme
path :: File
query :: Maybe Text
authority :: Text
headers :: Maybe (Expr Src Import)
scheme :: Scheme
..}))

    let local :: FilePrefix -> Decoder s ImportType
local FilePrefix
prefix = do
            [Text]
paths <- forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder (Int
len forall a. Num a => a -> a -> a
- Int
5) forall s. Decoder s Text
Decoding.decodeString

            Text
file <- forall s. Decoder s Text
Decoding.decodeString

            let components :: [Text]
components = forall a. [a] -> [a]
reverse [Text]
paths
            let directory :: Directory
directory  = Directory {[Text]
components :: [Text]
components :: [Text]
..}

            forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
prefix (File {Text
Directory
directory :: Directory
file :: Text
file :: Text
directory :: Directory
..}))

    let missing :: Decoder s ImportType
missing = forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
Missing

    let env :: Decoder s ImportType
env = do
            Text
x <- forall s. Decoder s Text
Decoding.decodeString

            forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ImportType
Env Text
x)

    Word
n <- forall s. Decoder s Word
Decoding.decodeWord

    ImportType
importType <- case Word
n of
        Word
0 -> forall {s}. Scheme -> Decoder s ImportType
remote Scheme
HTTP
        Word
1 -> forall {s}. Scheme -> Decoder s ImportType
remote Scheme
HTTPS
        Word
2 -> forall {s}. FilePrefix -> Decoder s ImportType
local FilePrefix
Absolute
        Word
3 -> forall {s}. FilePrefix -> Decoder s ImportType
local FilePrefix
Here
        Word
4 -> forall {s}. FilePrefix -> Decoder s ImportType
local FilePrefix
Parent
        Word
5 -> forall {s}. FilePrefix -> Decoder s ImportType
local FilePrefix
Home
        Word
6 -> forall {s}. Decoder s ImportType
env
        Word
7 -> Decoder s ImportType
missing
        Word
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unrecognized import type code: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
n)

    let importHashed :: ImportHashed
importHashed = ImportHashed {Maybe SHA256Digest
ImportType
importType :: ImportType
hash :: Maybe SHA256Digest
importType :: ImportType
hash :: Maybe SHA256Digest
..}

    forall (m :: * -> *) a. Monad m => a -> m a
return (Import {ImportHashed
ImportMode
importMode :: ImportMode
importHashed :: ImportHashed
importHashed :: ImportHashed
importMode :: ImportMode
..})

encodeImport :: Import -> Encoding
encodeImport :: Import -> Encoding
encodeImport Import
import_ =
    case ImportType
importType of
        Remote (URL { scheme :: URL -> Scheme
scheme = Scheme
scheme₀, Maybe Text
Maybe (Expr Src Import)
Text
File
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
authority :: Text
headers :: URL -> Maybe (Expr Src Import)
query :: URL -> Maybe Text
path :: URL -> File
authority :: URL -> Text
.. }) ->
            forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList
                (   [Encoding]
prefix
                forall a. [a] -> [a] -> [a]
++  [ Int -> Encoding
Encoding.encodeInt Int
scheme₁
                    , Encoding
using
                    , Text -> Encoding
Encoding.encodeString Text
authority
                    ]
                forall a. [a] -> [a] -> [a]
++  forall a b. (a -> b) -> [a] -> [b]
map Text -> Encoding
Encoding.encodeString (forall a. [a] -> [a]
reverse [Text]
components)
                forall a. [a] -> [a] -> [a]
++  [ Text -> Encoding
Encoding.encodeString Text
file ]
                forall a. [a] -> [a] -> [a]
++  [ case Maybe Text
query of
                         Maybe Text
Nothing -> Encoding
Encoding.encodeNull
                         Just Text
q  -> Text -> Encoding
Encoding.encodeString Text
q
                    ]
                )
          where
            using :: Encoding
using = case Maybe (Expr Src Import)
headers of
                Maybe (Expr Src Import)
Nothing ->
                    Encoding
Encoding.encodeNull
                Just Expr Src Import
h ->
                    forall a. (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal Import -> Encoding
encodeImport (forall s a t. Expr s a -> Expr t a
Syntax.denote Expr Src Import
h)

            scheme₁ :: Int
scheme₁ = case Scheme
scheme₀ of
                Scheme
HTTP  -> Int
0
                Scheme
HTTPS -> Int
1

            File{Text
Directory
directory :: Directory
file :: Text
file :: File -> Text
directory :: File -> Directory
..} = File
path

            Directory {[Text]
components :: [Text]
components :: Directory -> [Text]
..} = Directory
directory

        Local FilePrefix
prefix₀ File
path ->
            forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList
                (   [Encoding]
prefix
                forall a. [a] -> [a] -> [a]
++  [ Int -> Encoding
Encoding.encodeInt Int
prefix₁ ]
                forall a. [a] -> [a] -> [a]
++  forall a b. (a -> b) -> [a] -> [b]
map Text -> Encoding
Encoding.encodeString [Text]
components₁
                forall a. [a] -> [a] -> [a]
++  [ Text -> Encoding
Encoding.encodeString Text
file ]
                )
          where
            File{Text
Directory
directory :: Directory
file :: Text
file :: File -> Text
directory :: File -> Directory
..} = File
path

            Directory{[Text]
components :: [Text]
components :: Directory -> [Text]
..} = Directory
directory

            prefix₁ :: Int
prefix₁ = case FilePrefix
prefix₀ of
                FilePrefix
Absolute -> Int
2
                FilePrefix
Here     -> Int
3
                FilePrefix
Parent   -> Int
4
                FilePrefix
Home     -> Int
5

            components₁ :: [Text]
components₁ = forall a. [a] -> [a]
reverse [Text]
components

        Env Text
x ->
            forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList
                ([Encoding]
prefix forall a. [a] -> [a] -> [a]
++ [ Int -> Encoding
Encoding.encodeInt Int
6, Text -> Encoding
Encoding.encodeString Text
x ])

        ImportType
Missing ->
            forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList ([Encoding]
prefix forall a. [a] -> [a] -> [a]
++ [ Int -> Encoding
Encoding.encodeInt Int
7 ])
  where
    prefix :: [Encoding]
prefix = [ Int -> Encoding
Encoding.encodeInt Int
24, Encoding
h, Encoding
m ]
      where
        h :: Encoding
h = case Maybe SHA256Digest
hash of
            Maybe SHA256Digest
Nothing ->
                Encoding
Encoding.encodeNull

            Just SHA256Digest
digest ->
                ByteString -> Encoding
Encoding.encodeBytes (ByteString
"\x12\x20" forall a. Semigroup a => a -> a -> a
<> SHA256Digest -> ByteString
Dhall.Crypto.unSHA256Digest SHA256Digest
digest)

        m :: Encoding
m = Int -> Encoding
Encoding.encodeInt (case ImportMode
importMode of
            ImportMode
Code -> Int
0
            ImportMode
RawText -> Int
1
            ImportMode
Location -> Int
2
            ImportMode
RawBytes -> Int
3 )

    Import{ImportHashed
ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importMode :: Import -> ImportMode
importHashed :: Import -> ImportHashed
..} = Import
import_

    ImportHashed{Maybe SHA256Digest
ImportType
hash :: Maybe SHA256Digest
importType :: ImportType
importType :: ImportHashed -> ImportType
hash :: ImportHashed -> Maybe SHA256Digest
..} = ImportHashed
importHashed

decodeVoid :: Int -> Decoder s Void
decodeVoid :: forall s. Int -> Decoder s Void
decodeVoid Int
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Dhall.Binary.decodeVoid: Cannot decode an uninhabited type"

encodeVoid :: Void -> Encoding
encodeVoid :: Void -> Encoding
encodeVoid = forall a. Void -> a
absurd

instance Serialise (Expr Void Void) where
    encode :: Expr Void Void -> Encoding
encode = forall a. (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal Void -> Encoding
encodeVoid

    decode :: forall s. Decoder s (Expr Void Void)
decode = forall s a t. (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal forall s. Int -> Decoder s Void
decodeVoid

instance Serialise (Expr Void Import) where
    encode :: Expr Void Import -> Encoding
encode = forall a. (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal Import -> Encoding
encodeImport

    decode :: forall s. Decoder s (Expr Void Import)
decode = forall s a t. (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal forall s. Int -> Decoder s Import
decodeImport

-- | Encode a Dhall expression as a CBOR-encoded `ByteString`
encodeExpression :: Serialise (Expr Void a) => Expr Void a -> ByteString
encodeExpression :: forall a. Serialise (Expr Void a) => Expr Void a -> ByteString
encodeExpression = forall a. Serialise a => a -> ByteString
Serialise.serialise

-- | Decode a Dhall expression from a CBOR `Codec.CBOR.Term.Term`
decodeExpression
    :: Serialise (Expr s a) => ByteString -> Either DecodingFailure (Expr s a)
decodeExpression :: forall s a.
Serialise (Expr s a) =>
ByteString -> Either DecodingFailure (Expr s a)
decodeExpression ByteString
bytes =
    case Maybe (Expr s a)
decodeWithoutVersion forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Expr s a)
decodeWithVersion of
        Just Expr s a
expression -> forall a b. b -> Either a b
Right Expr s a
expression
        Maybe (Expr s a)
Nothing         -> forall a b. a -> Either a b
Left (ByteString -> DecodingFailure
CBORIsNotDhall ByteString
bytes)
  where
    adapt :: Either a (a, a) -> Maybe a
adapt (Right (a
"", a
x)) = forall a. a -> Maybe a
Just a
x
    adapt  Either a (a, a)
_              = forall a. Maybe a
Nothing

    decode' :: Decoder s (Expr s a)
decode' = forall s a. Decoder s a -> Decoder s a
decodeWith55799Tag forall a s. Serialise a => Decoder s a
decode

    -- This is the behavior specified by the standard
    decodeWithoutVersion :: Maybe (Expr s a)
decodeWithoutVersion = forall {a} {a} {a}.
(Eq a, IsString a) =>
Either a (a, a) -> Maybe a
adapt (forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
Read.deserialiseFromBytes forall {s}. Decoder s (Expr s a)
decode' ByteString
bytes)

    -- tag to ease the migration
    decodeWithVersion :: Maybe (Expr s a)
decodeWithVersion = forall {a} {a} {a}.
(Eq a, IsString a) =>
Either a (a, a) -> Maybe a
adapt (forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
Read.deserialiseFromBytes forall {s}. Decoder s (Expr s a)
decodeWithTag ByteString
bytes)
      where
        decodeWithTag :: Decoder s (Expr s a)
decodeWithTag = do
            Int
2 <- forall s. Decoder s Int
Decoding.decodeListLen

            Text
version <- forall s. Decoder s Text
Decoding.decodeString


            -- "_" has never been a valid version string, and this ensures that
            -- we don't interpret `[ "_", 0 ]` as the expression `_` (encoded as
            -- `0`) tagged with a version string of `"_"`
            if (Text
version forall a. Eq a => a -> a -> Bool
== Text
"_")
                then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Dhall.Binary.decodeExpression: \"_\" is not a valid version string"
                else forall (m :: * -> *) a. Monad m => a -> m a
return ()

            forall {s}. Decoder s (Expr s a)
decode'

decodeWith55799Tag :: Decoder s a -> Decoder s a
decodeWith55799Tag :: forall s a. Decoder s a -> Decoder s a
decodeWith55799Tag Decoder s a
decoder = do
    TokenType
tokenType <- forall s. Decoder s TokenType
Decoding.peekTokenType

    case TokenType
tokenType of
        TokenType
TypeTag -> do
            Word
w <- forall s. Decoder s Word
Decoding.decodeTag

            if Word
w forall a. Eq a => a -> a -> Bool
/= Word
55799
                then forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeWith55799Tag: Unexpected tag: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
w)
                else forall (m :: * -> *) a. Monad m => a -> m a
return ()

            Decoder s a
decoder
        TokenType
_ ->
            Decoder s a
decoder

{-| This indicates that a given CBOR-encoded `ByteString` did not correspond to
    a valid Dhall expression
-}
newtype DecodingFailure = CBORIsNotDhall ByteString
    deriving (DecodingFailure -> DecodingFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecodingFailure -> DecodingFailure -> Bool
$c/= :: DecodingFailure -> DecodingFailure -> Bool
== :: DecodingFailure -> DecodingFailure -> Bool
$c== :: DecodingFailure -> DecodingFailure -> Bool
Eq)

instance Exception DecodingFailure

_ERROR :: String
_ERROR :: String
_ERROR = String
"\ESC[1;31mError\ESC[0m"

instance Show DecodingFailure where
    show :: DecodingFailure -> String
show (CBORIsNotDhall ByteString
bytes) =
            String
_ERROR forall a. Semigroup a => a -> a -> a
<> String
": Cannot decode CBOR to Dhall\n"
        forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        forall a. Semigroup a => a -> a -> a
<>  String
"The following bytes do not encode a valid Dhall expression\n"
        forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        forall a. Semigroup a => a -> a -> a
<>  String
"↳ 0x" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
toHex (ByteString -> [Word8]
Data.ByteString.Lazy.unpack ByteString
bytes) forall a. Semigroup a => a -> a -> a
<> String
"\n"
      where
        toHex :: Word8 -> String
toHex = forall r. PrintfType r => String -> r
Printf.printf String
"%02x "

-- | This specialized version of 'Control.Monad.replicateM' reduces
-- decoding timings by roughly 10%.
replicateDecoder :: Int -> Decoder s a -> Decoder s [a]
replicateDecoder :: forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
n0 Decoder s a
decoder = forall {t}. (Ord t, Num t) => t -> Decoder s [a]
go Int
n0
  where
    go :: t -> Decoder s [a]
go t
n
      | t
n forall a. Ord a => a -> a -> Bool
<= t
0    = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      | Bool
otherwise = do
            a
x <- Decoder s a
decoder
            [a]
xs <- t -> Decoder s [a]
go (t
n forall a. Num a => a -> a -> a
- t
1)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
xforall a. a -> [a] -> [a]
:[a]
xs)