lorentz 0.8.0 → 0.9.0

raw patch · 13 files changed

+134/−51 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +11/−0
• README.md +5/−4
• lorentz.cabal +1/−1
• src/Lorentz/ADT.hs +2/−2
• src/Lorentz/Coercions.hs +1/−2
• src/Lorentz/ContractRegistry.hs +1/−1
• src/Lorentz/Doc.hs +39/−9
• src/Lorentz/Entrypoints/Doc.hs +27/−22
• src/Lorentz/Errors/Numeric/Doc.hs +1/−1
• src/Lorentz/Macro.hs +11/−7
• src/Lorentz/Rebinded.hs +1/−0
• src/Lorentz/Run.hs +32/−2
• src/Lorentz/Value.hs +2/−0

@@ -1,3 +1,14 @@+0.9.0+=====+* [!731](https://gitlab.com/morley-framework/morley/-/merge_requests/731)+  Added `GenericStrategy`-ies for compatibility with LIGO.+* [!712](https://gitlab.com/morley-framework/morley/-/merge_requests/712)+  Add lenses for Lorentz contract config.+* [!684](https://gitlab.com/morley-framework/morley/-/merge_requests/684)+  + Simplify working with autodoc in contracts (breaking change).+  + `finalizeParamCallingDoc` is now applied automatically when lorentz' `Contract`+    is used, no need to call it manually.+ 0.8.0 ===== * [!671](https://gitlab.com/morley-framework/morley/-/merge_requests/671)

@@ -24,8 +24,9 @@  You can find Lorentz instructions in [`Lorentz`](http://hackage.haskell.org/package/lorentz/docs/Lorentz.html) modules. -Examples of using Lorentz eDSL reside in the [`morley-multisig`](https://gitlab.com/morley-framework/morley/-/tree/master/code/morley-multisig) package.-For more information, refer to that package's [README](https://gitlab.com/morley-framework/morley/-/blob/master/code/morley-multisig/README.md).+Examples of using Lorentz eDSL reside in the [`morley-ledgers`](https://gitlab.com/morley-framework/morley-ledgers)+or [`tezos-btc`](https://github.com/tz-wrapped/tezos-btc) repos.+For more information, refer to that README's in the corresponding repositories.  Also, to get more information about Lorentz you can read our [blogpost](https://serokell.io/blog/lorentz-implementing-smart-contract-edsl-in-haskell). @@ -127,7 +128,7 @@ deriving anyclass instance HasAnnotation MeasurementMethod  instance TypeHasDoc MeasurementMethod where-  typeDocName _ = "MeasurmentMethod"+  typeDocName _ = "MeasurementMethod"   typeDocMdDescription =     "This type defines the way of measuring boa length. \     \Single boa constrictor corresponds to 38 parrot steps, 31 monkey step \@@ -145,7 +146,7 @@ type Storage = Natural  measureBoaConstrictor :: ContractCode Parameter Storage-measureBoaConstrictor = contractName "Boa constrictor measurement" $ do+measureBoaConstrictor = docGroup (DName "Boa constrictor measurement") $ do   doc $ DDescription "This contract measures boa constrictor."   unpair   dip drop

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           lorentz-version:        0.8.0+version:        0.9.0 synopsis:       EDSL for the Michelson Language description:    Lorentz is a powerful meta-programming tool which allows one to write Michelson contracts directly in Haskell. It has the same instructions as Michelson, but operates on Haskell values and allows one to use Haskell features. category:       Language

@@ -50,9 +50,9 @@  import Lorentz.Base import Lorentz.Coercions-import Lorentz.Instr import Michelson.Typed.Haskell.Instr import Michelson.Typed.Haskell.Value+import Michelson.Typed.Instr import Util.Label (Label) import Util.Type (type (++), KnownList) import Util.TypeTuple@@ -104,7 +104,7 @@   :: forall dt name st.      InstrGetFieldC dt name   => Label name -> dt : st :-> GetFieldType dt name : dt ': st-getField l = dup # toField @dt l+getField l = I DUP # toField @dt l  -- | Like 'getField', but leaves field named. getFieldNamed

@@ -42,7 +42,6 @@ import Lorentz.Address import Lorentz.Base import Lorentz.Bytes-import Lorentz.Instr import Lorentz.Value import Lorentz.Wrappable (Wrappable(..)) import Lorentz.Zip@@ -84,7 +83,7 @@  -- | Convert between two stacks via failing. fakeCoerce :: s1 :-> s2-fakeCoerce = unit # I FAILWITH+fakeCoerce = I (UNIT `Seq` FAILWITH)  fakeCoercing :: (s1 :-> s2) -> s1' :-> s2' fakeCoercing i = fakeCoerce # iForceNotFail i # fakeCoerce

@@ -92,7 +92,7 @@   if ciIsDocumented   then      writeFunc (toString name <> ".md") mOutput $-       contractDocToMarkdown $ buildLorentzDocWithGitRev gitRev $ cCode ciContract+       buildMarkdownDoc $ attachDocCommons gitRev ciContract   else die "This contract is not documented"  data SomeNiceStorage where

@@ -7,6 +7,7 @@ module Lorentz.Doc   ( doc   , docGroup+  , dStorage   , docStorage   , buildLorentzDoc   , buildLorentzDocWithGitRev@@ -33,6 +34,8 @@   , SubDoc (..)   , DocGrouping   , ContractDoc (..)+  , DGeneralInfoSection (..)+  , DName (..)   , DDescription (..)   , DEntrypointExample (..)   , mkDEntrypointExample@@ -48,6 +51,14 @@   , contractDocToMarkdown   , subDocToMarkdown   , docItemSectionRef+  , ContainsDoc (..)+  , ContainsUpdateableDoc (..)+  , WithFinalizedDoc+  , finalizedAsIs+  , buildDoc+  , buildMarkdownDoc+  , modifyDoc+  , attachDocCommons    , TypeHasDoc (..)   , SomeTypeWithDoc (..)@@ -91,26 +102,32 @@  -- | Group documentation built in the given piece of code -- into block dedicated to one thing, e.g. to one entrypoint.-docGroup :: DocGrouping -> (inp :-> out) -> (inp :-> out)-docGroup gr = iMapAnyCode (DocGroup gr)+--+-- Examples of doc items you can pass here: 'DName', 'DGeneralInfoSection'.+docGroup :: DocItem di => (SubDoc -> di) -> (inp :-> out) -> (inp :-> out)+docGroup gr = iMapAnyCode (DocGroup $ SomeDocItem . gr)  -- | Insert documentation of the contract storage type. The type -- should be passed using type applications.+{-# DEPRECATED docStorage "Use `doc (dStorage @storage)` instead." #-} docStorage :: forall storage s. TypeHasDoc storage => s :-> s docStorage = doc $ DStorageType $ DType $ Proxy @storage  -- | Give a name to given contract. Apply it to the whole contract code.+{-# DEPRECATED contractName "Use `docGroup name` instead." #-} contractName :: Text -> (inp :-> out) -> (inp :-> out)-contractName name = docGroup (SomeDocItem . DName name)+contractName name = docGroup (DName name) +{-# DEPRECATED buildLorentzDoc "Use 'buildDoc' instead." #-} buildLorentzDoc :: inp :-> out -> ContractDoc-buildLorentzDoc (iAnyCode -> code) = buildInstrDoc code+buildLorentzDoc = buildDocUnfinalized  -- | Takes an instruction that inserts documentation items with -- general information about the contract. Inserts it into general -- section. See 'DGeneralInfoSection'.+{-# DEPRECATED contractGeneral "Use `docGroup DGeneralInfoSection` instead." #-} contractGeneral :: (inp :-> out) -> (inp :-> out)-contractGeneral = docGroup (SomeDocItem . DGeneralInfoSection)+contractGeneral = docGroup DGeneralInfoSection  -- | Inserts general information about the contract using the default format. --@@ -120,17 +137,30 @@ -- to be updated in an executable using e.g. 'buildLorentzDocWithGitRev'. contractGeneralDefault :: s :-> s contractGeneralDefault =-  (contractGeneral $ doc DGitRevisionUnknown) #+  (docGroup DGeneralInfoSection $+     doc DGitRevisionUnknown+  ) #   doc (DToc "") #   doc DConversionInfo +instance ContainsDoc (i :-> o) where+  buildDocUnfinalized = buildDocUnfinalized . iAnyCode+instance ContainsUpdateableDoc (i :-> o) where+  modifyDocEntirely how = iMapAnyCode $ modifyDocEntirely how++{-# DEPRECATED buildLorentzDocWithGitRev+    "Use `buildDoc . attachDocCommons gitRev` instead."+#-} buildLorentzDocWithGitRev :: DGitRevision -> inp :-> out -> ContractDoc-buildLorentzDocWithGitRev gitRev (iAnyCode -> code) =-  buildInstrDocWithGitRev gitRev code+buildLorentzDocWithGitRev gitRev = buildDoc . attachDocCommons gitRev +{-# DEPRECATED renderLorentzDoc "Use 'buildMarkdownDoc' instead." #-} renderLorentzDoc :: inp :-> out -> LText-renderLorentzDoc = contractDocToMarkdown . buildLorentzDoc+renderLorentzDoc = buildMarkdownDoc . finalizedAsIs +{-# DEPRECATED renderLorentzDocWithGitRev+    "Use `buildMarkdownDoc . attachDocCommons gitRev` instead."+#-} renderLorentzDocWithGitRev :: DGitRevision -> inp :-> out -> LText renderLorentzDocWithGitRev gitRev = contractDocToMarkdown . buildLorentzDocWithGitRev gitRev 

@@ -34,6 +34,7 @@   , entryCase   , entryCase_   , finalizeParamCallingDoc+  , finalizeParamCallingDoc'   , areFinalizedParamBuildingSteps   , entryCaseSimple_   , entryCaseSimple@@ -64,7 +65,6 @@ import Michelson.Printer (printUntypedValue) import Michelson.Printer.Util (RenderDoc(..), needsParens, printDocB) import Michelson.Typed (pattern DefEpName, EpName, mkUType, sampleValueFromUntype)-import Michelson.Typed.Doc import Michelson.Typed.Haskell.Doc import Michelson.Typed.Haskell.Instr import qualified Michelson.Untyped as Untyped@@ -169,7 +169,7 @@   :: EntrypointKindHasDoc kind   => Text -> Proxy kind -> (i :-> o) -> (i :-> o) entrypointSection name (_ :: Proxy kind) =-  docGroup (SomeDocItem . DEntrypoint @kind name)+  docGroup (DEntrypoint @kind name)  -- | Default value for 'DEntrypoint' type argument. data PlainEntrypointsKind@@ -355,8 +355,7 @@   -> (inp :-> out)   -> (inp :-> out) modifyParamBuildingSteps f =-  iMapAnyCode $-  modifyInstrDoc (\di -> Just di{ epaBuilding = f (epaBuilding di) })+  modifyDoc (\di -> Just di{ epaBuilding = f (epaBuilding di) })  -- | Go over contract code and update every occurrence of 'DEntrypointArg' -- documentation item, adding the given step to its "how to build parameter"@@ -498,7 +497,7 @@         psteps = mkPbsWrapIn entrypointName michDesc         addDoc instr =           clarifyParamBuildingSteps psteps $-          docGroup (SomeDocItem . DEntrypoint @kind entrypointName) $+          docGroup (DEntrypoint @kind entrypointName) $           doc (deriveCtorFieldDoc @ctor @cf) # instr     in CaseClauseL (addDoc clause) :& RNil @@ -544,7 +543,7 @@   => param : s :-> out -> param : s :-> out documentEntrypoint instr =   let entrypointName = toText $ symbolVal (Proxy @epName) in-    docGroup (SomeDocItem . DEntrypoint @kind entrypointName) $+    docGroup (DEntrypoint @kind entrypointName) $     doc (constructDEpArg @param) # instr  -- | Provides arror for convenient entrypoint documentation@@ -574,18 +573,14 @@ -- -- Calling this twice over the same code is also prohibited. ----- In simple contracts you may prefer using 'entryCaseSimple'.-finalizeParamCallingDoc+-- This method is for internal use, if you want to apply it to a contract+-- manually, use 'finalizeParamCallingDoc'.+finalizeParamCallingDoc'   :: forall cp inp out.-     (NiceParameterFull cp, RequireSumType cp, HasCallStack)-  => (cp : inp :-> out) -> (cp : inp :-> out)-finalizeParamCallingDoc = modifyParamBuildingSteps modifySteps+     (NiceParameterFull cp, HasCallStack)+  => Proxy cp -> (inp :-> out) -> (inp :-> out)+finalizeParamCallingDoc' _ = modifyParamBuildingSteps modifySteps   where-    -- We do not actually need it, requiring this constraint only to avoid-    -- misapplication of our function.-    _needSumType :: Dict (RequireSumType cp)-    _needSumType = Dict-     epDescs :: [Some1 EpCallingDesc]     epDescs =       -- Reversing the list because if element @e1@ of this list is prefix of@@ -627,6 +622,19 @@           in Just $ callEpStep : truncated       | otherwise = Nothing +-- | Version of 'finalizeParamCallingDoc\'' more convenient for manual call in+-- a contract.+finalizeParamCallingDoc+  :: forall cp inp out.+     (NiceParameterFull cp, RequireSumType cp, HasCallStack)+  => (cp : inp :-> out) -> (cp : inp :-> out)+finalizeParamCallingDoc = finalizeParamCallingDoc' (Proxy @cp)+  where+    -- We do not actually need it, requiring this constraint only to avoid+    -- misapplication of our function.+    _needSumType :: Dict (RequireSumType cp)+    _needSumType = Dict+ -- | Whether 'finalizeParamCallingDoc' has already been applied to these steps. areFinalizedParamBuildingSteps :: [ParamBuildingStep] -> Bool areFinalizedParamBuildingSteps =@@ -648,25 +656,21 @@      ( InstrCaseC cp      , RMap (CaseClauses cp)      , DocumentEntrypoints PlainEntrypointsKind cp-     , NiceParameterFull cp      , RequireFlatParamEps cp      )   => Rec (CaseClauseL inp out) (CaseClauses cp)   -> cp : inp :-> out entryCaseSimple_ =-  finalizeParamCallingDoc . entryCase_ (Proxy @PlainEntrypointsKind)+  entryCase_ (Proxy @PlainEntrypointsKind)   where     _reqFlat = Dict @(RequireFlatEpDerivation cp (GetParameterEpDerivation cp))  -- | Version of 'entryCase' for contracts with flat parameter, use it when you -- need only one 'entryCase' all over the contract implementation.------ This method calls 'finalizeParamCallingDoc' inside. entryCaseSimple   :: forall cp out inp clauses.      ( CaseTC cp out inp clauses      , DocumentEntrypoints PlainEntrypointsKind cp-     , NiceParameterFull cp      , RequireFlatParamEps cp      )   => IsoRecTuple clauses -> cp : inp :-> out@@ -674,7 +678,8 @@  type family RequireFlatParamEps cp :: Constraint where   RequireFlatParamEps cp =-    ( RequireFlatEpDerivation cp (GetParameterEpDerivation cp)+    ( NiceParameterFull cp+    , RequireFlatEpDerivation cp (GetParameterEpDerivation cp)     , RequireSumType cp     ) 

@@ -121,7 +121,7 @@   -> inp :-> out   -> inp :-> out applyErrorTagToErrorsDocWith handlers errorTagMap =-  iMapAnyCode $ modifyInstrDoc @_ @DThrows $+  modifyDoc @_ @DThrows $   \(DThrows ep) ->     flip runCont id $     callCC $ \quitWith -> do

@@ -658,11 +658,11 @@   typeDocMdReference = poly2TypeDocMdReference   typeDocDependencies p =     genericTypeDocDependencies p <>-    [dTypeDep @(), dTypeDep @Integer]+    [dTypeDep @MText, dTypeDep @Integer]   typeDocHaskellRep =-    haskellRepNoFields $ concreteTypeDocHaskellRep @(View () Integer)+    haskellRepNoFields $ concreteTypeDocHaskellRep @(View MText Integer)   typeDocMichelsonRep =-    concreteTypeDocMichelsonRep @(View () Integer)+    concreteTypeDocMichelsonRep @(View MText Integer)  instance {-# OVERLAPPABLE #-} (Buildable a, WellTypedIsoValue r) => Buildable (View a r) where   build = buildView build@@ -730,16 +730,20 @@       ("Void", DType tp)       [ DType (Proxy @a)       , DType (Proxy @r)++        -- for examples+      , DType (Proxy @MText)+      , DType (Proxy @Integer)       ]   typeDocDependencies p =     genericTypeDocDependencies p <>     [dTypeDep @(), dTypeDep @Integer]   typeDocHaskellRep p descr = do-    (_, rhs) <- haskellRepNoFields (concreteTypeDocHaskellRep @(Void_ () Integer)) p descr-    return (Just "Void () Integer", rhs)+    (_, rhs) <- haskellRepNoFields (concreteTypeDocHaskellRep @(Void_ MText Integer)) p descr+    return (Just "Void MText Integer", rhs)   typeDocMichelsonRep p =-    let (_, rhs) = concreteTypeDocMichelsonRep @(Void_ () Integer) p-    in (Just "Void () Integer", rhs)+    let (_, rhs) = concreteTypeDocMichelsonRep @(Void_ MText Integer) p+    in (Just "Void MText Integer", rhs)  instance Buildable a => Buildable (Void_ a b) where   build Void_ {..} = "(Void param: " +| voidParam |+ ")"

@@ -28,6 +28,7 @@   , fromInteger   , fromString   , fromLabel+  , negate   ) where  

@@ -5,6 +5,10 @@ module Lorentz.Run   ( CompilationOptions(..)   , defaultCompilationOptions+  , intactCompilationOptions+  , coBytesTransformerL+  , coOptimizerConfL+  , coStringTransformerL    , compileLorentz   , compileLorentzWithOptions@@ -12,6 +16,9 @@   , Contract(..)   , defaultContract   , compileLorentzContract+  , cCodeL+  , cDisableInitialCastL+  , cCompilationOptionsL    , interpretLorentzInstr   , interpretLorentzLambda@@ -26,7 +33,9 @@ import Lorentz.Annotation import Lorentz.Base import Lorentz.Constraints+import Lorentz.Doc import Lorentz.Entrypoints+import Lorentz.Entrypoints.Doc import Michelson.Analyzer (AnalyzerRes, analyze) import Michelson.Interpret import Michelson.Optimizer (OptimizerConf, optimizeWithConf)@@ -34,6 +43,7 @@ import Michelson.Typed (Instr(..), IsoValue, IsoValuesStack(..), ToT, ToTs, starParamNotes) import qualified Michelson.Typed as M (Contract(..)) import qualified Michelson.Untyped as U (canonicalEntriesOrder)+import Util.Lens  -- | Options to control Lorentz to Michelson compilation. data CompilationOptions = CompilationOptions@@ -53,6 +63,14 @@   , coBytesTransformer = (False, id)   } +-- | Leave contract without any modifications. For testing purposes.+intactCompilationOptions :: CompilationOptions+intactCompilationOptions = CompilationOptions+  { coOptimizerConf = Nothing+  , coStringTransformer = (False, id)+  , coBytesTransformer = (False, id)+  }+ -- | For use outside of Lorentz. Will use 'defaultCompilationOptions'. compileLorentz :: (inp :-> out) -> Instr (ToTs inp) (ToTs out) compileLorentz = compileLorentzWithOptions defaultCompilationOptions@@ -88,9 +106,11 @@   }  -- | Compile contract with 'defaultCompilationOptions' and 'cDisableInitialCast' set to @False@.-defaultContract :: ContractCode cp st -> Contract cp st+defaultContract+  :: forall cp st. (NiceParameterFull cp, HasCallStack)+  => ContractCode cp st -> Contract cp st defaultContract code = Contract-  { cCode = code+  { cCode = finalizeParamCallingDoc' (Proxy @cp) code   , cDisableInitialCast = False   , cCompilationOptions = defaultCompilationOptions   }@@ -144,6 +164,16 @@   let Identity out :& RNil = res   return out +instance ContainsDoc (Contract cp st) where+  buildDocUnfinalized =+    buildDocUnfinalized . cCode+instance ContainsUpdateableDoc (Contract cp st) where+  modifyDocEntirely how c =+    c{ cCode = modifyDocEntirely how (cCode c) }+ -- | Lorentz version of analyzer. analyzeLorentz :: inp :-> out -> AnalyzerRes analyzeLorentz = analyze . compileLorentz++makeLensesWith postfixLFields ''CompilationOptions+makeLensesWith postfixLFields ''Contract

@@ -59,6 +59,7 @@   , convertContractRef      -- * Misc+  , Show   , Default (..)   , Label (..)   , PrintAsValue (..)@@ -76,6 +77,7 @@ import Michelson.Text import Michelson.Typed (EntrypointCall, IsoValue(..), SomeEntrypointCall, Value, WellTypedIsoValue) import qualified Michelson.Typed as M+import Michelson.Typed.Haskell.Compatibility as ReExports import Tezos.Core   (ChainId, Mutez, Timestamp, oneMutez, timestampFromSeconds, timestampFromUTCTime, timestampQuote,   toMutez, zeroMutez)