-- | A DSL for decoding Hydra terms

module Hydra.Dsl.Expect where

import Hydra.Compute
import Hydra.Core
import Hydra.Graph
import Hydra.Strip
import Hydra.Tier1
import Hydra.Tier2
import qualified Hydra.Lib.Flows as Flows

import Prelude hiding (map)
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y
import qualified Control.Monad as CM
import Data.Int


bigfloat :: Term -> Flow s Double
bigfloat :: forall s. Term -> Flow s Double
bigfloat Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s FloatValue) -> Flow s FloatValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s FloatValue
forall s. Literal -> Flow s FloatValue
floatLiteral Flow s FloatValue -> (FloatValue -> Flow s Double) -> Flow s Double
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatValue -> Flow s Double
forall s. FloatValue -> Flow s Double
bigfloatValue

bigfloatValue :: FloatValue -> Flow s Double
bigfloatValue :: forall s. FloatValue -> Flow s Double
bigfloatValue FloatValue
v = case FloatValue
v of
  FloatValueBigfloat Double
f -> Double -> Flow s Double
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
f
  FloatValue
_ -> String -> String -> Flow s Double
forall s x. String -> String -> Flow s x
unexpected String
"bigfloat" (String -> Flow s Double) -> String -> Flow s Double
forall a b. (a -> b) -> a -> b
$ FloatValue -> String
forall a. Show a => a -> String
show FloatValue
v

bigint :: Term -> Flow s Integer
bigint :: forall s. Term -> Flow s Integer
bigint Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Integer) -> Flow s Integer
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Integer
forall s. IntegerValue -> Flow s Integer
bigintValue

bigintValue :: IntegerValue -> Flow s Integer
bigintValue :: forall s. IntegerValue -> Flow s Integer
bigintValue IntegerValue
v = case IntegerValue
v of
  IntegerValueBigint Integer
i -> Integer -> Flow s Integer
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
  IntegerValue
_ -> String -> String -> Flow s Integer
forall s x. String -> String -> Flow s x
unexpected String
"bigint" (String -> Flow s Integer) -> String -> Flow s Integer
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

binary :: Term -> Flow s String
binary :: forall s. Term -> Flow s String
binary Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal -> (Literal -> Flow s String) -> Flow s String
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s String
forall s. Literal -> Flow s String
binaryLiteral

binaryLiteral :: Literal -> Flow s String
binaryLiteral :: forall s. Literal -> Flow s String
binaryLiteral Literal
v = case Literal
v of
  LiteralBinary String
b -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
b
  Literal
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"binary" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
v

boolean :: Term -> Flow s Bool
boolean :: forall s. Term -> Flow s Bool
boolean Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal -> (Literal -> Flow s Bool) -> Flow s Bool
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s Bool
forall s. Literal -> Flow s Bool
booleanLiteral

booleanLiteral :: Literal -> Flow s Bool
booleanLiteral :: forall s. Literal -> Flow s Bool
booleanLiteral Literal
v = case Literal
v of
  LiteralBoolean Bool
b -> Bool -> Flow s Bool
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
b
  Literal
_ -> String -> String -> Flow s Bool
forall s x. String -> String -> Flow s x
unexpected String
"boolean" (String -> Flow s Bool) -> String -> Flow s Bool
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
v

cases :: Name -> Term -> Flow s (CaseStatement)
cases :: forall s. Name -> Term -> Flow s CaseStatement
cases Name
name Term
term = case Term -> Term
strip Term
term of
  TermFunction (FunctionElimination (EliminationUnion CaseStatement
cs)) -> if CaseStatement -> Name
caseStatementTypeName CaseStatement
cs Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name
    then CaseStatement -> Flow s CaseStatement
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CaseStatement
cs
    else String -> String -> Flow s CaseStatement
