morley-0.5.0: Developer tools for the Michelson Language

Safe HaskellNone
LanguageHaskell2010

Michelson.Typed.Scope

Contents

Description

Module, containing restrictions imposed by instruction or value scope.

Michelson have multiple restrictions on values, examples: * operation type cannot appear in parameter. * big_map type cannot appear in PUSH-able constants. * contract type cannot appear in type we UNPACK to.

Thus we declare multiple "scopes" - constraints applied in corresponding situations, for instance * ParameterScope; * StorageScope; * ConstantScope.

Also we separate multiple "classes" of scope-related constraints.

  • ParameterScope and similar ones are used within Michelson engine, they are understandable by GHC but produce not very clarifying errors.
  • ProperParameterBetterErrors and similar ones are middle-layer constraints, they produce human-readable errors but GHC cannot make conclusions from them. They are supposed to be used only by eDSLs to define their own high-level constraints.
  • Lorentz and other eDSLs may declare their own constraints, in most cases you should use them. For example see Constraints module.
Synopsis

Scopes

type ParameterScope t = (Typeable t, SingI t, HasNoOp t, HasNoNestedBigMaps t) Source #

Alias for constraints which Michelson applies to parameter.

type StorageScope t = (Typeable t, SingI t, HasNoOp t, HasNoNestedBigMaps t, HasNoContract t) Source #

Alias for constraints which Michelson applies to contract storage.

type ConstantScope t = (SingI t, HasNoOp t, HasNoBigMap t, HasNoContract t) Source #

Alias for constraints which Michelson applies to pushed constants.

type PackedValScope t = (SingI t, HasNoOp t, HasNoBigMap t) Source #

Alias for constraints which Michelson applies to packed values.

type UnpackedValScope t = (PackedValScope t, ConstantScope t) Source #

Alias for constraints which Michelson applies to unpacked values.

It is different from PackedValScope, e.g. contract type cannot appear in a value we unpack to.

type PrintedValScope t = (SingI t, HasNoOp t) Source #

Alias for constraints which are required for printing.

newtype a :- b infixr 9 #

This is the type of entailment.

a :- b is read as a "entails" b.

With this we can actually build a category for Constraint resolution.

e.g.

Because Eq a is a superclass of Ord a, we can show that Ord a entails Eq a.

Because instance Ord a => Ord [a] exists, we can show that Ord a entails Ord [a] as well.

This relationship is captured in the :- entailment type here.

Since p :- p and entailment composes, :- forms the arrows of a Category of constraints. However, Category only became sufficiently general to support this instance in GHC 7.8, so prior to 7.8 this instance is unavailable.

But due to the coherence of instance resolution in Haskell, this Category has some very interesting properties. Notably, in the absence of IncoherentInstances, this category is "thin", which is to say that between any two objects (constraints) there is at most one distinguishable arrow.

This means that for instance, even though there are two ways to derive Ord a :- Eq [a], the answers from these two paths _must_ by construction be equal. This is a property that Haskell offers that is pretty much unique in the space of languages with things they call "type classes".

What are the two ways?

Well, we can go from Ord a :- Eq a via the superclass relationship, and then from Eq a :- Eq [a] via the instance, or we can go from Ord a :- Ord [a] via the instance then from Ord [a] :- Eq [a] through the superclass relationship and this diagram by definition must "commute".

Diagrammatically,

                   Ord a
               ins /     \ cls
                  v       v
            Ord [a]     Eq a
               cls \     / ins
                    v   v
                   Eq [a]

This safety net ensures that pretty much anything you can write with this library is sensible and can't break any assumptions on the behalf of library authors.

Constructors

Sub (a -> Dict b) 
Instances
Category (:-)

Possible since GHC 7.8, when Category was made polykinded.

Instance details

Defined in Data.Constraint

Methods

id :: a :- a #

(.) :: (b :- c) -> (a :- b) -> a :- c #

() :=> (Eq (a :- b)) 
Instance details

Defined in Data.Constraint

Methods

ins :: () :- Eq (a :- b) #

() :=> (Ord (a :- b)) 
Instance details

Defined in Data.Constraint

Methods

ins :: () :- Ord (a :- b) #

() :=> (Show (a :- b)) 
Instance details

Defined in Data.Constraint

Methods

ins :: () :- Show (a :- b) #

a => HasDict b (a :- b) 
Instance details

Defined in Data.Constraint

Methods

evidence :: (a :- b) -> Dict b #

Eq (a :- b)

Assumes IncoherentInstances doesn't exist.

Instance details

Defined in Data.Constraint

Methods

(==) :: (a :- b) -> (a :- b) -> Bool #

(/=) :: (a :- b) -> (a :- b) -> Bool #

(Typeable p, Typeable q, p, q) => Data (p :- q) 
Instance details

Defined in Data.Constraint

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> (p :- q) -> c (p :- q) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (p :- q) #

toConstr :: (p :- q) -> Constr #

dataTypeOf :: (p :- q) -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (p :- q)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (p :- q)) #

gmapT :: (forall b. Data b => b -> b) -> (p :- q) -> p :- q #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> (p :- q) -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> (p :- q) -> r #

gmapQ :: (forall d. Data d => d -> u) -> (p :- q) -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> (p :- q) -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> (p :- q) -> m (p :- q) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> (p :- q) -> m (p :- q) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> (p :- q) -> m (p :- q) #

Ord (a :- b)

Assumes IncoherentInstances doesn't exist.

Instance details

Defined in Data.Constraint

Methods

compare :: (a :- b) -> (a :- b) -> Ordering #

(<) :: (a :- b) -> (a :- b) -> Bool #

