-- | A module for miscellaneous tier-1 functions and constants.

module Hydra.Tier1 where

import qualified Hydra.Coders as Coders
import qualified Hydra.Compute as Compute
import qualified Hydra.Constants as Constants
import qualified Hydra.Core as Core
import qualified Hydra.Lib.Equality as Equality
import qualified Hydra.Lib.Lists as Lists
import qualified Hydra.Lib.Literals as Literals
import qualified Hydra.Lib.Logic as Logic
import qualified Hydra.Lib.Maps as Maps
import qualified Hydra.Lib.Optionals as Optionals
import qualified Hydra.Lib.Sets as Sets
import qualified Hydra.Lib.Strings as Strings
import qualified Hydra.Mantle as Mantle
import qualified Hydra.Module as Module
import qualified Hydra.Strip as Strip
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | Convert a floating-point value of any precision to a bigfloat
floatValueToBigfloat :: (Core.FloatValue -> Double)
floatValueToBigfloat :: FloatValue -> Double
floatValueToBigfloat FloatValue
x = case FloatValue
x of
  Core.FloatValueBigfloat Double
v77 -> (Double -> Double
forall x. x -> x
Equality.identity Double
v77)
  Core.FloatValueFloat32 Float
v78 -> (Float -> Double
Literals.float32ToBigfloat Float
v78)
  Core.FloatValueFloat64 Double
v79 -> (Double -> Double
Literals.float64ToBigfloat Double
v79)

-- | Convert an integer value of any precision to a bigint
integerValueToBigint :: (Core.IntegerValue -> Integer)
integerValueToBigint :: IntegerValue -> Integer
integerValueToBigint IntegerValue
x = case IntegerValue
x of
  Core.IntegerValueBigint Integer
v80 -> (Integer -> Integer
forall x. x -> x
Equality.identity Integer
v80)
  Core.IntegerValueInt8 Int8
v81 -> (Int8 -> Integer
Literals.int8ToBigint Int8
v81)
  Core.IntegerValueInt16 Int16
v82 -> (Int16 -> Integer
Literals.int16ToBigint Int16
v82)
  Core.IntegerValueInt32 Int
v83 -> (Int -> Integer
Literals.int32ToBigint Int
v83)
  Core.IntegerValueInt64 Int64
v84 -> (Int64 -> Integer
Literals.int64ToBigint Int64
v84)
  Core.IntegerValueUint8 Int16
v85 -> (Int16 -> Integer
Literals.uint8ToBigint Int16
v85)
  Core.IntegerValueUint16 Int
v86 -> (Int -> Integer
Literals.uint16ToBigint Int
v86)
  Core.IntegerValueUint32 Int64
v87 -> (Int64 -> Integer
Literals.uint32ToBigint Int64
v87)
  Core.IntegerValueUint64 Integer
v88 -> (Integer -> Integer
Literals.uint64ToBigint Integer
v88)

-- | Check whether a term is a lambda, possibly nested within let and/or annotation terms
isLambda :: (Core.Term -> Bool)
isLambda :: Term -> Bool
isLambda Term
term = ((\Term
x -> case Term
x of
  Core.TermFunction Function
v89 -> ((\Function
x -> case Function
x of
    Core.FunctionLambda Lambda
_ -> Bool
True
    Function
_ -> Bool
False) Function
v89)
  Core.TermLet Let
v91 -> (Term -> Bool
isLambda (Let -> Term
Core.letEnvironment Let
v91))
  Term
_ -> Bool
False) (Term -> Term
Strip.fullyStripTerm Term
term))

-- | Convert a qualified name to a dot-separated name
unqualifyName :: (Module.QualifiedName -> Core.Name)
unqualifyName :: QualifiedName -> Name
unqualifyName QualifiedName
qname =  
  let prefix :: String
prefix = ((\Maybe Namespace
x -> case Maybe Namespace
x of
          Maybe Namespace
Nothing -> String
""
          Just Namespace
v92 -> ([String] -> String
Strings.cat [
            Namespace -> String
Module.unNamespace Namespace
v92,
            String
"."])) (QualifiedName -> Maybe Namespace
Module.qualifiedNameNamespace QualifiedName
qname))
  in (String -> Name
Core.Name ([String] -> String
Strings.cat [
    String
prefix,
    (QualifiedName -> String
Module.qualifiedNameLocal QualifiedName
qname)]))