forall s x. String -> String -> Flow s x
unexpected (String
"case statement for type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (String -> Flow s CaseStatement) -> String -> Flow s CaseStatement
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term
  Term
_ -> String -> String -> Flow s CaseStatement
forall s x. String -> String -> Flow s x
unexpected String
"case statement" (String -> Flow s CaseStatement) -> String -> Flow s CaseStatement
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

casesCase :: Name -> String -> Term -> Flow s (Field)
casesCase :: forall s. Name -> String -> Term -> Flow s Field
casesCase Name
name String
n Term
term = do
  CaseStatement
cs <- Name -> Term -> Flow s CaseStatement
forall s. Name -> Term -> Flow s CaseStatement
cases Name
name Term
term
  let matching :: [Field]
matching = (Field -> Bool) -> [Field] -> [Field]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\Field
f -> Field -> Name
fieldName Field
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
Name String
n) ([Field] -> [Field]) -> [Field] -> [Field]
forall a b. (a -> b) -> a -> b
$ CaseStatement -> [Field]
caseStatementCases CaseStatement
cs
  if [Field] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Field]
matching
    then String -> Flow s Field
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s Field) -> String -> Flow s Field
forall a b. (a -> b) -> a -> b
$ String
"not enough cases"
    else Field -> Flow s Field
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field -> Flow s Field) -> Field -> Flow s Field
forall a b. (a -> b) -> a -> b
$ [Field] -> Field
forall a. HasCallStack => [a] -> a
L.head [Field]
matching

field :: Name -> (Term -> Flow s x) -> [Field] -> Flow s x
field :: forall s x. Name -> (Term -> Flow s x) -> [Field] -> Flow s x
field Name
fname Term -> Flow s x
mapping [Field]
fields = case (Field -> Bool) -> [Field] -> [Field]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\Field
f -> Field -> Name
fieldName Field
f Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
fname) [Field]
fields of
  [] -> String -> Flow s x
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s x) -> String -> Flow s x
forall a b. (a -> b) -> a -> b
$ String
"field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
  [Field
f] -> Term -> Flow s x
mapping (Term -> Flow s x) -> Term -> Flow s x
forall a b. (a -> b) -> a -> b
$ Field -> Term
fieldTerm Field
f
  [Field]
_ -> String -> Flow s x
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s x) -> String -> Flow s x
forall a b. (a -> b) -> a -> b
$ String
"multiple fields named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
fname

float32 :: Term -> Flow s Float
float32 :: forall s. Term -> Flow s Float
float32 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s FloatValue) -> Flow s FloatValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s FloatValue
forall s. Literal -> Flow s FloatValue
floatLiteral Flow s FloatValue -> (FloatValue -> Flow s Float) -> Flow s Float
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatValue -> Flow s Float
forall s. FloatValue -> Flow s Float
float32Value

float32Value :: FloatValue -> Flow s Float
float32Value :: forall s. FloatValue -> Flow s Float
float32Value FloatValue
v = case FloatValue
v of
  FloatValueFloat32 Float
f -> Float -> Flow s Float
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
f
  FloatValue
_ -> String -> String -> Flow s Float
forall s x. String -> String -> Flow s x
unexpected String
"float32" (String -> Flow s Float) -> String -> Flow s Float
forall a b. (a -> b) -> a -> b
$ FloatValue -> String
forall a. Show a => a -> String
show FloatValue
v

float64 :: Term -> Flow s Double
float64 :: forall s. Term -> Flow s Double
float64 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s FloatValue) -> Flow s FloatValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s FloatValue
forall s. Literal -> Flow s FloatValue
floatLiteral Flow s FloatValue -> (FloatValue -> Flow s Double) -> Flow s Double
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FloatValue -> Flow s Double
forall s. FloatValue -> Flow s Double
float64Value

float64Value :: FloatValue -> Flow s Double
float64Value :: forall s. FloatValue -> Flow s Double
float64Value FloatValue
v = case FloatValue
v of
  FloatValueFloat64 Double
f -> Double -> Flow s Double
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
f
  FloatValue
