{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Dhall.Binary
(
encodeExpression
, decodeExpression
, 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
unApply :: Expr s a -> (Expr s a, [Expr s a])
unApply :: 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 :: (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 (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
tokenType₀ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₀ of
TokenType
TypeUInt -> do
!Int
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"_" Int
n))
TokenType
TypeUInt64 -> do
!Int
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
"_" Int
n))
TokenType
TypeFloat16 -> do
!Double
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))
TokenType
TypeFloat32 -> do
!Double
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))
TokenType
TypeFloat64 -> do
!Double
n <- Decoder s Double
forall s. Decoder s Double
Decoding.decodeDouble
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (DhallDouble -> Expr s a
forall s a. DhallDouble -> Expr s a
DoubleLit (Double -> DhallDouble
DhallDouble Double
n))
TokenType
TypeBool -> do
!Bool
b <- Decoder s Bool
forall s. Decoder s Bool
Decoding.decodeBool
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Expr s a
forall s a. Bool -> Expr s a
BoolLit Bool
b)
TokenType
TypeString -> do
!ByteArray
ba <- Decoder s ByteArray
forall s. Decoder s ByteArray
Decoding.decodeUtf8ByteArray
let sb :: ShortByteString
sb = ByteArray -> ShortByteString
Codec.CBOR.ByteArray.toShortByteString ByteArray
ba
case ShortByteString -> Int
Data.ByteString.Short.length ShortByteString
sb of
Int
4 | ShortByteString
sb ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
"Bool" -> Expr s a -> Decoder s (Expr 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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Sort)
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 (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 (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 (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 (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 (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
"List/fold" -> Expr s a -> Decoder s (Expr 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Expr s a
forall s a. Expr s a
TextShow
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Expr s a
forall s a. Expr s a
NaturalBuild
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 (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 (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 (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 (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 (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
Int
len <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeListLen
case Int
len of
Int
0 -> String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
die String
"Missing tag"
Int
_ -> () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TokenType
tokenType₁ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₁ of
TokenType
TypeString -> do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_"
then String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
die String
"Non-standard encoding of an α-normalized variable"
else () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₂ of
TokenType
TypeUInt -> do
!Int
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
n))
TokenType
TypeUInt64 -> do
!Int
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Var -> Expr s a
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x Int
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
Word
tag <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeWord
case Word
tag of
Word
0 -> do
!Expr s a
f <- Decoder s (Expr s a)
go
let loop :: t -> Expr s a -> Decoder s (Expr s a)
loop t
n !Expr s a
acc
| t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr s a
acc
| Bool
otherwise = do
!Expr s a
x <- Decoder s (Expr s a)
go
t -> Expr s a -> Decoder s (Expr s a)
loop (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
acc Expr s a
x)
let nArgs :: Int
nArgs = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
if Int
nArgs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then String -> Decoder s (Expr s a)
forall (m :: * -> *) a. MonadFail m => String -> m a
die String
"Non-standard encoding of a function with no arguments"
else Int -> Expr s a -> Decoder s (Expr s a)
forall t. (Ord t, Num t) => t -> Expr s a -> Decoder s (Expr s a)
loop Int
nArgs Expr s a
f
Word
1 ->
case Int
len of
Int
3 -> do
Expr s a
_A <- Decoder s (Expr s a)
go
Expr s a
b <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
forall a. Monoid a => a
mempty (Text -> Expr s a -> FunctionBinding s a
forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
"_" Expr s a
_A) Expr s a
b)
Int
4 -> do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_"
then String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
die String
"Non-standard encoding of a λ expression"
else () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Expr s a
_A <- Decoder s (Expr s a)
go
Expr s a
b <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
forall a. Monoid a => a
mempty (Text -> Expr s a -> FunctionBinding s a
forall s a. Text -> Expr s a -> FunctionBinding s a
Syntax.makeFunctionBinding Text
x Expr s a
_A) Expr s 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
Expr s a
_A <- Decoder s (Expr s a)
go
Expr s a
_B <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Monoid a => a
mempty Text
"_" Expr s a
_A Expr s a
_B)
Int
4 -> do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_"
then String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
die String
"Non-standard encoding of a ∀ expression"
else () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Expr s a
_A <- Decoder s (Expr s a)
go
Expr s a
_B <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
forall a. Monoid a => a
mempty Text
x Expr s a
_A Expr s 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
Word
opcode <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeWord
Expr s a -> Expr s a -> Expr s a
op <- case Word
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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Monoid a => a
mempty PreferAnnotation s a
forall s a. PreferAnnotation s a
PreferFromSource)
Word
10 -> (Expr s a -> Expr s a -> Expr s a)
-> Decoder s (Expr s a -> Expr s a -> Expr 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 (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 (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 (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)
Expr s a
l <- Decoder s (Expr s a)
go
Expr s a
r <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a -> Expr s a
op Expr s a
l Expr s a
r)
Word
4 ->
case Int
len of
Int
2 -> do
Expr s a
_T <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
forall s a. Expr s a
List Expr s a
_T)) Seq (Expr s a)
forall (f :: * -> *) a. Alternative f => f a
empty)
Int
_ -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Seq (Expr s a)
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit Maybe (Expr s a)
forall a. Maybe a
Nothing Seq (Expr s a)
xs)
Word
5 -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Some Expr s a
t)
Word
6 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a
u <- Decoder s (Expr s a)
go
case Int
len of
Int
3 ->
Expr s a -> Decoder s (Expr 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
Expr s a
_T <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr 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 (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
_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
Int
mapLength <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeMapLen
[(Text, RecordField s a)]
xTs <- Int
-> Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)]
forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength (Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)])
-> Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)]
forall a b. (a -> b) -> a -> b
$ do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Expr s a
_T <- Decoder s (Expr s a)
go
(Text, RecordField s a) -> Decoder s (Text, RecordField s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Syntax.makeRecordField Expr s a
_T)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
Record ([(Text, RecordField s a)] -> Map Text (RecordField s a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, RecordField s a)]
xTs))
Word
8 -> do
Int
mapLength <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeMapLen
[(Text, RecordField s a)]
xts <- Int
-> Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)]
forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength (Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)])
-> Decoder s (Text, RecordField s a)
-> Decoder s [(Text, RecordField s a)]
forall a b. (a -> b) -> a -> b
$ do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Expr s a
t <- Decoder s (Expr s a)
go
(Text, RecordField s a) -> Decoder s (Text, RecordField s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Expr s a -> RecordField s a
forall s a. Expr s a -> RecordField s a
Syntax.makeRecordField Expr s a
t)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (RecordField s a) -> Expr s a
forall s a. Map Text (RecordField s a) -> Expr s a
RecordLit ([(Text, RecordField s a)] -> Map Text (RecordField s a)
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, RecordField s a)]
xts))
Word
9 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> FieldSelection s -> Expr s a
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s a
t (Text -> FieldSelection s
forall s. Text -> FieldSelection s
Syntax.makeFieldSelection Text
x))
Word
10 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Either [Text] (Expr s a)
xs <- case Int
len of
Int
3 -> do
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₂ of
TokenType
TypeListLen -> do
Int
_ <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeListLen
Expr s a
_T <- Decoder s (Expr s a)
go
Either [Text] (Expr s a) -> Decoder s (Either [Text] (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Either [Text] (Expr s a)
forall a b. b -> Either a b
Right Expr s a
_T)
TokenType
TypeString -> do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Either [Text] (Expr s a) -> Decoder s (Either [Text] (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either [Text] (Expr s a)
forall a b. a -> Either a b
Left [Text
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
[Text]
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
Either [Text] (Expr s a) -> Decoder s (Either [Text] (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either [Text] (Expr s a)
forall a b. a -> Either a b
Left [Text]
xs)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Either [Text] (Expr s a) -> Expr s a
forall s a. Expr s a -> Either [Text] (Expr s a) -> Expr s a
Project Expr s a
t Either [Text] (Expr s a)
xs)
Word
11 -> do
Int
mapLength <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeMapLen
[(Text, Maybe (Expr s a))]
xTs <- Int
-> Decoder s (Text, Maybe (Expr s a))
-> Decoder s [(Text, Maybe (Expr s a))]
forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
mapLength (Decoder s (Text, Maybe (Expr s a))
-> Decoder s [(Text, Maybe (Expr s a))])
-> Decoder s (Text, Maybe (Expr s a))
-> Decoder s [(Text, Maybe (Expr s a))]
forall a b. (a -> b) -> a -> b
$ do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Maybe (Expr s a)
mT <- case TokenType
tokenType₂ of
TokenType
TypeNull -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Maybe (Expr s a) -> Decoder s (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Expr s a)
forall a. Maybe a
Nothing
TokenType
_ -> do
Expr s a
_T <- Decoder s (Expr s a)
go
Maybe (Expr s a) -> Decoder s (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
_T)
(Text, Maybe (Expr s a)) -> Decoder s (Text, Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Maybe (Expr s a)
mT)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text (Maybe (Expr s a)) -> Expr s a
forall s a. Map Text (Maybe (Expr s a)) -> Expr s a
Union ([(Text, Maybe (Expr s a))] -> Map Text (Maybe (Expr s a))
forall k v. Ord k => [(k, v)] -> Map k v
Dhall.Map.fromList [(Text, Maybe (Expr s a))]
xTs))
Word
14 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a
l <- Decoder s (Expr s a)
go
Expr s a
r <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
BoolIf Expr s a
t Expr s a
l Expr s a
r)
Word
15 -> do
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₂ of
TokenType
TypeUInt -> do
!Natural
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit Natural
n)
TokenType
TypeUInt64 -> do
!Natural
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit Natural
n)
TokenType
TypeInteger -> do
!Natural
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Natural -> Expr s a
forall s a. Natural -> Expr s a
NaturalLit Natural
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
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₂ of
TokenType
TypeUInt -> do
!Integer
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit Integer
n)
TokenType
TypeUInt64 -> do
!Integer
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit Integer
n)
TokenType
TypeNInt -> do
!Integer
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> Integer -> Expr s a
forall a b. (a -> b) -> a -> b
$! (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n))
TokenType
TypeNInt64 -> do
!Integer
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
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit (Integer -> Expr s a) -> Integer -> Expr s a
forall a b. (a -> b) -> a -> b
$! (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n))
TokenType
TypeInteger -> do
Integer
n <- Decoder s Integer
forall s. Decoder s Integer
Decoding.decodeInteger
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Expr s a
forall s a. Integer -> Expr s a
IntegerLit Integer
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
[(Text, Expr s a)]
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
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Expr s a
y <- Decoder s (Expr s a)
go
(Text, Expr s a) -> Decoder s (Text, Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Expr s a
y)
Text
z <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Chunks s a -> Expr s a
forall s a. Chunks s a -> Expr s a
TextLit ([(Text, Expr s a)] -> Text -> Chunks s a
forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
Chunks [(Text, Expr s a)]
xys Text
z))
Word
19 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Assert Expr s a
t)
Word
24 ->
(a -> Expr s a) -> Decoder s a -> Decoder s (Expr s a)
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
[Binding s a]
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
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Maybe (Maybe s, Expr s a)
mA <- case TokenType
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe (Maybe s, Expr s a)
forall a. Maybe a
Nothing
TokenType
_ -> do
Expr s a
_A <- Decoder s (Expr s a)
go
Maybe (Maybe s, Expr s a) -> Decoder s (Maybe (Maybe s, Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe s, Expr s a) -> Maybe (Maybe s, Expr s a)
forall a. a -> Maybe a
Just (Maybe s
forall a. Maybe a
Nothing, Expr s a
_A))
Expr s a
a <- Decoder s (Expr s a)
go
Binding s a -> Decoder s (Binding s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding Maybe s
forall a. Maybe a
Nothing Text
x Maybe s
forall a. Maybe a
Nothing Maybe (Maybe s, Expr s a)
mA Maybe s
forall a. Maybe a
Nothing Expr s a
a)
Expr s a
b <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Binding s a -> Expr s a -> Expr s a)
-> Expr s a -> [Binding s a] -> Expr s a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Binding s a -> Expr s a -> Expr s a
forall s a. Binding s a -> Expr s a -> Expr s a
Let Expr s a
b [Binding s a]
bindings)
Word
26 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a
_T <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr 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
Annot Expr s a
t Expr s a
_T)
Word
27 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Maybe (Expr s a)
mT <- case Int
len of
Int
2 ->
Maybe (Expr s a) -> Decoder s (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Expr s a)
forall a. Maybe a
Nothing
Int
3 -> do
Expr s a
_T <- Decoder s (Expr s a)
go
Maybe (Expr s a) -> Decoder s (Maybe (Expr s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
_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)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Maybe (Expr s a) -> Expr s a
forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
ToMap Expr s a
t Maybe (Expr s a)
mT)
Word
28 -> do
Expr s a
_T <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
forall s a. Maybe (Expr s a) -> Seq (Expr s a) -> Expr s a
ListLit (Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just Expr s a
_T) Seq (Expr s a)
forall (f :: * -> *) a. Alternative f => f a
empty)
Word
29 -> do
Expr s a
l <- Decoder s (Expr s a)
go
Int
n <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeListLen
let decodeWithComponent :: Decoder s WithComponent
decodeWithComponent = do
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType₂ of
TokenType
TypeString -> do
(Text -> WithComponent)
-> Decoder s Text -> Decoder s WithComponent
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
Int
m <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
case Int
m of
Int
0 -> WithComponent -> Decoder s WithComponent
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)
[WithComponent]
ks₀ <- Int -> Decoder s WithComponent -> Decoder s [WithComponent]
forall s a. Int -> Decoder s a -> Decoder s [a]
replicateDecoder Int
n Decoder s WithComponent
forall s. Decoder s WithComponent
decodeWithComponent
NonEmpty WithComponent
ks₁ <- case [WithComponent] -> Maybe (NonEmpty WithComponent)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [WithComponent]
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 (m :: * -> *) a. Monad m => a -> m a
return NonEmpty WithComponent
ks₁
Expr s a
r <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
forall s a.
Expr s a -> NonEmpty WithComponent -> Expr s a -> Expr s a
With Expr s a
l NonEmpty WithComponent
ks₁ Expr s a
r)
Word
30 -> do
Int
_YYYY <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
Int
_MM <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
Int
_HH <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
case Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
_YYYY) Int
_MM Int
_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 (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
Int
hh <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
Int
mm <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
Word
tag₂ <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeTag
case Word
tag₂ of
Word
4 -> do
() -> Decoder s ()
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)
Int
n <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeListLen
case Int
n of
Int
2 -> do
() -> Decoder s ()
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)
Int
exponent <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Integer
mantissa <- case TokenType
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
!Integer
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
Integer -> Decoder s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i)
TokenType
TypeNInt64 -> do
!Integer
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
Integer -> Decoder s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (-Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
i)
TokenType
TypeInteger -> do
Decoder s Integer
forall s. Decoder s Integer
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 :: Word
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 :: Pico
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))
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay -> Word -> Expr s a
forall s a. TimeOfDay -> Word -> Expr s a
TimeLiteral (Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Int
hh Int
mm Pico
ss) Word
precision)
Word
32 -> do
Bool
b <- Decoder s Bool
forall s. Decoder s Bool
Decoding.decodeBool
Int
_HH <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
Int
_MM <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeInt
let sign :: Int -> Int
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
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)
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> Expr s a
forall s a. TimeZone -> Expr s a
TimeZoneLiteral (Int -> Bool -> String -> TimeZone
Time.TimeZone Int
minutes Bool
False String
""))
Word
34 -> do
Expr s a
t <- Decoder s (Expr s a)
go
Expr s a -> Decoder s (Expr s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
ShowConstructor Expr s a
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 :: (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
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
Time ->
SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"Time"
Expr s a
TimeZone ->
SlicedByteArray -> Encoding
Encoding.encodeUtf8ByteArray SlicedByteArray
"TimeZone"
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 (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
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 s a
_ 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 (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 (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 (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 (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)
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 (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 (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 (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 (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 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 (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 :: 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 (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold f Encoding
xs
{-# INLINE encodeListN #-}
encodeList :: Foldable f => f Encoding -> Encoding
encodeList :: f Encoding -> Encoding
encodeList f Encoding
xs = Int -> f Encoding -> Encoding
forall (f :: * -> *). Foldable f => Int -> f Encoding -> Encoding
encodeListN (f Encoding -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length f Encoding
xs) f Encoding
xs
{-# INLINE encodeList #-}
decodeImport :: Int -> Decoder s Import
decodeImport :: Int -> Decoder s Import
decodeImport Int
len = do
let die :: String -> m a
die String
message = 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
tokenType₀ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Maybe SHA256Digest
hash <- case TokenType
tokenType₀ of
TokenType
TypeNull -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Maybe SHA256Digest -> Decoder s (Maybe SHA256Digest)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SHA256Digest
forall a. Maybe a
Nothing
TokenType
TypeBytes -> do
ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
Decoding.decodeBytes
let (ByteString
prefix, ByteString
suffix) = Int -> ByteString -> (ByteString, ByteString)
Data.ByteString.splitAt Int
2 ByteString
bytes
case ByteString
prefix of
ByteString
"\x12\x20" -> () -> Decoder s ()
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 ByteString -> Maybe SHA256Digest
Dhall.Crypto.sha256DigestFromByteString ByteString
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 (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₀)
Word
m <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeWord
ImportMode
importMode <- case Word
m of
Word
0 -> ImportMode -> Decoder s ImportMode
forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
Code
Word
1 -> ImportMode -> Decoder s ImportMode
forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
RawText
Word
2 -> ImportMode -> Decoder s ImportMode
forall (m :: * -> *) a. Monad m => a -> m a
return ImportMode
Location
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 -> Decoder s ImportType
remote Scheme
scheme = do
TokenType
tokenType₁ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Maybe (Expr Src Import)
headers <- case TokenType
tokenType₁ of
TokenType
TypeNull -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Maybe (Expr Src Import) -> Decoder s (Maybe (Expr Src Import))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Expr Src Import)
forall a. Maybe a
Nothing
TokenType
_ -> do
Expr Src Import
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
Maybe (Expr Src Import) -> Decoder s (Maybe (Expr Src Import))
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Src Import -> Maybe (Expr Src Import)
forall a. a -> Maybe a
Just Expr Src Import
headers)
Text
authority <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
[Text]
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
8) Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
Text
file <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
TokenType
tokenType₂ <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
Maybe Text
query <- case TokenType
tokenType₂ of
TokenType
TypeNull -> do
Decoder s ()
forall s. Decoder s ()
Decoding.decodeNull
Maybe Text -> Decoder s (Maybe Text)
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 (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]
components = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
paths
let directory :: Directory
directory = Directory :: [Text] -> Directory
Directory {[Text]
components :: [Text]
components :: [Text]
..}
let path :: File
path = File :: Directory -> Text -> File
File {Text
Directory
file :: Text
directory :: Directory
directory :: Directory
file :: Text
..}
ImportType -> Decoder s ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (URL -> ImportType
Remote (URL :: Scheme
-> Text -> File -> Maybe Text -> Maybe (Expr Src Import) -> URL
URL {Maybe Text
Maybe (Expr Src Import)
Text
Scheme
File
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
authority :: Text
scheme :: Scheme
path :: File
query :: Maybe Text
authority :: Text
headers :: Maybe (Expr Src Import)
scheme :: Scheme
..}))
let local :: FilePrefix -> Decoder s ImportType
local FilePrefix
prefix = do
[Text]
paths <- 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
Text
file <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
let components :: [Text]
components = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
paths
let directory :: Directory
directory = Directory :: [Text] -> Directory
Directory {[Text]
components :: [Text]
components :: [Text]
..}
ImportType -> Decoder s ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePrefix -> File -> ImportType
Local FilePrefix
prefix (File :: Directory -> Text -> File
File {Text
Directory
directory :: Directory
file :: Text
file :: Text
directory :: Directory
..}))
let missing :: Decoder s ImportType
missing = ImportType -> Decoder s ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return ImportType
Missing
let env :: Decoder s ImportType
env = do
Text
x <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
ImportType -> Decoder s ImportType
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ImportType
Env Text
x)
Word
n <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeWord
ImportType
importType <- case Word
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 (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
importHashed = ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
ImportHashed {Maybe SHA256Digest
ImportType
importType :: ImportType
hash :: Maybe SHA256Digest
importType :: ImportType
hash :: Maybe SHA256Digest
..}
Import -> Decoder s Import
forall (m :: * -> *) a. Monad m => a -> m a
return (Import :: ImportHashed -> ImportMode -> Import
Import {ImportHashed
ImportMode
importMode :: ImportMode
importHashed :: ImportHashed
importHashed :: ImportHashed
importMode :: ImportMode
..})
encodeImport :: Import -> Encoding
encodeImport :: Import -> Encoding
encodeImport Import
import_ =
case ImportType
importType of
Remote (URL { scheme :: URL -> Scheme
scheme = Scheme
scheme₀, Maybe Text
Maybe (Expr Src Import)
Text
File
headers :: Maybe (Expr Src Import)
query :: Maybe Text
path :: File
authority :: Text
headers :: URL -> Maybe (Expr Src Import)
query :: URL -> Maybe Text
path :: URL -> File
authority :: URL -> Text
.. }) ->
[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
directory :: Directory
file :: Text
file :: File -> Text
directory :: File -> Directory
..} = File
path
Directory {[Text]
components :: [Text]
components :: Directory -> [Text]
..} = Directory
directory
Local FilePrefix
prefix₀ File
path ->
[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
directory :: Directory
file :: Text
file :: File -> Text
directory :: File -> Directory
..} = File
path
Directory{[Text]
components :: [Text]
components :: Directory -> [Text]
..} = Directory
directory
prefix₁ :: Int
prefix₁ = case FilePrefix
prefix₀ of
FilePrefix
Absolute -> Int
2
FilePrefix
Here -> Int
3
FilePrefix
Parent -> Int
4
FilePrefix
Home -> Int
5
components₁ :: [Text]
components₁ = [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;)
Import{ImportHashed
ImportMode
importHashed :: ImportHashed
importMode :: ImportMode
importMode :: Import -> ImportMode
importHashed :: Import -> ImportHashed
..} = Import
import_
ImportHashed{Maybe SHA256Digest
ImportType
hash :: Maybe SHA256Digest
importType :: ImportType
importType :: ImportHashed -> ImportType
hash :: ImportHashed -> Maybe SHA256Digest
..} = ImportHashed
importHashed
decodeVoid :: Int -> Decoder s Void
decodeVoid :: Int -> Decoder s Void
decodeVoid Int
_ = String -> Decoder s Void
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 :: 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 :: 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
encodeExpression :: Serialise (Expr Void a) => Expr Void a -> ByteString
encodeExpression :: Expr Void a -> ByteString
encodeExpression = Expr Void a -> ByteString
forall a. Serialise a => a -> ByteString
Serialise.serialise
decodeExpression
:: Serialise (Expr s a) => ByteString -> Either DecodingFailure (Expr s a)
decodeExpression :: 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 (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 a s. Serialise a => Decoder s a
decode
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 forall s. Decoder s (Expr s a)
decode' ByteString
bytes)
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 forall s. Decoder s (Expr s a)
decodeWithTag ByteString
bytes)
where
decodeWithTag :: Decoder s (Expr s a)
decodeWithTag = do
Int
2 <- Decoder s Int
forall s. Decoder s Int
Decoding.decodeListLen
Text
version <- Decoder s Text
forall s. Decoder s Text
Decoding.decodeString
if (Text
version Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"_")
then String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Dhall.Binary.decodeExpression: \"_\" is not a valid version string"
else () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Decoder s (Expr s a)
forall s. Decoder s (Expr s a)
decode'
decodeWith55799Tag :: Decoder s a -> Decoder s a
decodeWith55799Tag :: Decoder s a -> Decoder s a
decodeWith55799Tag Decoder s a
decoder = do
TokenType
tokenType <- Decoder s TokenType
forall s. Decoder s TokenType
Decoding.peekTokenType
case TokenType
tokenType of
TokenType
TypeTag -> do
Word
w <- Decoder s Word
forall s. Decoder s Word
Decoding.decodeTag
if Word
w Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
55799
then String -> Decoder s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Dhall.Binary.decodeWith55799Tag: Unexpected tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
w)
else () -> Decoder s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Decoder s a
decoder
TokenType
_ ->
Decoder s a
decoder
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
/= :: DecodingFailure -> DecodingFailure -> Bool
$c/= :: DecodingFailure -> DecodingFailure -> Bool
== :: DecodingFailure -> DecodingFailure -> Bool
$c== :: DecodingFailure -> DecodingFailure -> Bool
Eq)
instance Exception DecodingFailure
_ERROR :: String
_ERROR :: String
_ERROR = String
"\ESC[1;31mError\ESC[0m"
instance Show DecodingFailure where
show :: DecodingFailure -> String
show (CBORIsNotDhall ByteString
bytes) =
String
_ERROR 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 "
replicateDecoder :: Int -> Decoder s a -> Decoder s [a]
replicateDecoder :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = do
a
x <- Decoder s a
decoder
[a]
xs <- t -> Decoder s [a]
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
[a] -> Decoder s [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)