-- | Fold over a term, traversing its subterms in the specified order
foldOverTerm :: (Coders.TraversalOrder -> (x -> Core.Term -> x) -> x -> Core.Term -> x)
foldOverTerm :: forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld x
b0 Term
term = ((\TraversalOrder
x -> case TraversalOrder
x of
  TraversalOrder
Coders.TraversalOrderPre -> ((x -> Term -> x) -> x -> [Term] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld) (x -> Term -> x
fld x
b0 Term
term) (Term -> [Term]
subterms Term
term))
  TraversalOrder
Coders.TraversalOrderPost -> (x -> Term -> x
fld ((x -> Term -> x) -> x -> [Term] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
forall x. TraversalOrder -> (x -> Term -> x) -> x -> Term -> x
foldOverTerm TraversalOrder
order x -> Term -> x
fld) x
b0 (Term -> [Term]
subterms Term
term)) Term
term)) TraversalOrder
order)

-- | Fold over a type, traversing its subtypes in the specified order
foldOverType :: (Coders.TraversalOrder -> (x -> Core.Type -> x) -> x -> Core.Type -> x)
foldOverType :: forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld x
b0 Type
typ = ((\TraversalOrder
x -> case TraversalOrder
x of
  TraversalOrder
Coders.TraversalOrderPre -> ((x -> Type -> x) -> x -> [Type] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld) (x -> Type -> x
fld x
b0 Type
typ) (Type -> [Type]
subtypes Type
typ))
  TraversalOrder
Coders.TraversalOrderPost -> (x -> Type -> x
fld ((x -> Type -> x) -> x -> [Type] -> x
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
forall x. TraversalOrder -> (x -> Type -> x) -> x -> Type -> x
foldOverType TraversalOrder
order x -> Type -> x
fld) x
b0 (Type -> [Type]
subtypes Type
typ)) Type
typ)) TraversalOrder
order)

-- | Find the free variables (i.e. variables not bound by a lambda or let) in a term
freeVariablesInTerm :: (Core.Term -> Set Core.Name)
freeVariablesInTerm :: Term -> Set Name
freeVariablesInTerm Term
term =  
  let dfltVars :: Set Name
dfltVars = ((Set Name -> Term -> Set Name) -> Set Name -> [Term] -> Set Name
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (\Set Name
s -> \Term
t -> Set Name -> Set Name -> Set Name
forall x. Ord x => Set x -> Set x -> Set x
Sets.union Set Name
s (Term -> Set Name
freeVariablesInTerm Term
t)) Set Name
forall x. Set x
Sets.empty (Term -> [Term]
subterms Term
term))
  in ((\Term
x -> case Term
x of
    Core.TermFunction Function
v97 -> ((\Function
x -> case Function
x of
      Core.FunctionLambda Lambda
v98 -> (Name -> Set Name -> Set Name
forall x. Ord x => x -> Set x -> Set x
Sets.remove (Lambda -> Name
Core.lambdaParameter Lambda
v98) (Term -> Set Name
freeVariablesInTerm (Lambda -> Term
Core.lambdaBody Lambda
v98)))
      Function
_ -> Set Name
dfltVars) Function
v97)
    Core.TermVariable Name
v99 -> (Name -> Set Name
forall x. x -> Set x
Sets.singleton Name
v99)
    Term
_ -> Set Name
dfltVars) Term
term)

-- | Find the free variables (i.e. variables not bound by a lambda or let) in a type
freeVariablesInType :: (Core.Type -> Set Core.Name)
freeVariablesInType :: Type -> Set Name
freeVariablesInType Type
typ =  
  let dfltVars :: Set Name