_ -> String -> String -> Flow s Double
forall s x. String -> String -> Flow s x
unexpected String
"float64" (String -> Flow s Double) -> String -> Flow s Double
forall a b. (a -> b) -> a -> b
$ FloatValue -> String
forall a. Show a => a -> String
show FloatValue
v

floatLiteral :: Literal -> Flow s FloatValue
floatLiteral :: forall s. Literal -> Flow s FloatValue
floatLiteral Literal
lit = case Literal
lit of
  LiteralFloat FloatValue
v -> FloatValue -> Flow s FloatValue
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FloatValue
v
  Literal
_ -> String -> String -> Flow s FloatValue
forall s x. String -> String -> Flow s x
unexpected String
"floating-point value" (String -> Flow s FloatValue) -> String -> Flow s FloatValue
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
lit

inject :: Name -> Term -> Flow s (Field)
inject :: forall s. Name -> Term -> Flow s Field
inject Name
name Term
term = case Term -> Term
strip Term
term of
  TermUnion (Injection Name
name' Field
field) -> if Name
name' Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name
    then Field -> Flow s Field
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field
field
    else String -> String -> Flow s Field
forall s x. String -> String -> Flow s x
unexpected (String
"injection of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
name) (Name -> String
unName Name
name')
  Term
_ -> String -> String -> Flow s Field
forall s x. String -> String -> Flow s x
unexpected String
"injection" (String -> Flow s Field) -> String -> Flow s Field
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

injection :: Term -> Flow s (Field)
injection :: forall s. Term -> Flow s Field
injection Term
term = case Term -> Term
strip Term
term of
  TermUnion (Injection Name
_ Field
field) -> Field -> Flow s Field
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field
field
  Term
_ -> String -> String -> Flow s Field
forall s x. String -> String -> Flow s x
unexpected String
"injection" (String -> Flow s Field) -> String -> Flow s Field
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

injectionWithName :: Name -> Term -> Flow s (Field)
injectionWithName :: forall s. Name -> Term -> Flow s Field
injectionWithName Name
expected Term
term = case Term -> Term
strip Term
term of
  TermUnion (Injection Name
actual Field
field) -> if Name
actual Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
expected
    then Field -> Flow s Field
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Field
field
    else String -> String -> Flow s Field
forall s x. String -> String -> Flow s x
unexpected (String
"injection of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
expected) (Name -> String
unName Name
actual)
  Term
_ -> String -> String -> Flow s Field
forall s x. String -> String -> Flow s x
unexpected String
"injection" (String -> Flow s Field) -> String -> Flow s Field
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

int8 :: Term -> Flow s Int8
int8 :: forall s. Term -> Flow s Int8
int8 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue -> (IntegerValue -> Flow s Int8) -> Flow s Int8
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int8
forall s. IntegerValue -> Flow s Int8
int8Value

int8Value :: IntegerValue -> Flow s Int8
int8Value :: forall s. IntegerValue -> Flow s Int8
int8Value IntegerValue
v = case IntegerValue
v of
  IntegerValueInt8 Int8
i -> Int8 -> Flow s Int8
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int8
i
  IntegerValue
_ -> String -> String -> Flow s Int8
forall s x. String -> String -> Flow s x
unexpected String
"int8" (String -> Flow s Int8) -> String -> Flow s Int8
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

int16 :: Term -> Flow s Int16
int16 :: forall s. Term -> Flow s Int16
int16 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Int16) -> Flow s Int16
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int16
forall s. IntegerValue -> Flow s Int16
int16Value

int16Value :: IntegerValue -> Flow s Int16
int16Value :: forall s. IntegerValue -> Flow s Int16
int16Value IntegerValue
v = case IntegerValue
v of
  IntegerValueInt16 Int16
i -> Int16 -> Flow s Int16
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int16
i
  IntegerValue
_ -> String -> String -> Flow s Int16
forall s x. String -> String -> Flow s x
unexpected String
"int16" (String -> Flow s Int16) -> String -> Flow s Int16
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

int32 :: Term -> Flow s Int
int32 :: forall s. Term -> Flow s Int
int32 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue -> (IntegerValue -> Flow s Int) -> Flow s Int
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int
forall s. IntegerValue -> Flow s Int
int32Value

