lorentz-0.15.1: EDSL for the Michelson Language
Safe HaskellSafe-Inferred
LanguageHaskell2010

Lorentz.Run

Description

Lorentz contracts compilation.

Compilation in one scheme:

                    mkContract
                  mkContractWith
  ContractCode  -----------------→  Contract
 (Lorentz code)              (ready compiled contract)
        ↓                                ↑
        ↓                                ↑
defaultContractData            compileLorentzContract
   ContractData                          ↑
        ↓         ContractData           ↑
       (Lorentz code + compilation options)
Synopsis

Documentation

data Contract cp st vd Source #

Compiled Lorentz contract.

Note, that the views argument (views descriptor) is added comparing to the Michelson. In Michelson, ability to call a view is fully checked at runtime, but in Lorentz we want to make calls safer at compile-time.

Constructors

(NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) => Contract 

Fields

  • cMichelsonContract :: Contract (ToT cp) (ToT st)

    Ready contract code.

  • cDocumentedCode :: ~(ContractCode cp st)

    Contract that contains documentation.

    We have to keep it separately, since optimizer is free to destroy documentation blocks. Also, it is not ContractDoc but Lorentz code because the latter is easier to modify.

Instances

Instances details
Show (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Base

Methods

showsPrec :: Int -> Contract cp st vd -> ShowS #

show :: Contract cp st vd -> String #

showList :: [Contract cp st vd] -> ShowS #

NFData (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Base

Methods

rnf :: Contract cp st vd -> () #

Eq (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Base

Methods

(==) :: Contract cp st vd -> Contract cp st vd -> Bool #

(/=) :: Contract cp st vd -> Contract cp st vd -> Bool #

ToExpression (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Base

Methods

toExpression :: Contract cp st vd -> Expression

ContainsDoc (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Doc

ContainsUpdateableDoc (Contract cp st vd) Source # 
Instance details

Defined in Lorentz.Doc

Methods

modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> Contract cp st vd -> Contract cp st vd #

toMichelsonContract :: Contract cp st vd -> Contract (ToT cp) (ToT st) Source #

Demote Lorentz Contract to Michelson typed Contract.

defaultContract :: (NiceParameterFull cp, NiceStorageFull st) => (IsNotInView => '[(cp, st)] :-> ContractOut st) -> Contract cp st () Source #

Construct and compile Lorentz contract.

This is an alias for mkContract.

data CompilationOptions Source #

Options to control Lorentz to Michelson compilation.

Constructors

CompilationOptions 

Fields

defaultCompilationOptions :: CompilationOptions Source #

Runs Michelson optimizer with default config and does not touch strings and bytes.

intactCompilationOptions :: CompilationOptions Source #

Leave contract without any modifications. For testing purposes.

compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) Source #

For use outside of Lorentz. Will use defaultCompilationOptions.

compileLorentzWithOptions :: CompilationOptions -> (inp :-> out) -> Instr (ToTs inp) (ToTs out) Source #

Compile Lorentz code, optionally running the optimizer, string and byte transformers.

mkContract :: (NiceParameterFull cp, NiceStorageFull st) => ContractCode cp st -> Contract cp st () Source #

Construct and compile Lorentz contract.

Note that this accepts code with initial and final stacks unpaired for simplicity.

mkContractWith :: (NiceParameterFull cp, NiceStorageFull st) => CompilationOptions -> ContractCode cp st -> Contract cp st () Source #

Version of mkContract that accepts custom compilation options.

data ContractData cp st vd Source #

Code for a contract along with compilation options for the Lorentz compiler.

It is expected that a Contract is one packaged entity, wholly controlled by its author. Therefore the author should be able to set all options that control contract's behavior.

This helps ensure that a given contract will be interpreted in the same way in all environments, like production and testing.

Raw ContractCode should not be used for distribution of contracts.

Constructors

(NiceParameterFull cp, NiceStorageFull st, NiceViewsDescriptor vd) => ContractData 

Fields

Instances

Instances details
ContainsDoc (ContractData cp st vd) Source # 
Instance details

Defined in Lorentz.Run

ContainsUpdateableDoc (ContractData cp st vd) Source # 
Instance details

Defined in Lorentz.Run

Methods

modifyDocEntirely :: (SomeDocItem -> SomeDocItem) -> ContractData cp st vd -> ContractData cp st vd #

data ContractView st (v :: ViewTyInfo) where Source #

Single contract view.

Constructors

ContractView :: (KnownSymbol name, NiceViewable arg, NiceViewable ret, HasAnnotation arg, HasAnnotation ret) => ViewCode arg st ret -> ContractView st ('ViewTyInfo name arg ret) 

defaultContractData :: forall cp st. (NiceParameterFull cp, NiceStorageFull st) => (IsNotInView => '[(cp, st)] :-> ContractOut st) -> ContractData cp st () Source #

Compile contract with defaultCompilationOptions.

compileLorentzContract :: forall cp st vd. ContractData cp st vd -> Contract cp st vd Source #

Compile a whole contract to Michelson.

Note that compiled contract can be ill-typed in terms of Michelson code when some of the compilation options are used. However, compilation with defaultCompilationOptions should be valid.

mkView :: forall name arg ret st. (KnownSymbol name, NiceViewable arg, NiceViewable ret, HasAnnotation arg, HasAnnotation ret, TypeHasDoc arg, TypeHasDoc ret) => ViewCode arg st ret -> ContractView st ('ViewTyInfo name arg ret) Source #

Construct a view.

mkView @"add" @(Integer, Integer) do
 car; unpair; add

setViews :: forall vd cp st. (RecFromTuple (Rec (ContractView st) (RevealViews vd)), NiceViewsDescriptor vd) => IsoRecTuple (Rec (ContractView st) (RevealViews vd)) -> ContractData cp st () -> ContractData cp st vd Source #

Set all the contract's views.

compileLorentzContract $
  defaultContractData do
    ...
  & setViews
    ( mkView "myView" () do
        ...
    , mkView "anotherView" Integer do
        ...
    )

setViewsRec :: forall vd cp st. NiceViewsDescriptor vd => Rec (ContractView st) (RevealViews vd) -> ContractData cp st () -> ContractData cp st vd Source #

Version of setViews that accepts a Rec.

May be useful if you have too many views or want to combine views sets.

noViews :: contract cp st () -> contract cp st () Source #

Restrict type of Contract, ContractData or other similar type to have no views.

cdCodeL :: forall cp st vd cp1. NiceParameterFull cp1 => Lens (ContractData cp st vd) (ContractData cp1 st vd) (ContractCode cp st) (ContractCode cp1 st) Source #

interpretLorentzInstr :: (IsoValuesStack inp, IsoValuesStack out) => ContractEnv -> (IsNotInView => inp :-> out) -> Rec Identity inp -> Either (MichelsonFailureWithStack Void) (Rec Identity out) Source #

Interpret a Lorentz instruction, for test purposes. Note that this does not run the optimizer.

interpretLorentzLambda :: (IsoValue inp, IsoValue out) => ContractEnv -> (IsNotInView => Fn inp out) -> inp -> Either (MichelsonFailureWithStack Void) out Source #

Like interpretLorentzInstr, but works on singleton input and output stacks.

analyzeLorentz :: (inp :-> out) -> AnalyzerRes Source #

Lorentz version of analyzer.