dfltVars = ((Set Name -> Type -> Set Name) -> Set Name -> [Type] -> Set Name
forall b a. (b -> a -> b) -> b -> [a] -> b
Lists.foldl (\Set Name
s -> \Type
t -> Set Name -> Set Name -> Set Name
forall x. Ord x => Set x -> Set x -> Set x
Sets.union Set Name
s (Type -> Set Name
freeVariablesInType Type
t)) Set Name
forall x. Set x
Sets.empty (Type -> [Type]
subtypes Type
typ))
  in ((\Type
x -> case Type
x of
    Core.TypeLambda LambdaType
v100 -> (Name -> Set Name -> Set Name
forall x. Ord x => x -> Set x -> Set x
Sets.remove (LambdaType -> Name
Core.lambdaTypeParameter LambdaType
v100) (Type -> Set Name
freeVariablesInType (LambdaType -> Type
Core.lambdaTypeBody LambdaType
v100)))
    Core.TypeVariable Name
v101 -> (Name -> Set Name
forall x. x -> Set x
Sets.singleton Name
v101)
    Type
_ -> Set Name
dfltVars) Type
typ)

-- | Find the children of a given term
subterms :: (Core.Term -> [Core.Term])
subterms :: Term -> [Term]
subterms Term
x = case Term
x of
  Core.TermAnnotated AnnotatedTerm
v102 -> [
    AnnotatedTerm -> Term
Core.annotatedTermSubject AnnotatedTerm
v102]
  Core.TermApplication Application
v103 -> [
    Application -> Term
Core.applicationFunction Application
v103,
    (Application -> Term
Core.applicationArgument Application
v103)]
  Core.TermFunction Function
v104 -> ((\Function
x -> case Function
x of
    Core.FunctionElimination Elimination
v105 -> ((\Elimination
x -> case Elimination
x of
      Core.EliminationList Term
v106 -> [
        Term
v106]
      Core.EliminationOptional OptionalCases
v107 -> [
        OptionalCases -> Term
Core.optionalCasesNothing OptionalCases
v107,
        (OptionalCases -> Term
Core.optionalCasesJust OptionalCases
v107)]
      Core.EliminationUnion CaseStatement
v108 -> ([Term] -> [Term] -> [Term]
forall a. [a] -> [a] -> [a]
Lists.concat2 ((\Maybe Term
x -> case Maybe Term
x of
        Maybe Term
Nothing -> []
        Just Term
v109 -> [
          Term
v109]) (CaseStatement -> Maybe Term
Core.caseStatementDefault CaseStatement
v108)) ((Field -> Term) -> [Field] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Field -> Term
Core.fieldTerm (CaseStatement -> [Field]
Core.caseStatementCases CaseStatement
v108)))
      Elimination
_ -> []) Elimination
v105)
    Core.FunctionLambda Lambda
v110 -> [
      Lambda -> Term
Core.lambdaBody Lambda
v110]
    Function
_ -> []) Function
v104)
  Core.TermLet Let
v111 -> (Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
Lists.cons (Let -> Term
Core.letEnvironment Let
v111) ((LetBinding -> Term) -> [LetBinding] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map LetBinding -> Term
Core.letBindingTerm (Let -> [LetBinding]
Core.letBindings Let
v111)))
  Core.TermList [Term]
v112 -> [Term]
v112
  Core.TermLiteral Literal
_ -> []
  Core.TermMap Map Term Term
v114 -> ([[Term]] -> [Term]
forall a. [[a]] -> [a]
Lists.concat (((Term, Term) -> [Term]) -> [(Term, Term)] -> [[Term]]
forall a b. (a -> b) -> [a] -> [b]
Lists.map (\(Term, Term)
p -> [
    (Term, Term) -> Term
forall a b. (a, b) -> a
fst (Term, Term)
p,
    ((Term, Term) -> Term
forall a b. (a, b) -> b
snd (Term, Term)
p)]) (Map Term Term -> [(Term, Term)]
forall k v. Map k v -> [(k, v)]
Maps.toList Map Term Term
v114)))
  Core.TermOptional Maybe Term
v115 -> ((\Maybe Term
x -> case Maybe Term
x of
    Maybe Term
Nothing -> []
    Just Term
v116 -> [
      Term
v116]) Maybe Term
v115)
  Core.TermProduct [Term]
v117 -> [Term]
v117
  Core.TermRecord Record
v118 -> ((Field -> Term) -> [Field] -> [Term]
forall a b. (a -> b) -> [a] -> [b]
Lists.map Field -> Term
Core.fieldTerm (Record -> [Field]
Core.recordFields Record
v118))
  Core.TermSet Set Term