int32Value :: IntegerValue -> Flow s Int
int32Value :: forall s. IntegerValue -> Flow s Int
int32Value IntegerValue
v = case IntegerValue
v of
  IntegerValueInt32 Int
i -> Int -> Flow s Int
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  IntegerValue
_ -> String -> String -> Flow s Int
forall s x. String -> String -> Flow s x
unexpected String
"int32" (String -> Flow s Int) -> String -> Flow s Int
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

int64 :: Term -> Flow s Int64
int64 :: forall s. Term -> Flow s Int64
int64 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Int64) -> Flow s Int64
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int64
forall s. IntegerValue -> Flow s Int64
int64Value

int64Value :: IntegerValue -> Flow s Int64
int64Value :: forall s. IntegerValue -> Flow s Int64
int64Value IntegerValue
v = case IntegerValue
v of
  IntegerValueInt64 Int64
i -> Int64 -> Flow s Int64
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
i
  IntegerValue
_ -> String -> String -> Flow s Int64
forall s x. String -> String -> Flow s x
unexpected String
"int64" (String -> Flow s Int64) -> String -> Flow s Int64
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

integerLiteral :: Literal -> Flow s IntegerValue
integerLiteral :: forall s. Literal -> Flow s IntegerValue
integerLiteral Literal
lit = case Literal
lit of
  LiteralInteger IntegerValue
v -> IntegerValue -> Flow s IntegerValue
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntegerValue
v
  Literal
_ -> String -> String -> Flow s IntegerValue
forall s x. String -> String -> Flow s x
unexpected String
"integer value" (String -> Flow s IntegerValue) -> String -> Flow s IntegerValue
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
lit

lambda :: Term -> Flow s (Lambda)
lambda :: forall s. Term -> Flow s Lambda
lambda Term
term = case Term -> Term
strip Term
term of
  TermFunction (FunctionLambda Lambda
l) -> Lambda -> Flow s Lambda
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Lambda
l
  Term
_ -> String -> String -> Flow s Lambda
forall s x. String -> String -> Flow s x
unexpected String
"lambda" (String -> Flow s Lambda) -> String -> Flow s Lambda
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

letBinding :: String -> Term -> Flow s (Term)
letBinding :: forall s. String -> Term -> Flow s Term
letBinding String
n Term
term = do
  [LetBinding]
bindings <- Let -> [LetBinding]
letBindings (Let -> [LetBinding]) -> Flow s Let -> Flow s [LetBinding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Let
forall s. Term -> Flow s Let
letTerm Term
term
  case (LetBinding -> Bool) -> [LetBinding] -> [LetBinding]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (\LetBinding
b -> LetBinding -> Name
letBindingName LetBinding
b Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Name
Name String
n) [LetBinding]
bindings of
    [] -> String -> Flow s Term
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s Term) -> String -> Flow s Term
forall a b. (a -> b) -> a -> b
$ String
"no such binding: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n
    [LetBinding
b] -> Term -> Flow s Term
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Flow s Term) -> Term -> Flow s Term
forall a b. (a -> b) -> a -> b
$ LetBinding -> Term
letBindingTerm LetBinding
b
    [LetBinding]
_ -> String -> Flow s Term
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s Term) -> String -> Flow s Term
forall a b. (a -> b) -> a -> b
$ String
"multiple bindings named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n

lambdaBody :: Term -> Flow s (Term)
lambdaBody :: forall s. Term -> Flow s Term
lambdaBody Term
term = Lambda -> Term
Hydra.Core.lambdaBody (Lambda -> Term) -> Flow s Lambda -> Flow s Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s Lambda
forall s. Term -> Flow s Lambda
lambda Term
term

letTerm :: Term -> Flow s (Let)
letTerm :: forall s. Term -> Flow s Let
letTerm Term
term = case Term -> Term
strip Term
term of
  TermLet Let
