dovetail-0.1.0.0
Safe HaskellNone
LanguageHaskell2010

Dovetail.Evaluate

Synopsis

High-level API

buildCoreFn :: MonadFix m => Env m -> Module Ann -> EvalT m (Env m) Source #

Evaluate each of the bindings in a compiled PureScript module, and store the evaluated values in the environment, without evaluating any main expression.

builtIn :: ToValue m a => ModuleName -> Text -> a -> Env m Source #

Create an environment from a Haskell value.

It is recommended that a type annotation is given for the type of the value being provided.

For example:

builtIn (ModuleName Main) "greeting" ("Hello, World!" :: Text)
builtIn (ModuleName Main) "somePrimes" ([2, 3, 5, 7, 11] :: Vector Integer)

Functions can be provided as built-ins, but the EvalT monad needs to be used to wrap any outputs (or values in positive position):

builtIn (ModuleName Main) "strip" ((pure . Text.strip) :: Text -> EvalT m Text)
builtIn (ModuleName Main) "map" (traverse :: (Value -> EvalT m Value) -> Vector Value -> EvalT m (Vector Value))

Polymorphic functions can also be provided as built-ins, but values with polymoprhic types will need to be passed across the FFI boundary with monomorphic types. The type Value can always be used to represent values of unknown or polymorphic type, as in the map example above.

Evaluation

Eval/apply

eval :: forall m. MonadFix m => Env m -> Expr Ann -> EvalT m (Value m) Source #

Evaluate a PureScript CoreFn expression in the given environment.

Note: it should not be necessary to call this function directly in most circumstances. It is provided as a helper function, for some more advanced use cases, such as setting up a custom environment.

apply :: MonadFix m => Value m -> Value m -> EvalT m (Value m) Source #

Apply a value which represents an unevaluated closure to an argument.

Conversion to and from Haskell types

class MonadFix m => ToValue m a where Source #

Values which can be communicated across the FFI boundary from Haskell to PureScript.

Instances should identify and document any valid representations as a subset of the semantic domain Value. Such a subset can be identified by an injective function toValue, and a partial inverse, fromValue, defined on the image of toValue.

Laws:

fromValue . toValue = pure

Minimal complete definition

Nothing

Methods

toValue :: a -> Value m Source #

The default implementation uses generic deriving to identify a Haskell record type with a single data constructor with a PureScript record with the same field names.

default toValue :: (Generic a, ToObject m (Rep a)) => a -> Value m Source #

fromValue :: Value m -> EvalT m a Source #

default fromValue :: (Generic a, ToObject m (Rep a)) => Value m -> EvalT m a Source #

Instances

Instances details
MonadFix m => ToValue m Bool Source #

Haskell booleans are represented by boolean values.

Instance details

Defined in Dovetail.Evaluate

MonadFix m => ToValue m Char Source #

The Haskell Char type is represented by PureScript characters.

Instance details

Defined in Dovetail.Evaluate

MonadFix m => ToValue m Text Source #

The Haskell Text type is represented by PureScript strings which contain no lone surrogates.

Instance details

Defined in Dovetail.Evaluate

MonadFix m => ToValue m Double Source #

The Haskell Douvle type corresponds to the subset of PureScript values consisting of its Number type.

Instance details

Defined in Dovetail.Evaluate

MonadFix m => ToValue m Integer Source #

The Haskell Integer type corresponds to PureScript's integer type.

Instance details

Defined in Dovetail.Evaluate

MonadFix m => ToValue m UnknownJSON Source # 
Instance details

Defined in Dovetail.JSON

ToValue m a => ToValue m (Vector a) Source #

Haskell vectors are represented as homogeneous vectors of values, each of which are valid representations of the element type.

Instance details

Defined in Dovetail.Evaluate

Methods

toValue :: Vector a -> Value m Source #

fromValue :: Value m -> EvalT m (Vector a) Source #

MonadFix m => ToValue m (Value m) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toValue :: Value m -> Value m Source #

fromValue :: Value m -> EvalT m (Value m) Source #

ToValue m a => ToValue m (Nullable a) Source # 
Instance details

Defined in Dovetail.JSON

(MonadFix m, ToValue m a, ToValueRHS m b) => ToValue m (a -> b) Source #

Haskell functions are represented as closures which take valid representations for the domain type to valid representations of the codomain type.