v119 -> (Set Term -> [Term]
forall x. Ord x => Set x -> [x]
Sets.toList Set Term
v119)
  Core.TermSum Sum
v120 -> [
    Sum -> Term
Core.sumTerm Sum
v120]
  Core.TermTyped TypedTerm
v121 -> [
    TypedTerm -> Term
Core.typedTermTerm TypedTerm
v121]
  Core.TermUnion Injection
v122 -> [
    Field -> Term
Core.fieldTerm (Injection -> Field
Core.injectionField Injection
v122)]
  Core.TermVariable Name
_ -> []
  Core.TermWrap WrappedTerm
v124 -> [
    WrappedTerm -> Term
Core.wrappedTermObject WrappedTerm
v124]

-- | Find the children of a given type expression
subtypes :: (Core.Type -> [Core.Type])
subtypes :: Type -> [Type]
subtypes Type
x = case Type
x of
  Core.TypeAnnotated AnnotatedType
v125 -> [
    AnnotatedType -> Type
Core.annotatedTypeSubject AnnotatedType
v125]
  Core.TypeApplication ApplicationType
v126 -> [
    ApplicationType -> Type
Core.applicationTypeFunction ApplicationType
v126,
    (ApplicationType -> Type
Core.applicationTypeArgument ApplicationType
v126)]
  Core.TypeFunction FunctionType
v127 -> [
    FunctionType -> Type
Core.functionTypeDomain FunctionType
v127,
    (FunctionType -> Type
Core.functionTypeCodomain FunctionType
v127)]
  Core.TypeLambda LambdaType
v128 -> [
    LambdaType -> Type
Core.lambdaTypeBody LambdaType
v128]
  Core.TypeList Type
v129 -> [
    Type
v129]
  Core.TypeLiteral LiteralType
_ -> []
  Core.TypeMap MapType
v131 -> [
    MapType -> Type
Core.mapTypeKeys MapType
v131,
    (MapType -> Type
Core.mapTypeValues MapType
v131)]
  Core.TypeOptional Type
v132 -> [
    Type
v132]
  Core.TypeProduct [Type]
v133 -> [Type]
v133
  Core.TypeRecord RowType
v134 -> ((FieldType -> Type) -> [FieldType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
Lists.map FieldType -> Type
Core.fieldTypeType (RowType -> [FieldType]
Core.rowTypeFields RowType
v134))
  Core.TypeSet Type
v135 -> [
    Type
v135]
  Core.TypeSum [Type]
v136 -> [Type]
v136
  Core.TypeUnion RowType
v137 -> ((FieldType -> Type) -> [FieldType] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
Lists.map FieldType -> Type
Core.fieldTypeType (RowType -> [FieldType]
Core.rowTypeFields RowType
v137))
  Core.TypeVariable Name
_ -> []
  Core.TypeWrap WrappedType
v139 -> [
    WrappedType -> Type
Core.wrappedTypeObject WrappedType
v139]

emptyTrace :: Compute.Trace
emptyTrace :: Trace
emptyTrace = Compute.Trace {
  traceStack :: [String]
Compute.traceStack = [],
  traceMessages :: [String]
Compute.traceMessages = [],
  traceOther :: Map String Term
Compute.traceOther = Map String Term
forall k v. Map k v
Maps.empty}

-- | Check whether a flow succeeds
flowSucceeds :: (s -> Compute.Flow s a -> Bool)
flowSucceeds :: forall s a. s -> Flow s a -> Bool
flowSucceeds s
cx Flow s a
f = (Maybe a -> Bool
forall a. Maybe a -> Bool
Optionals.isJust (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
cx Trace
emptyTrace)))

-- | Get the value of a flow, or a default value if the flow fails
fromFlow :: (a -> s -> Compute.Flow s a -> a)
fromFlow :: forall a s. a -> s -> Flow s a -> a
fromFlow a
def s
cx Flow s a
f = ((\Maybe a
x -> case Maybe a
x of
  Maybe a
Nothing -> a
def
  Just a
v140 -> a
v140) (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
cx Trace
emptyTrace)))