lt -> Let -> Flow s Let
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Let
lt
  Term
_ -> String -> String -> Flow s Let
forall s x. String -> String -> Flow s x
unexpected String
"let term" (String -> Flow s Let) -> String -> Flow s Let
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

list :: (Term -> Flow s x) -> Term -> Flow s [x]
list :: forall s x. (Term -> Flow s x) -> Term -> Flow s [x]
list Term -> Flow s x
f Term
term = case Term -> Term
strip Term
term of
  TermList [Term]
l -> (Term -> Flow s x) -> [Term] -> Flow s [x]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow s x
f [Term]
l
  Term
_ -> String -> String -> Flow s [x]
forall s x. String -> String -> Flow s x
unexpected String
"list" (String -> Flow s [x]) -> String -> Flow s [x]
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

listHead :: Term -> Flow s (Term)
listHead :: forall s. Term -> Flow s Term
listHead Term
term = do
  [Term]
l <- (Term -> Flow s Term) -> Term -> Flow s [Term]
forall s x. (Term -> Flow s x) -> Term -> Flow s [x]
list Term -> Flow s Term
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
term
  if [Term] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Term]
l
    then String -> Flow s Term
forall a. String -> Flow s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty list"
    else Term -> Flow s Term
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Term -> Flow s Term) -> Term -> Flow s Term
forall a b. (a -> b) -> a -> b
$ [Term] -> Term
forall a. HasCallStack => [a] -> a
L.head [Term]
l

literal :: Term -> Flow s Literal
literal :: forall s. Term -> Flow s Literal
literal Term
term = case Term -> Term
strip Term
term of
  TermLiteral Literal
lit -> Literal -> Flow s Literal
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Literal
lit
  Term
_ -> String -> String -> Flow s Literal
forall s x. String -> String -> Flow s x
unexpected String
"literal" (String -> Flow s Literal) -> String -> Flow s Literal
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

map :: Ord k => (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (M.Map k v)
map :: forall k s v.
Ord k =>
(Term -> Flow s k)
-> (Term -> Flow s v) -> Term -> Flow s (Map k v)
map Term -> Flow s k
fk Term -> Flow s v
fv Term
term = case Term -> Term
strip Term
term of
  TermMap Map Term Term
m -> [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, v)] -> Map k v) -> Flow s [(k, v)] -> Flow s (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Term, Term) -> Flow s (k, v))
-> [(Term, Term)] -> Flow s [(k, v)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Term, Term) -> Flow s (k, v)
pair (Map Term Term -> [(Term, Term)]
forall k a. Map k a -> [(k, a)]
M.toList Map Term Term
m)
    where
      pair :: (Term, Term) -> Flow s (k, v)
pair (Term
kterm, Term
vterm) = do
        k
kval <- Term -> Flow s k
fk Term
kterm
        v
vval <- Term -> Flow s v
fv Term
vterm
        (k, v) -> Flow s (k, v)
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (k
kval, v
vval)
  Term
_ -> String -> String -> Flow s (Map k v)
forall s x. String -> String -> Flow s x
unexpected String
"map" (String -> Flow s (Map k v)) -> String -> Flow s (Map k v)
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

nArgs :: Int -> [Term] -> Flow s ()
nArgs :: forall s. Int -> [Term] -> Flow s ()
nArgs Int
n [Term]
args = if [Term] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Term]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n
  then String -> String -> Flow s ()
forall s x. String -> String -> Flow s x
unexpected (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" arguments") (String -> Flow s ()) -> String -> Flow s ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show ([Term] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Term]
args)
  else () -> Flow s ()
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

optCases :: Term -> Flow s (OptionalCases)
optCases :: forall s. Term -> Flow s OptionalCases
optCases Term
term = case Term -> Term
strip Term
term of
  TermFunction (FunctionElimination (EliminationOptional OptionalCases
cs)) -> OptionalCases -> Flow s OptionalCases
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptionalCases
cs
  Term