Instance details

Defined in Dovetail.Evaluate

Methods

toValue :: (a -> b) -> Value m Source #

fromValue :: Value m -> EvalT m (a -> b) Source #

Higher-order functions

class ToValueRHS m a where Source #

ToValue should support functions with types such as

a -> EvalT m b
a -> b -> EvalT m c
a -> b -> c -> EvalT m d
(a -> EvalT m b) -> EvalT m c
(a -> b -> EvalT m c) -> EvalT m d

Note that every type in a return position is wrapped in the EvalT monad transformer. This is because evaluation in general may result in errors. However, a naive translation would result in too many applications of EvalT.

Specifically, we do not want to require types such as these, in which EvalT appears on the right hand side of every function arrow:

a -> EvalT m b (b -> EvalT m c)
a -> EvalT m b (b -> EvalT m (c -> EvalT m d))

For this reason, the ToValue instance for functions delegates to this type class for the type on the right hand side of the function. It skips the application of EvalT for nested function types.

Methods

toValueRHS :: a -> EvalT m (Value m) Source #

fromValueRHS :: EvalT m (Value m) -> a Source #

Instances

Instances details
(ToValue m a, n ~ m) => ToValueRHS m (EvalT n a) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toValueRHS :: EvalT n a -> EvalT m (Value m) Source #

fromValueRHS :: EvalT m (Value m) -> EvalT n a Source #

(MonadFix m, ToValue m a, ToValueRHS m b) => ToValueRHS m (a -> b) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toValueRHS :: (a -> b) -> EvalT m (Value m) Source #

fromValueRHS :: EvalT m (Value m) -> a -> b Source #

Records

data ObjectOptions Source #

Options for customizing generic deriving of record instances

Constructors

ObjectOptions 

Fields

defaultObjectOptions :: ObjectOptions Source #

  • Maps Haskell field names to PureScript field names, unmodified.

genericToValue :: (MonadFix m, Generic a, ToObject m (Rep a)) => ObjectOptions -> a -> Value m Source #

Derived toValue function for Haskell record types which should map to corresponding PureScript record types.

genericFromValue :: (MonadFix m, Generic a, ToObject m (Rep a)) => ObjectOptions -> Value m -> EvalT m a Source #

Derived fromValue function for Haskell record types which should map to corresponding PureScript record types.

class ToObject m f where Source #

This class is used in the default instance for ToValue, via generic deriving, in order to identify a Haskell record type (with a single data constructor and named fields) with values in the semantic domain corresponding to a PureScript record type with the same field names.

Instances

Instances details
(MonadFix m, ToObject m f, ToObject m g) => ToObject m (f :*: g :: k -> Type) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toObject :: forall (x :: k0). ObjectOptions -> (f :*: g) x -> HashMap Text (Value m) Source #

fromObject :: forall (x :: k0). ObjectOptions -> HashMap Text (Value m) -> EvalT m ((f :*: g) x) Source #

(Functor m, ToObject m f) => ToObject m (M1 C t f :: k -> Type) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toObject :: forall (x :: k0). ObjectOptions -> M1 C t f x -> HashMap Text (Value m) Source #

fromObject :: forall (x :: k0). ObjectOptions -> HashMap Text (Value m) -> EvalT m (M1 C t f x) Source #

(Functor m, ToObject m f) => ToObject m (M1 D t f :: k -> Type) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toObject :: forall (x :: k0). ObjectOptions -> M1 D t f x -> HashMap Text (Value m) Source #

fromObject :: forall (x :: k0). ObjectOptions -> HashMap Text (Value m) -> EvalT m (M1 D t f x) Source #

(KnownSymbol field, ToValue m a) => ToObject m (M1 S ('MetaSel ('Just field) u s l) (K1 r a :: k -> Type) :: k -> Type) Source # 
Instance details

Defined in Dovetail.Evaluate

Methods

toObject :: forall (x :: k0). ObjectOptions -> M1 S ('MetaSel ('Just field) u s l) (K1 r a) x -> HashMap Text (Value m) Source #

fromObject :: forall (x :: k0). ObjectOptions -> HashMap Text (Value m) -> EvalT m (M1 S ('MetaSel ('Just field) u s l) (K1 r a) x) Source #

Utilities

evalPSString :: MonadFix m => PSString -> EvalT m Text Source #