mutateTrace :: ((Compute.Trace -> Mantle.Either_ String Compute.Trace) -> (Compute.Trace -> Compute.Trace -> Compute.Trace) -> Compute.Flow s a -> Compute.Flow s a)
mutateTrace :: forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
mutate Trace -> Trace -> Trace
restore Flow s a
f = ((s -> Trace -> FlowState s a) -> Flow s a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s
s0 -> \Trace
t0 ->  
  let forLeft :: String -> FlowState s x
forLeft = (\String
msg -> Compute.FlowState {
          flowStateValue :: Maybe x
Compute.flowStateValue = Maybe x
forall a. Maybe a
Nothing,
          flowStateState :: s
Compute.flowStateState = s
s0,
          flowStateTrace :: Trace
Compute.flowStateTrace = (String -> Trace -> Trace
pushError String
msg Trace
t0)}) 
      forRight :: Trace -> FlowState s a
forRight = (\Trace
t1 ->  
              let f2 :: FlowState s a
f2 = (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
f s
s0 Trace
t1)
              in Compute.FlowState {
                flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s a
f2),
                flowStateState :: s
Compute.flowStateState = (FlowState s a -> s
forall s x. FlowState s x -> s
Compute.flowStateState FlowState s a
f2),
                flowStateTrace :: Trace
Compute.flowStateTrace = (Trace -> Trace -> Trace
restore Trace
t0 (FlowState s a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s a
f2))})
  in ((\Either_ String Trace
x -> case Either_ String Trace
x of
    Mantle.EitherLeft String
v141 -> (String -> FlowState s a
forall {x}. String -> FlowState s x
forLeft String
v141)
    Mantle.EitherRight Trace
v142 -> (Trace -> FlowState s a
forRight Trace
v142)) (Trace -> Either_ String Trace
mutate Trace
t0))))

-- | Push an error message
pushError :: (String -> Compute.Trace -> Compute.Trace)
pushError :: String -> Trace -> Trace
pushError String
msg Trace
t =  
  let errorMsg :: String
errorMsg = ([String] -> String
Strings.cat [
          String
"Error: ",
          String
msg,
          String
" (",
          String -> [String] -> String
Strings.intercalate String
" > " ([String] -> [String]
forall a. [a] -> [a]
Lists.reverse (Trace -> [String]
Compute.traceStack Trace
t)),
          String
")"])
  in Compute.Trace {
    traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
    traceMessages :: [String]
Compute.traceMessages = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons String
errorMsg (Trace -> [String]
Compute.traceMessages Trace
t)),
    traceOther :: Map String Term
Compute.traceOther = (Trace -> Map String Term
Compute.traceOther Trace
t)}

-- | Continue the current flow after adding a warning message
warn :: (String -> Compute.Flow s a -> Compute.Flow s a)
warn :: forall s a. String -> Flow s a -> Flow s a
warn String
msg Flow s a
b = ((s -> Trace -> FlowState s a) -> Flow s a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s
s0 -> \Trace
t0 ->  
  let f1 :: FlowState s a
f1 = (Flow s a -> s -> Trace -> FlowState s a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s a
b s
s0 Trace
t0) 
      addMessage :: Trace -> Trace
addMessage = (\Trace
t -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
              traceMessages :: [String]
Compute.traceMessages = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons ([String] -> String
Strings.cat [
                String
"Warning: ",
                String
msg]) (Trace -> [String]
Compute.traceMessages Trace
t)),
              traceOther :: Map String Term
Compute.traceOther = (Trace -> Map String Term
Compute.traceOther Trace
t)})
  in Compute.FlowState {
    flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s a
f1),
    flowStateState :: s
Compute.flowStateState = (FlowState s a -> s
forall s x. FlowState s x -> s
Compute.flowStateState FlowState s a
f1),
    flowStateTrace :: Trace
Compute.flowStateTrace = (Trace -> Trace
addMessage (FlowState s a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s a
f1))}))

-- | Continue the current flow after setting a flag
withFlag :: (String -> Compute.Flow s a -> Compute.Flow s a)
withFlag :: forall s a. String -> Flow s a -> Flow s a
withFlag String
flag =  
  let mutate :: Trace -> Either_ a Trace
