{-# 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₀) = Expr s a -> (Expr s a, [Expr s a] -> [Expr s a])
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 ([Expr s a] -> [Expr s a])
-> ([Expr s a] -> [Expr s a]) -> [Expr s a] -> [Expr s a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr s a
a Expr s a -> [Expr s a] -> [Expr s 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, [Expr s a] -> [Expr s a]
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 = Decoder s (Expr t a)
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 = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeExpressionInternal: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message)

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

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

                return (Var (V "_" n))

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

                return (Var (V "_" n))

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

                return (DoubleLit (DhallDouble n))

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

                return (DoubleLit (DhallDouble n))

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

                return (DoubleLit (DhallDouble n))

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

                return (BoolLit b)

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

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

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

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

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

                tokenType₁ <- Decoding.peekTokenType

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

                        if x == "_"
                            then die "Non-standard encoding of an α-normalized variable"
                            else return ()

                        tokenType₂ <- Decoding.peekTokenType

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

                                return (Var (V x n))

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

                                return (Var (V x n))

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

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

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

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

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

                                if nArgs <= 0
                                    then die "Non-standard encoding of a function with no arguments"
                                    else loop nArgs f

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

                                        b <- go

                                        return (Lam mempty (Syntax.makeFunctionBinding "_" _A) b)

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

                                        if x == "_"
                                            then die "Non-standard encoding of a λ expression"
                                            else return ()

                                        _A <- go

                                        b <- go

                                        return (Lam mempty (Syntax.makeFunctionBinding x _A) b)

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

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

                                        _B <- go

                                        return (Pi mempty "_" _A _B)

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

                                        if x == "_"
                                            then die "Non-standard encoding of a ∀ expression"
                                            else return ()

                                        _A <- go

                                        _B <- go

                                        return (Pi mempty x _A _B)

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

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

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

                                l <- go

                                r <- go

                                return (op l r)

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

                                        return (ListLit (Just (App List _T)) empty)

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

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

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

                                t <- Decoder s (Expr s a)
go

                                return (Some t)

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

                                u <- go

                                case len of
                                    Int
3 ->
                                        Expr s a -> Decoder s (Expr s a)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
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 Maybe (Expr s a)
forall a. Maybe a
Nothing)

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

                                        return (Merge t u (Just _T))

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

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

                                xTs <- replicateDecoder mapLength $ do
                                    x <- Decoding.decodeString

                                    _T <- go

                                    return (x, Syntax.makeRecordField _T)

                                return (Record (Dhall.Map.fromList xTs))

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

                                xts <- replicateDecoder mapLength $ do
                                    x <- Decoding.decodeString

                                    t <- go

                                    return (x, Syntax.makeRecordField t)

                                return (RecordLit (Dhall.Map.fromList xts))

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

                                x <- Decoding.decodeString

                                return (Field t (Syntax.makeFieldSelection x))

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

                                xs <- case len of
                                    Int
3 -> do
                                        tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType

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

                                                _T <- go

                                                return (Right _T)

                                            TokenType
TypeString -> do
                                                x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
                                                return (Left [x])

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

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

                                        return (Left xs)

                                return (Project t xs)

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

                                xTs <- replicateDecoder mapLength $ do
                                    x <- Decoding.decodeString

                                    tokenType₂ <- Decoding.peekTokenType

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

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

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

                                            return (Just _T)

                                    return (x, mT)

                                return (Union (Dhall.Map.fromList xTs))

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

                                l <- go

                                r <- go

                                return (BoolIf t l r)

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

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

                                        return (NaturalLit n)

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

                                        return (NaturalLit n)

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

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

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

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

                                        return (IntegerLit n)

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

                                        return (IntegerLit n)

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

                                        return (IntegerLit $! (-1 - n))

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

                                        return (IntegerLit $! (-1 - n))
                                    TokenType
TypeInteger -> do
                                        n <- Decoder s Integer
forall s. Decoder s Integer
Decoding.decodeInteger
                                        return (IntegerLit n)

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

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

                                    y <- go

                                    return (x, y)

                                z <- Decoding.decodeString

                                return (TextLit (Chunks xys z))

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

                                return (Assert t)

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

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

                                    tokenType₂ <- Decoding.peekTokenType

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

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

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

                                            return (Just (Nothing, _A))

                                    a <- go

                                    return (Binding Nothing x Nothing mA Nothing a)

                                b <- go

                                return (foldr Let b bindings)

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

                                _T <- go

                                return (Annot t _T)

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

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

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

                                        return (Just _T)

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

                                return (ToMap t mT)

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

                                return (ListLit (Just _T) empty)

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

                                n <- Decoding.decodeListLen

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

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

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

                                r <- go

                                return (With l ks₁ r)

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

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

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

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

                                exponent <- Decoding.decodeInt

                                tokenType₂ <- Decoding.peekTokenType

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

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

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

                                        return (-1 - i)

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

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

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

                                return (TimeLiteral (Time.TimeOfDay hh mm ss) precision)
                            Word
32 -> do
                                b   <- Decoder s Bool
forall s. Decoder s Bool
Decoding.decodeBool
                                _HH <- Decoding.decodeInt
                                _MM <- Decoding.decodeInt

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

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

                                return (TimeZoneLiteral (Time.TimeZone minutes False ""))

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

                                return (BytesLit b)

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

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

            TokenType
_ ->
                String -> Decoder s (Expr s a)
forall {m :: * -> *} {a}. MonadFail m => String -> m a
die (String
"Unexpected initial token: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TokenType -> String
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 = Expr Void a -> Encoding
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
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Text -> Encoding
Encoding.encodeString Text
x
            Encoding -> Encoding -> Encoding
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{} ->
            Int -> [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Expr s a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr s a]
arguments)
                ( Int -> Encoding
Encoding.encodeInt Int
0
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: Expr s a -> Encoding
go Expr s a
function
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: (Expr s a -> Encoding) -> [Expr s a] -> [Encoding]
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) = Expr s a -> (Expr s a, [Expr s a])
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
            | Seq (Expr s a) -> Bool
forall a. Seq a -> Bool
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 ->
                Int -> [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                    (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq (Expr s a) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Expr s a)
xs)
                    ( Int -> Encoding
Encoding.encodeInt Int
4
                    Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: Encoding
Encoding.encodeNull
                    Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: (Expr s a -> Encoding) -> [Expr s a] -> [Encoding]
forall a b. (a -> b) -> [a] -> [b]
map Expr s a -> Encoding
go (Seq (Expr s a) -> [Expr s a]
forall a. Seq a -> [a]
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)
                ((RecordField s a -> Encoding)
-> Map Text (RecordField s a) -> Encoding
forall {t}. (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith (Expr s a -> Encoding
go (Expr s a -> Encoding)
-> (RecordField s a -> Expr s a) -> RecordField s a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s a -> Expr s a
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)
                ((RecordField s a -> Encoding)
-> Map Text (RecordField s a) -> Encoding
forall {t}. (t -> Encoding) -> Map Text t -> Encoding
encodeMapWith (Expr s a -> Encoding
go(Expr s a -> Encoding)
-> (RecordField s a -> Expr s a) -> RecordField s a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s a -> Expr s a
forall s a. RecordField s a -> Expr s a
recordFieldValue) Map Text (RecordField s a)
xts)

        Field Expr s a
t (FieldSelection s -> Text
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) ->
            Int -> [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs)
                ( Int -> Encoding
Encoding.encodeInt Int
10
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: Expr s a -> Encoding
go Expr s a
t
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: (Text -> Encoding) -> [Text] -> [Encoding]
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)
                ((Maybe (Expr s a) -> Encoding)
-> Map Text (Maybe (Expr s a)) -> Encoding
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 (Natural -> Integer
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 (Integer -> Integer
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 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Float -> Double
float2Double Float
n32

            useHalf :: Bool
useHalf = Double
n64 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== (Float -> Double
float2Double (Float -> Double) -> Float -> Double
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) ->
            Int -> [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Text, Expr s a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Expr s a)]
xys)
                ( Int -> Encoding
Encoding.encodeInt Int
18
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: ((Text, Expr s a) -> [Encoding])
-> [(Text, Expr s a)] -> [Encoding]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, Expr s a) -> [Encoding]
encodePair [(Text, Expr s a)]
xys [Encoding] -> [Encoding] -> [Encoding]
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₀ ->
            Int -> [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN
                (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* NonEmpty (Binding s a) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Binding s a)
as)
                ( Int -> Encoding
Encoding.encodeInt Int
25
                Encoding -> [Encoding] -> [Encoding]
forall a. a -> [a] -> [a]
: (Binding s a -> [Encoding]) -> [Binding s a] -> [Encoding]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binding s a -> [Encoding]
encodeBinding (NonEmpty (Binding s a) -> [Binding s a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Binding s a)
as) [Encoding] -> [Encoding] -> [Encoding]
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₁ = Binding s a -> Expr s a -> MultiLet s a
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)
                (NonEmpty Encoding -> Encoding
forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList ((WithComponent -> Encoding)
-> NonEmpty WithComponent -> NonEmpty Encoding
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
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 (Integer -> Int
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
                Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  Encoding -> Encoding -> Encoding
encodeList2
                        (Int -> Encoding
Encoding.encodeInt Int
exponent)
                        Encoding
encodedMantissa
                )
          where
            exponent :: Int
exponent = Int -> Int
forall a. Num a => a -> a
negate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
precision)

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

            encodedMantissa :: Encoding
encodedMantissa
                |  Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mantissa
                Bool -> Bool -> Bool
&& Integer
mantissa Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int) =
                    Int -> Encoding
Encoding.encodeInt (Integer -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
minutes

            (Int
_HH, Int
_MM) = Int -> Int
forall a. Num a => a -> a
abs Int
minutes Int -> Int -> (Int, Int)
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 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map Text t -> Int
forall k v. Map k v -> Int
Dhall.Map.size Map Text t
m))
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>  ((Text, t) -> Encoding) -> [(Text, t)] -> Encoding
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text, t) -> Encoding
encodeKeyValue (Map Text t -> [(Text, t)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList (Map Text t -> Map Text t
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 Encoding -> Encoding -> Encoding
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 Encoding -> Encoding -> Encoding
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
a Encoding -> Encoding -> Encoding
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b Encoding -> Encoding -> Encoding
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
c Encoding -> Encoding -> Encoding
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 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f Encoding -> Encoding
forall m. Monoid m => f m -> m
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 = Int -> f Encoding -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN (f Encoding -> Int
forall a. f a -> Int
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 = String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeImport: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message)

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

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

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

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

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

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

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

    m <- Decoding.decodeWord

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

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

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

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

                    return (Just headers)

            authority <- Decoding.decodeString

            paths <- replicateDecoder (len - 8) Decoding.decodeString

            file <- Decoding.decodeString

            tokenType₂ <- Decoding.peekTokenType

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

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

            return (Remote (URL {..}))

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

            file <- Decoding.decodeString

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

            return (Local prefix (File {..}))

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

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

            return (Env x)

    n <- Decoding.decodeWord

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

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

    return (Import {..})

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 :: URL -> Maybe (Expr Src Import)
query :: URL -> Maybe Text
path :: URL -> File
authority :: URL -> Text
authority :: Text
path :: File
query :: Maybe Text
headers :: Maybe (Expr Src Import)
.. }) ->
            [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList
                (   [Encoding]
prefix
                [Encoding] -> [Encoding] -> [Encoding]
forall a. [a] -> [a] -> [a]
++  [ Int -> Encoding
Encoding.encodeInt Int
scheme₁
                    , Encoding
using
                    , Text -> Encoding
Encoding.encodeString Text
authority
                    ]
                [Encoding] -> [Encoding] -> [Encoding]
forall a. [a] -> [a] -> [a]
++  (Text -> Encoding) -> [Text] -> [Encoding]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Encoding
Encoding.encodeString ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
components)
                [Encoding] -> [Encoding] -> [Encoding]
forall a. [a] -> [a] -> [a]
++  [ Text -> Encoding
Encoding.encodeString Text
file ]
                [Encoding] -> [Encoding] -> [Encoding]
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 ->
                    (Import -> Encoding) -> Expr Void Import -> Encoding
forall a. (a -> Encoding) -> Expr Void a -> Encoding
encodeExpressionInternal Import -> Encoding
encodeImport (Expr Src Import -> Expr Void Import
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
file :: File -> Text
directory :: File -> Directory
file :: Text
directory :: Directory
..} = File
path

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

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

            Directory{[Text]
components :: Directory -> [Text]
components :: [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₁ = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
components

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

        ImportType
Missing ->
            [Encoding] -> Encoding
forall (f :: * -> *). Foldable f => f Encoding -> Encoding
encodeList ([Encoding]
prefix [Encoding] -> [Encoding] -> [Encoding]
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" ByteString -> ByteString -> ByteString
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
importMode :: Import -> ImportMode
importHashed :: Import -> ImportHashed
importMode :: ImportMode
importHashed :: ImportHashed
..} = Import
import_

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

decodeVoid :: Int -> Decoder s Void
decodeVoid :: forall s. Int -> Decoder s Void
decodeVoid Int
_ = String -> Decoder s Void
forall a. String -> Decoder s a
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 = Void -> Encoding
forall a. Void -> a
absurd

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

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

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

    decode :: forall s. Decoder s (Expr Void Import)
decode = (Int -> Decoder s Import) -> Decoder s (Expr Void Import)
forall s a t. (Int -> Decoder s a) -> Decoder s (Expr t a)
decodeExpressionInternal Int -> Decoder s Import
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 = Expr Void a -> ByteString
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 Maybe (Expr s a) -> Maybe (Expr s a) -> Maybe (Expr s a)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Expr s a)
decodeWithVersion of
        Just Expr s a
expression -> Expr s a -> Either DecodingFailure (Expr s a)
forall a b. b -> Either a b
Right Expr s a
expression
        Maybe (Expr s a)
Nothing         -> DecodingFailure -> Either DecodingFailure (Expr s a)
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)) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    adapt  Either a (a, a)
_              = Maybe a
forall a. Maybe a
Nothing

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

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

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

            version <- 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 (version == "_")
                then fail "Dhall.Binary.decodeExpression: \"_\" is not a valid version string"
                else return ()

            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 <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType

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

            if w /= 55799
                then fail ("Dhall.Binary.decodeWith55799Tag: Unexpected tag: " <> show w)
                else return ()

            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
(DecodingFailure -> DecodingFailure -> Bool)
-> (DecodingFailure -> DecodingFailure -> Bool)
-> Eq DecodingFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodingFailure -> DecodingFailure -> Bool
== :: DecodingFailure -> DecodingFailure -> Bool
$c/= :: DecodingFailure -> DecodingFailure -> Bool
/= :: 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 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": Cannot decode CBOR to Dhall\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  String
"The following bytes do not encode a valid Dhall expression\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  String
"\n"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<>  String
"↳ 0x" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
toHex (ByteString -> [Word8]
Data.ByteString.Lazy.unpack ByteString
bytes) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
      where
        toHex :: Word8 -> String
toHex = String -> Word8 -> String
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 = Int -> Decoder s [a]
forall {t}. (Ord t, Num t) => t -> Decoder s [a]
go Int
n0
  where
    go :: t -> Decoder s [a]
go t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = [a] -> Decoder s [a]
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      | Bool
otherwise = do
            x <- Decoder s a
decoder
            xs <- go (n - 1)
            pure (x:xs)