_ -> String -> String -> Flow s OptionalCases
forall s x. String -> String -> Flow s x
unexpected String
"optional cases" (String -> Flow s OptionalCases) -> String -> Flow s OptionalCases
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

optCasesJust :: Term -> Flow s (Term)
optCasesJust :: forall s. Term -> Flow s Term
optCasesJust Term
term = OptionalCases -> Term
optionalCasesJust (OptionalCases -> Term) -> Flow s OptionalCases -> Flow s Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s OptionalCases
forall s. Term -> Flow s OptionalCases
optCases Term
term

optCasesNothing :: Term -> Flow s (Term)
optCasesNothing :: forall s. Term -> Flow s Term
optCasesNothing Term
term = OptionalCases -> Term
optionalCasesNothing (OptionalCases -> Term) -> Flow s OptionalCases -> Flow s Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s OptionalCases
forall s. Term -> Flow s OptionalCases
optCases Term
term

optional :: (Term -> Flow s x) -> Term -> Flow s (Y.Maybe x)
optional :: forall s x. (Term -> Flow s x) -> Term -> Flow s (Maybe x)
optional Term -> Flow s x
f Term
term = case Term -> Term
strip Term
term of
  TermOptional Maybe Term
mt -> case Maybe Term
mt of
    Maybe Term
Nothing -> Maybe x -> Flow s (Maybe x)
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe x
forall a. Maybe a
Nothing
    Just Term
t -> x -> Maybe x
forall a. a -> Maybe a
Just (x -> Maybe x) -> Flow s x -> Flow s (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow s x
f Term
t
  Term
_ -> String -> String -> Flow s (Maybe x)
forall s x. String -> String -> Flow s x
unexpected String
"optional value" (String -> Flow s (Maybe x)) -> String -> Flow s (Maybe x)
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

pair :: (Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (k, v)
pair :: forall s k v.
(Term -> Flow s k) -> (Term -> Flow s v) -> Term -> Flow s (k, v)
pair Term -> Flow s k
kf Term -> Flow s v
vf Term
term = case Term -> Term
strip Term
term of
  TermProduct [Term]
terms -> case [Term]
terms of
    [Term
kTerm, Term
vTerm] -> do
      k
kVal <- Term -> Flow s k
kf Term
kTerm
      v
vVal <- Term -> Flow s v
vf Term
vTerm
      (k, v) -> Flow s (k, v)
forall a. a -> Flow s a
forall (m :: * -> *) a. Monad m => a -> m a
return (k
kVal, v
vVal)
    [Term]
_ -> String -> String -> Flow s (k, v)
forall s x. String -> String -> Flow s x
unexpected String
"pair" (String -> Flow s (k, v)) -> String -> Flow s (k, v)
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term
  Term
_ -> String -> String -> Flow s (k, v)
forall s x. String -> String -> Flow s x
unexpected String
"product" (String -> Flow s (k, v)) -> String -> Flow s (k, v)
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

record :: Term -> Flow s [Field]
record :: forall s. Term -> Flow s [Field]
record Term
term = case Term -> Term
strip Term
term of
  TermRecord (Record Name
_ [Field]
fields) -> [Field] -> Flow s [Field]
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Field]
fields
  Term
_ -> String -> String -> Flow s [Field]
forall s x. String -> String -> Flow s x
unexpected String
"record" (String -> Flow s [Field]) -> String -> Flow s [Field]
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

recordWithName :: Name -> Term -> Flow s [Field]
recordWithName :: forall s. Name -> Term -> Flow s [Field]
recordWithName Name
expected Term
term = case Term -> Term
strip Term
term of
  TermRecord (Record Name
actual [Field]
fields) -> if Name
actual Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
expected
    then [Field] -> Flow s [Field]
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Field]
fields
    else String -> String -> Flow s [Field]
forall s x. String -> String -> Flow s x
unexpected (String
"record of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
expected) (Name -> String
unName Name
actual)
  Term
_ -> String -> String -> Flow s [Field]
forall s x. String -> String -> Flow s x
unexpected String
"record" (String -> Flow s [Field]) -> String -> Flow s [Field]
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