mutate = (\Trace
t -> Trace -> Either_ a Trace
forall a b. b -> Either_ a b
Mantle.EitherRight (Compute.Trace {
          traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t),
          traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t),
          traceOther :: Map String Term
Compute.traceOther = (String -> Term -> Map String Term -> Map String Term
forall k v. Ord k => k -> v -> Map k v -> Map k v
Maps.insert String
flag (Literal -> Term
Core.TermLiteral (Bool -> Literal
Core.LiteralBoolean Bool
True)) (Trace -> Map String Term
Compute.traceOther Trace
t))})) 
      restore :: p -> Trace -> Trace
restore = (\p
ignored -> \Trace
t1 -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t1),
              traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t1),
              traceOther :: Map String Term
Compute.traceOther = (String -> Map String Term -> Map String Term
forall k v. Ord k => k -> Map k v -> Map k v
Maps.remove String
flag (Trace -> Map String Term
Compute.traceOther Trace
t1))})
  in ((Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
forall {a}. Trace -> Either_ a Trace
mutate Trace -> Trace -> Trace
forall {p}. p -> Trace -> Trace
restore)

-- | Continue a flow using a given state
withState :: (s1 -> Compute.Flow s1 a -> Compute.Flow s2 a)
withState :: forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState s1
cx0 Flow s1 a
f = ((s2 -> Trace -> FlowState s2 a) -> Flow s2 a
forall s x. (s -> Trace -> FlowState s x) -> Flow s x
Compute.Flow (\s2
cx1 -> \Trace
t1 ->  
  let f1 :: FlowState s1 a
f1 = (Flow s1 a -> s1 -> Trace -> FlowState s1 a
forall s x. Flow s x -> s -> Trace -> FlowState s x
Compute.unFlow Flow s1 a
f s1
cx0 Trace
t1)
  in Compute.FlowState {
    flowStateValue :: Maybe a
Compute.flowStateValue = (FlowState s1 a -> Maybe a
forall s x. FlowState s x -> Maybe x
Compute.flowStateValue FlowState s1 a
f1),
    flowStateState :: s2
Compute.flowStateState = s2
cx1,
    flowStateTrace :: Trace
Compute.flowStateTrace = (FlowState s1 a -> Trace
forall s x. FlowState s x -> Trace
Compute.flowStateTrace FlowState s1 a
f1)}))

-- | Continue the current flow after augmenting the trace
withTrace :: (String -> Compute.Flow s a -> Compute.Flow s a)
withTrace :: forall s a. String -> Flow s a -> Flow s a
withTrace String
msg =  
  let mutate :: Trace -> Either_ String Trace
mutate = (\Trace
t -> Either_ String Trace
-> Either_ String Trace -> Bool -> Either_ String Trace
forall a. a -> a -> Bool -> a
Logic.ifElse (String -> Either_ String Trace
forall a b. a -> Either_ a b
Mantle.EitherLeft String
"maximum trace depth exceeded. This may indicate an infinite loop") (Trace -> Either_ String Trace
forall a b. b -> Either_ a b
Mantle.EitherRight (Compute.Trace {
          traceStack :: [String]
Compute.traceStack = (String -> [String] -> [String]
forall a. a -> [a] -> [a]
Lists.cons String
msg (Trace -> [String]
Compute.traceStack Trace
t)),
          traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t),
          traceOther :: Map String Term
Compute.traceOther = (Trace -> Map String Term
Compute.traceOther Trace
t)})) (Int -> Int -> Bool
Equality.gteInt32 ([String] -> Int
forall a. [a] -> Int
Lists.length (Trace -> [String]
Compute.traceStack Trace
t)) Int
Constants.maxTraceDepth)) 
      restore :: Trace -> Trace -> Trace
restore = (\Trace
t0 -> \Trace
t1 -> Compute.Trace {
              traceStack :: [String]
Compute.traceStack = (Trace -> [String]
Compute.traceStack Trace
t0),
              traceMessages :: [String]
Compute.traceMessages = (Trace -> [String]
Compute.traceMessages Trace
t1),
              traceOther :: Map String Term
Compute.traceOther = (Trace -> Map String Term
Compute.traceOther Trace
t1)})
  in ((Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
forall s a.
(Trace -> Either_ String Trace)
-> (Trace -> Trace -> Trace) -> Flow s a -> Flow s a
mutateTrace Trace -> Either_ String Trace
mutate Trace -> Trace -> Trace
restore)