(<=) :: (a :- b) -> (a :- b) -> Bool #

(>) :: (a :- b) -> (a :- b) -> Bool #

(>=) :: (a :- b) -> (a :- b) -> Bool #

max :: (a :- b) -> (a :- b) -> a :- b #

min :: (a :- b) -> (a :- b) -> a :- b #

Show (a :- b) 
Instance details

Defined in Data.Constraint

Methods

showsPrec :: Int -> (a :- b) -> ShowS #

show :: (a :- b) -> String #

showList :: [a :- b] -> ShowS #

a => NFData (a :- b) 
Instance details

Defined in Data.Constraint

Methods

rnf :: (a :- b) -> () #

Implementation internals

class ContainsBigMap t ~ False => HasNoBigMap t Source #

Constraint which ensures that bigmap does not appear in a given type.

Instances
ContainsBigMap t ~ False => HasNoBigMap t Source # 
Instance details

Defined in Michelson.Typed.Scope

class ContainsNestedBigMaps t ~ False => HasNoNestedBigMaps t Source #

Constraint which ensures that there are no nested bigmaps

Instances
ContainsNestedBigMaps t ~ False => HasNoNestedBigMaps t Source # 
Instance details

Defined in Michelson.Typed.Scope

class ContainsOp t ~ False => HasNoOp t Source #

Constraint which ensures that operation type does not appear in a given type.

Not just a type alias in order to be able to partially apply it (e.g. in Each).

Instances
ContainsOp t ~ False => HasNoOp t Source # 
Instance details

Defined in Michelson.Typed.Scope

class ContainsContract t ~ False => HasNoContract t Source #

Constraint which ensures that contract type does not appear in a given type.

Instances
ContainsContract t ~ False => HasNoContract t Source # 
Instance details

Defined in Michelson.Typed.Scope

type family ContainsNestedBigMaps (t :: T) :: Bool where ... Source #

Whether this type contains a type with nested TBigMaps .

Nested big_maps (i.e. big_map which contains another big_map inside of it's value type). Are prohibited in all contexts. Some context such as PUSH, APPLY, PACK/UNPACK instructions are more strict because they doesn't work with big_map at all.

type ForbidOp t = FailOnOperationFound (ContainsOp t) Source #

This is like HasNoOp, it raises a more human-readable error when t type is concrete, but GHC cannot make any conclusions from such constraint as it can for 'HasNoOp.

Use it in our eDSL.

type ForbidContract t = FailOnContractFound (ContainsContract t) Source #

type family FailOnBigMapFound (enabled :: Bool) :: Constraint where ... Source #

Report a human-readable error about TBigMap at a wrong place.

Equations

FailOnBigMapFound True = TypeError (Text "BigMaps are not allowed in this scope") 
FailOnBigMapFound False = () 

type family FailOnNestedBigMapsFound (enabled :: Bool) :: Constraint where ... Source #

Report a human-readable error that TBigMap contains another TBigMap

Equations

FailOnNestedBigMapsFound True = TypeError (Text "Nested BigMaps are not allowed") 
FailOnNestedBigMapsFound False = () 

type family FailOnOperationFound (enabled :: Bool) :: Constraint where ... Source #

Report a human-readable error about TOperation at a wrong place.

Equations

FailOnOperationFound True = TypeError (Text "Operations are not allowed in this scope") 
FailOnOperationFound False = () 

data OpPresence (t :: T) Source #

Whether the type contains TOperation, with proof.

Constructors

ContainsOp t ~ True => OpPresent 
ContainsOp t ~ False => OpAbsent 

data ContractPresence (t :: T) Source #

Constructors

ContainsContract t ~ True => ContractPresent 
ContainsContract t ~ False => ContractAbsent 

checkOpPresence :: Sing (ty :: T) -> OpPresence ty Source #

Check at runtime whether the given type contains TOperation.

checkContractTypePresence :: Sing (ty :: T) -> ContractPresence ty Source #

Check at runtime whether the given type contains TContract.

checkBigMapPresence :: Sing (ty :: T) -> BigMapPresence ty Source #

Check at runtime whether the given type contains TBigMap.

checkNestedBigMapsPresence :: Sing (ty :: T) -> NestedBigMapsPresence ty Source #

Check at runtime whether the given type contains TBigMap.

opAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoOp t) Source #

Check at runtime that the given type does not contain TOperation.

contractTypeAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoContract t) Source #

Check at runtime that the given type does not contain TContract.

bigMapAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoBigMap t) Source #

Check at runtime that the given type does not containt TBigMap

nestedBigMapsAbsense :: Sing (t :: T) -> Maybe (Dict $ HasNoNestedBigMaps t) Source #

Check at runtime that the given type does not contain nested TBigMap

forbiddenOp :: forall t a. (SingI t, ForbidOp t) => (HasNoOp t => a) -> a Source #

Reify HasNoOp contraint from ForbidOp.

Left for backward compatibility.

forbiddenContractType :: forall t a. (SingI t, ForbidContract t) => (HasNoContract t => a) -> a Source #

Reify HasNoContract contraint from ForbidContract.

forbiddenBigMap :: forall t a. (SingI t, ForbidBigMap t) => (HasNoBigMap t => a) -> a Source #

Re-exports

withDict :: HasDict c e => e -> (c -> r) -> r #

From a Dict, takes a value in an environment where the instance witnessed by the Dict is in scope, and evaluates it.

Essentially a deconstruction of a Dict into its continuation-style form.

Can also be used to deconstruct an entailment, a :- b, using a context a.

withDict :: Dict c -> (c => r) -> r
withDict :: a => (a :- c) -> (c => r) -> r