set :: Ord x => (Term -> Flow s x) -> Term -> Flow s (S.Set x)
set :: forall x s. Ord x => (Term -> Flow s x) -> Term -> Flow s (Set x)
set Term -> Flow s x
f Term
term = case Term -> Term
strip Term
term of
  TermSet Set Term
s -> [x] -> Set x
forall a. Ord a => [a] -> Set a
S.fromList ([x] -> Set x) -> Flow s [x] -> Flow s (Set x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term -> Flow s x) -> [Term] -> Flow s [x]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Term -> Flow s x
f (Set Term -> [Term]
forall a. Set a -> [a]
S.toList Set Term
s)
  Term
_ -> String -> String -> Flow s (Set x)
forall s x. String -> String -> Flow s x
unexpected String
"set" (String -> Flow s (Set x)) -> String -> Flow s (Set x)
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

string :: Term -> Flow s String
string :: forall s. Term -> Flow s String
string Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal -> (Literal -> Flow s String) -> Flow s String
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s String
forall s. Literal -> Flow s String
stringLiteral

stringLiteral :: Literal -> Flow s String
stringLiteral :: forall s. Literal -> Flow s String
stringLiteral Literal
v = case Literal
v of
  LiteralString String
s -> String -> Flow s String
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
  Literal
_ -> String -> String -> Flow s String
forall s x. String -> String -> Flow s x
unexpected String
"string" (String -> Flow s String) -> String -> Flow s String
forall a b. (a -> b) -> a -> b
$ Literal -> String
forall a. Show a => a -> String
show Literal
v

strip :: Term -> Term
strip :: Term -> Term
strip Term
term = case Term -> Term
stripTerm Term
term of
  TermTyped (TypedTerm Term
term1 Type
_) -> Term -> Term
strip Term
term1
  Term
t -> Term
t

uint8 :: Term -> Flow s Int16
uint8 :: forall s. Term -> Flow s Int16
uint8 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Int16) -> Flow s Int16
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int16
forall s. IntegerValue -> Flow s Int16
uint8Value

uint8Value :: IntegerValue -> Flow s Int16
uint8Value :: forall s. IntegerValue -> Flow s Int16
uint8Value IntegerValue
v = case IntegerValue
v of
  IntegerValueUint8 Int16
i -> Int16 -> Flow s Int16
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int16
i
  IntegerValue
_ -> String -> String -> Flow s Int16
forall s x. String -> String -> Flow s x
unexpected String
"uint8" (String -> Flow s Int16) -> String -> Flow s Int16
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

uint16 :: Term -> Flow s Int
uint16 :: forall s. Term -> Flow s Int
uint16 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue -> (IntegerValue -> Flow s Int) -> Flow s Int
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int
forall s. IntegerValue -> Flow s Int
uint16Value

uint16Value :: IntegerValue -> Flow s Int
uint16Value :: forall s. IntegerValue -> Flow s Int
uint16Value IntegerValue
v = case IntegerValue
v of
  IntegerValueUint16 Int
i -> Int -> Flow s Int
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
i
  IntegerValue
_ -> String -> String -> Flow s Int
forall s x. String -> String -> Flow s x
unexpected String
"uint16" (String -> Flow s Int) -> String -> Flow s Int
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

uint32 :: Term -> Flow s Int64
uint32 :: forall s. Term -> Flow s Int64
uint32 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Int64) -> Flow s Int64
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Int64
forall s. IntegerValue -> Flow s Int64
uint32Value

uint32Value :: IntegerValue -> Flow s Int64
uint32Value :: forall s. IntegerValue -> Flow s Int64
uint32Value IntegerValue
v = case IntegerValue
v of
  IntegerValueUint32 Int64
i -> Int64 -> Flow s Int64
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
i
  IntegerValue
_ -> String -> String -> Flow s Int64
forall s x. String -> String -> Flow s x
unexpected String
"uint32" (String -> Flow s Int64) -> String -> Flow s Int64
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

uint64 :: Term -> Flow s Integer
uint64 :: forall s. Term -> Flow s Integer
uint64 Term
t = Term -> Flow s Literal
forall s. Term -> Flow s Literal
literal Term
t Flow s Literal
-> (Literal -> Flow s IntegerValue) -> Flow s IntegerValue
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Literal -> Flow s IntegerValue
forall s. Literal -> Flow s IntegerValue
integerLiteral Flow s IntegerValue
-> (IntegerValue -> Flow s Integer) -> Flow s Integer
forall a b. Flow s a -> (a -> Flow s b) -> Flow s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IntegerValue -> Flow s Integer
forall s. IntegerValue -> Flow s Integer
uint64Value

uint64Value :: IntegerValue -> Flow s Integer
uint64Value :: forall s. IntegerValue -> Flow s Integer
uint64Value IntegerValue
v = case IntegerValue
v of
  IntegerValueUint64 Integer
i -> Integer -> Flow s Integer
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
i
  IntegerValue
_ -> String -> String -> Flow s Integer
forall s x. String -> String -> Flow s x
unexpected String
"uint64" (String -> Flow s Integer) -> String -> Flow s Integer
forall a b. (a -> b) -> a -> b
$ IntegerValue -> String
forall a. Show a => a -> String
show IntegerValue
v

unit :: Term -> Flow s ()
unit :: forall s. Term -> Flow s ()
unit Term
term = do
  [Field]
fields <- Name -> Term -> Flow s [Field]
forall s. Name -> Term -> Flow s [Field]
recordWithName Name
_Unit Term
term
  if [Field] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Field]
fields
    then () -> Flow s ()
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else String -> String -> Flow s ()
forall s x. String -> String -> Flow s x
unexpected String
"unit" (String -> Flow s ()) -> String -> Flow s ()
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

unitVariant :: Name -> Term -> Flow s Name
unitVariant :: forall s. Name -> Term -> Flow s Name
unitVariant Name
tname Term
term = do
  Field
field <- Name -> Term -> Flow s Field
forall s. Name -> Term -> Flow s Field
variant Name
tname Term
term
  Term -> Flow s ()
forall s. Term -> Flow s ()
unit (Term -> Flow s ()) -> Term -> Flow s ()
forall a b. (a -> b) -> a -> b
$ Field -> Term
fieldTerm Field
field
  Name -> Flow s Name
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Flow s Name) -> Name -> Flow s Name
forall a b. (a -> b) -> a -> b
$ Field -> Name
fieldName Field
field

variable :: Term -> Flow s Name
variable :: forall s. Term -> Flow s Name
variable Term
term = case Term -> Term
strip Term
term of
  TermVariable Name
name -> Name -> Flow s Name
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name
  Term
_ -> String -> String -> Flow s Name
forall s x. String -> String -> Flow s x
unexpected String
"variable" (String -> Flow s Name) -> String -> Flow s Name
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term

variant :: Name -> Term -> Flow s (Field)
variant :: forall s. Name -> Term -> Flow s Field
variant = Name -> Term -> Flow s Field
forall s. Name -> Term -> Flow s Field
injectionWithName

wrap :: Name -> Term -> Flow s (Term)
wrap :: forall s. Name -> Term -> Flow s Term
wrap Name
expected Term
term = case Term -> Term
strip Term
term of
  TermWrap (WrappedTerm Name
actual Term
term) -> if Name
actual Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
expected
    then Term -> Flow s Term
forall a. a -> Flow s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
term
    else String -> String -> Flow s Term
forall s x. String -> String -> Flow s x
unexpected (String
"wrapper of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
expected) (Name -> String
unName Name
actual)
  Term
_ -> String -> String -> Flow s Term
forall s x. String -> String -> Flow s x
unexpected (String
"wrap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unName Name
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")") (String -> Flow s Term) -> String -> Flow s Term
forall a b. (a -> b) -> a -> b
$ Term -> String
forall a. Show a => a -> String
show Term
term