packages feed

indigo 0.3.0 → 0.3.1

raw patch · 13 files changed

+145/−135 lines, 13 files

Files

CHANGES.md view
@@ -1,6 +1,10 @@-Unreleased-==========-<!-- Append new entries here -->+0.3.1+=====+* Update `indigo` executable:+  + Make it usable inside `docker` environment.+  + Avoid usage of `mixin` in generated project since this feature is not properly handled by `stack`.+* [!629](https://gitlab.com/morley-framework/morley/-/merge_requests/629)+  Generalize functions working on `UStore` to anything satisfying classes from `Lorentz.StoreClass`.  0.3.0 ==========
app/FileGen/Files.hs view
@@ -24,6 +24,7 @@   ( main   ) where +import Universum import qualified Data.Map as Map import qualified Options.Applicative as Opt import Options.Applicative.Help.Pretty (Doc, linebreak)@@ -206,7 +207,6 @@ dependencies:   - name: base     version: ">= 4.7 && < 5"-    mixin: [hiding (Prelude)]  ghc-options:   - -Weverything@@ -234,7 +234,6 @@     - indigo     - lorentz     - morley-    - morley-prelude     - text  executables:@@ -248,8 +247,8 @@       - morley       - lorentz       - indigo-      - morley-prelude       - optparse-applicative+      - universum       - with-utf8  tests:@@ -272,7 +271,6 @@       - HUnit       - lorentz       - morley-      - morley-prelude       - tasty       - tasty-hspec       - tasty-hunit-compat
app/Main.hs view
@@ -102,7 +102,7 @@       S.shelly . S.escaping False $ case getExecName (words result) of         Just execName ->           S.catch_sh @SomeException-            (S.run_ "stack" (["run", execName, "--"] <> (toText <$> input)))+            (runStackWithArgs (["run", execName, "--"] <> (toText <$> input)))             (const pass)  -- Hide Exception error text from `optparse`         Nothing ->           die "Could not find executable name in package.yaml"@@ -143,8 +143,8 @@           Left err ->             die $ toString err -      Build -> S.shelly $ S.escaping False $ do-        S.run_ "stack" ["build", "--fast"]+      Build -> do+        S.shelly . S.escaping False $ runStackWithArgs ["build", "--fast"]        -- | Placeholder command       --@@ -153,6 +153,8 @@       Run -> pure ()        Repl -> do+        mbIndigoInDocker <- SE.lookupEnv "INDIGO_IN_DOCKER"+        let dockerFlag = (maybe [] (const ["--allow-different-user"]) mbIndigoInDocker)         result <- Utf8.readFile "package.yaml"         target <- case getLibName (words result) of           Just libName ->@@ -166,7 +168,13 @@               Nothing ->                 die "Could not find library name in package.yaml" -        S.shelly $ S.liftIO $ callProcess "stack" ["repl", toString target]+        S.shelly $ S.liftIO $ callProcess "stack" $ dockerFlag <> ["repl", toString target] -      Test -> S.shelly $ S.escaping False $ do-        S.run_ "stack" ["test", "--fast"]+      Test -> do+        S.shelly . S.escaping False $ runStackWithArgs ["test", "--fast"]++    runStackWithArgs :: [Text] -> S.Sh ()+    runStackWithArgs args = do+      mbIndigoInDocker <- liftIO $ SE.lookupEnv "INDIGO_IN_DOCKER"+      let dockerFlag = (maybe [] (const ["--allow-different-user"]) mbIndigoInDocker)+      S.shelly $ S.escaping False $ S.run_ "stack" $ dockerFlag <> args
indigo.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           indigo-version:        0.3.0+version:        0.3.1 synopsis:       Convenient imperative eDSL over Lorentz. description:    Syntax and implementation of Indigo eDSL. category:       Language
src/Indigo/Compilation/Lambda.hs view
@@ -155,8 +155,8 @@       FinalizeParamCallingDoc _ block _ -> lookForLambdas block        -- We skip two types of instructions:-      -- * Instructions without deeper code block-      -- * Unnamed lambdas creation/usage (like CreateLambda1, ExecLambda1, etc)+      -- 1) Instructions without deeper code block+      -- 2) Unnamed lambdas creation/usage (like CreateLambda1, ExecLambda1, etc)        -- Instructions without deeper code block       LiftIndigoState {} -> return ()
src/Indigo/Internal/Expr/Compilation.hs view
@@ -22,24 +22,24 @@   , ternaryOpFlat   ) where -import Data.Vinyl.Core (RMap(..))+import Data.Vinyl.Core (RMap (..))  import qualified Lorentz.ADT as L import qualified Lorentz.Instr as L import qualified Lorentz.Macro as L+import qualified Lorentz.StoreClass as L import Michelson.Typed.Haskell.Instr.Product (GetFieldType)  import Indigo.Backend.Prelude import Indigo.Internal.Expr.Types import Indigo.Internal.Field-import Indigo.Internal.State (DecomposedObjects, withObject) import Indigo.Internal.Lookup (varActionGet)-import Indigo.Internal.Var (pushNoRef, Var(..)) import Indigo.Internal.Object-  (IndigoObjectF(..), NamedFieldObj(..), castFieldConstructors, namedToTypedRec,-  typedToNamedRec)+  (IndigoObjectF (..), NamedFieldObj (..), castFieldConstructors, namedToTypedRec, typedToNamedRec) import Indigo.Internal.State-  (GenCode(..), IndigoState(..), usingIndigoState, withObjectState, MetaData (..), replStkMd)+  (DecomposedObjects, GenCode (..), IndigoState (..), MetaData (..), replStkMd, usingIndigoState,+  withObject, withObjectState)+import Indigo.Internal.Var (Var (..), pushNoRef) import Indigo.Lorentz  compileExpr :: forall a inp . Expr a -> IndigoState inp (a & inp)@@ -96,14 +96,14 @@ compileExpr (Mem k c) = binaryOp k c L.mem compileExpr (Size s) = unaryOp s L.size -compileExpr (UInsertNew l err k v store) =-  ternaryOp k v store $ ustoreInsertNew l (failUsing err)-compileExpr (UInsert l k v store) =-  ternaryOp k v store $ ustoreInsert l-compileExpr (UGet l ekey estore) = binaryOp ekey estore (ustoreGet l)-compileExpr (UMem l ekey estore) = binaryOp ekey estore (ustoreMem l)-compileExpr (UUpdate l ekey evalue estore) = ternaryOp ekey evalue estore (ustoreUpdate l)-compileExpr (UDelete l ekey estore) = binaryOp ekey estore (ustoreDelete l)+compileExpr (StInsertNew l err k v store) =+  ternaryOp k v store $ L.stInsertNew l (failUsing err)+compileExpr (StInsert l k v store) =+  ternaryOp k v store $ L.stInsert l+compileExpr (StGet l ekey estore) = binaryOp ekey estore (L.stGet l)+compileExpr (StMem l ekey estore) = binaryOp ekey estore (L.stMem l)+compileExpr (StUpdate l ekey evalue estore) = ternaryOp ekey evalue estore (L.stUpdate l)+compileExpr (StDelete l ekey estore) = binaryOp ekey estore (L.stDelete l)  compileExpr (Wrap l exFld) = unaryOp exFld $ L.wrapOne l compileExpr (Unwrap l exDt) = unaryOp exDt $ L.unwrapUnsafe_ l
src/Indigo/Internal/Expr/Symbolic.hs view
@@ -9,7 +9,7 @@ -- 1. the last character identifies the structure type: -- --      - @:@ for containers ('Map', 'BigMap', 'Set', 'List')---      - @\@@ for 'UStore'+--      - @\@@ for storage operations (@MEM@, @GET@, @UPDATE@) --      - @!@ for 'HasField' --      - @~@ fot 'Util.Named' --@@ -66,8 +66,8 @@   , (#:), (!:), (+:), (-:), (?:)   , empty, emptyBigMap, emptyMap, emptySet -  -- * UStore-  , uGet, uUpdate, uInsert, uInsertNew, uDelete, uMem+  -- * Storages+  , stGet, stUpdate, stInsert, stInsertNew, stDelete, stMem   , (#@), (!@), (+@), (++@), (-@), (?@)    -- * Sum types@@ -105,18 +105,18 @@   , checkSignature   ) where -import Data.Vinyl.Core (RMap(..))+import Data.Vinyl.Core (RMap (..))  import Indigo.Internal.Expr.Types import Indigo.Internal.Field import Indigo.Internal.Var (Var) import Indigo.Lorentz hiding (forcedCoerce) import Indigo.Prelude-import qualified Michelson.Typed.Arith as M-import Util.TypeTuple import Michelson.Text (unMText)+import qualified Michelson.Typed.Arith as M import Michelson.Typed.Haskell.Instr.Sum (CtorOnlyField, InstrUnwrapC, InstrWrapOneC) import Michelson.Untyped.Entrypoints (unsafeBuildEpName)+import Util.TypeTuple  ---------------------------------------------------------------------------- -- Basic@@ -532,82 +532,85 @@ emptySet = empty  ------------------------------------------------------------------------------- UStore+-- Storages ----------------------------------------------------------------------------  infixr 8 #@-uGet, (#@)-  :: ( HasUStore name key value store+stGet, (#@)+  :: ( StoreHasSubmap store name key value+     , KnownValue value      , exKey   :~> key-     , exStore :~> (UStore store)+     , exStore :~> store      )   => exStore -> (Label name, exKey)   -> Expr (Maybe value)-uGet store (uName, key) = UGet uName (toExpr key) (toExpr store)-(#@) = uGet+stGet store (uName, key) = StGet uName (toExpr key) (toExpr store)+(#@) = stGet  infixl 8 !@-uUpdate, (!@)-  :: ( HasUStore name key value store+stUpdate, (!@)+  :: ( StoreHasSubmap store name key value      , exKey   :~> key      , exVal   :~> Maybe value-     , exStore :~> UStore store+     , exStore :~> store      )   => exStore -> (Label name, exKey, exVal)-  -> Expr (UStore store)-uUpdate store (uName, key, val) =-  UUpdate uName (toExpr key) (toExpr val) (toExpr store)-(!@) = uUpdate+  -> Expr store+stUpdate store (uName, key, val) =+  StUpdate uName (toExpr key) (toExpr val) (toExpr store)+(!@) = stUpdate  infixr 8 +@-uInsert, (+@)-  :: ( HasUStore name key value store+stInsert, (+@)+  :: ( StoreHasSubmap store name key value      , exKey   :~> key      , exVal   :~> value-     , exStore :~> UStore store+     , exStore :~> store      )   => exStore -> (Label name, exKey, exVal)-  -> Expr (UStore store)-uInsert store (uName, key, val) =-  UInsert uName (toExpr key) (toExpr val) (toExpr store)-(+@) = uInsert+  -> Expr store+stInsert store (uName, key, val) =+  StInsert uName (toExpr key) (toExpr val) (toExpr store)+(+@) = stInsert  infixr 8 ++@-uInsertNew, (++@)-  :: ( HasUStore name key value store+stInsertNew, (++@)+  :: ( StoreHasSubmap store name key value      , IsError err      , exKey   :~> key      , exVal   :~> value-     , exStore :~> UStore store+     , exStore :~> store      )   => exStore   -> (Label name, err, exKey, exVal)-  -> Expr (UStore store)-uInsertNew store (uName, err, key, val) =-  UInsertNew uName err (toExpr key) (toExpr val) (toExpr store)-(++@) = uInsertNew+  -> Expr store+stInsertNew store (uName, err, key, val) =+  StInsertNew uName err (toExpr key) (toExpr val) (toExpr store)+(++@) = stInsertNew  infixl 8 -@-uDelete, (-@)-  :: ( HasUStore name key value store+stDelete, (-@)+  :: ( StoreHasSubmap store name key value+     , KnownValue value      , exKey   :~> key-     , exStore :~> (UStore store)+     , exStore :~> store      )   => exStore -> (Label name, exKey)-  -> Expr (UStore store)-uDelete store (uName, key) = UDelete uName (toExpr key) (toExpr store)-(-@) = uDelete+  -> Expr store+stDelete store (uName, key) = StDelete uName (toExpr key) (toExpr store)+(-@) = stDelete  infixl 8 ?@-uMem, (?@)-  :: ( HasUStore name key value store+stMem, (?@)+  :: ( StoreHasSubmap store name key value+     , KnownValue value      , exKey   :~> key-     , exStore :~> (UStore store)+     , exStore :~> store      )   => exStore -> (Label name, exKey)   -> Expr Bool-uMem store (uName, key) = UMem uName (toExpr key) (toExpr store)-(?@) = uMem+stMem store (uName, key) = StMem uName (toExpr key) (toExpr store)+(?@) = stMem  ---------------------------------------------------------------------------- -- Sum types
src/Indigo/Internal/Expr/Types.hs view
@@ -36,13 +36,13 @@   ) where  import qualified Data.Kind as Kind-import Data.Vinyl.Core (RMap(..))+import Data.Vinyl.Core (RMap (..)) -import Indigo.Prelude (Either (..), id)-import Indigo.Lorentz import Indigo.Internal.Field-import Indigo.Internal.Object (IndigoObjectF (..), FieldTypes, ComplexObjectC)+import Indigo.Internal.Object (ComplexObjectC, FieldTypes, IndigoObjectF (..)) import Indigo.Internal.Var (Var (..))+import Indigo.Lorentz+import Indigo.Prelude (Either (..), id) import qualified Michelson.Typed.Arith as M import Michelson.Typed.Haskell.Instr.Product (GetFieldType) import Michelson.Typed.Haskell.Instr.Sum (CtorOnlyField, InstrUnwrapC, InstrWrapOneC)@@ -157,38 +157,38 @@    Mem :: MemOpHs c => Expr (MemOpKeyHs c) -> Expr c -> Expr Bool -  UGet-    :: ( HasUStore name key value store+  StGet+    :: ( StoreHasSubmap store name key value        , KnownValue value        )-    => Label name -> Expr key -> Expr (UStore store) -> Expr (Maybe value)+    => Label name -> Expr key -> Expr store -> Expr (Maybe value) -  UInsertNew-    :: ( HasUStore name key value store+  StInsertNew+    :: ( StoreHasSubmap store name key value+       , KnownValue store        , IsError err-       , KnownValue (UStore store)        )     => Label name -> err-    -> Expr key -> Expr value -> Expr (UStore store) -> Expr (UStore store)+    -> Expr key -> Expr value -> Expr store -> Expr store -  UInsert-    :: (HasUStore name key value store, KnownValue (UStore store))+  StInsert+    :: (StoreHasSubmap store name key value, KnownValue store)     => Label name-    -> Expr key -> Expr value -> Expr (UStore store) -> Expr (UStore store)+    -> Expr key -> Expr value -> Expr store -> Expr store -  UMem-    :: ( HasUStore name key val store+  StMem+    :: ( StoreHasSubmap store name key val        , KnownValue val        )-    => Label name -> Expr key -> Expr (UStore store) -> Expr Bool+    => Label name -> Expr key -> Expr store -> Expr Bool -  UUpdate-    :: (HasUStore name key val store, KnownValue (UStore store))-    => Label name -> Expr key -> Expr (Maybe val) -> Expr (UStore store) -> Expr (UStore store)+  StUpdate+    :: (StoreHasSubmap store name key val, KnownValue store)+    => Label name -> Expr key -> Expr (Maybe val) -> Expr store -> Expr store -  UDelete-    :: (HasUStore name key val store, KnownValue (UStore store))-    => Label name -> Expr key -> Expr (UStore store) -> Expr (UStore store)+  StDelete+    :: (StoreHasSubmap store name key val, KnownValue store, KnownValue val)+    => Label name -> Expr key -> Expr store -> Expr store    Wrap     :: ( InstrWrapOneC dt name
src/Indigo/Internal/Field.hs view
@@ -20,15 +20,15 @@        ) where  import Data.Vinyl (RElem)-import Data.Vinyl.TypeLevel (RIndex) import Data.Vinyl.Lens (rget, rput)+import Data.Vinyl.TypeLevel (RIndex) import GHC.TypeLits (KnownSymbol)  import Indigo.Lorentz import Indigo.Prelude import qualified Lorentz.ADT as L import Michelson.Typed.Haskell.Instr.Product-  (GetFieldType, InstrSetFieldC, InstrGetFieldC, ConstructorFieldNames)+  (ConstructorFieldNames, GetFieldType, InstrGetFieldC, InstrSetFieldC)  -- | Constraint to access/assign field stored in Rec type AccessFieldC a name =@@ -107,10 +107,7 @@  => Label fname -> FieldLens dt targetFName targetFType fieldLensADT lb =   let sfo = storeFieldOpsADT @dt @fname in-  TargetField lb $ StoreFieldOps-    { sopToField = \_ -> sopToField sfo lb-    , sopSetField = \_ -> sopSetField sfo lb-    }+  TargetField lb $ storeFieldOpsReferTo lb sfo  -- | Build a lens to deeper field of an object. fieldLensDeeper
src/Indigo/Lorentz.hs view
@@ -35,9 +35,8 @@ import Lorentz.Print as L import Lorentz.Referenced as L import Lorentz.Run as L hiding (Contract(..))-import Lorentz.StoreClass as L+import Lorentz.StoreClass as L hiding (stDelete, stGet, stInsert, stInsertNew, stMem, stUpdate) import Lorentz.UParam as L-import Lorentz.UStore as L import Lorentz.Util.TH as L import Lorentz.Value as L import Lorentz.Zip as L ()
test/Test/Code/Expr.hs view
@@ -5,8 +5,7 @@ -- | Tests for Indigo Expr  module Test.Code.Expr-  ( MyUStore-  , MyTemplate (..)+  ( MyStore (..)   , MySum (..)   , SignatureData (..)   , sampleSignature@@ -39,7 +38,7 @@   , exprBigMapLookup   , exprBigMapDelete   , exprBigMapInsert-  , exprUStore+  , exprStore   , exprCheckSignature   , exprCrypto   , exprHashKey@@ -56,13 +55,19 @@ partialParse :: Buildable b => (a -> Either b c) -> a -> c partialParse f = either (error . pretty) id . f -data MyTemplate = MyTemplate-  { ints :: Integer |~> ()-  , bool :: UStoreField Bool+data MyStore = MyStore+  { ints :: Map Integer ()+  , bool :: Bool   } deriving stock (Eq, Show, Generic)+    deriving anyclass (IsoValue) -type MyUStore = UStore MyTemplate+instance HasFieldOfType MyStore fname ftype =>+         StoreHasField MyStore fname ftype where+  storeFieldOps = storeFieldOpsADT +instance StoreHasSubmap MyStore "ints" Integer () where+  storeSubmapOps = storeSubmapOpsDeeper #ints+ data MySum = MySumA Bool | MySumB Natural   deriving stock (Eq, Show, Generic)   deriving anyclass IsoValue@@ -204,10 +209,10 @@ exprBigMapInsert = compileIndigo @2 $ \st param -> do   st =: st +: (param, param) -exprUStore-  :: '[Integer, MyUStore]-  :-> '[Integer, MyUStore]-exprUStore = compileIndigo @2 $ \st param -> do+exprStore+  :: '[Integer, MyStore]+  :-> '[Integer, MyStore]+exprStore = compileIndigo @2 $ \st param -> do   st1 <- new$ st +@ (#ints, param, ())   st2 <- new$ st1 ++@ (#ints, notNewKeyM, 0 int, ())   ifSome (st2 #@ (#ints, -1 int))
test/Test/Examples.hs view
@@ -207,7 +207,7 @@ whileCheck param st   | st <= 0 = Right 0   | param == 0 = Left zeroDivFail-  | otherwise = Right . sum $ filter ((== 0) . (`mod` param)) [0..(st - 1)]+  | otherwise = Right . sum $ filter ((== 0) . (`T.modMich` param)) [0..(st - 1)]  whileLeftCheck :: Integer -> Integer -> Either MichelsonFailed Integer whileLeftCheck param _st
test/Test/Expr.hs view
@@ -20,7 +20,6 @@ import Test.Tasty (TestTree)  import Cleveland.Util (genTuple2)-import Hedgehog.Gen.Lorentz.UStore (genUStoreFieldExt, genUStoreSubMap) import Hedgehog.Gen.Michelson (genMText) import Hedgehog.Gen.Michelson.Typed (genBigMap) import Hedgehog.Gen.Tezos.Address (genAddress)@@ -38,13 +37,11 @@ import Tezos.Core (dummyChainId, unsafeMkMutez) import qualified Tezos.Crypto as C -genMyTemplate :: Gen MyTemplate-genMyTemplate = MyTemplate-  <$> genUStoreSubMap (Gen.integral (Range.linearFrom 0 -1000 1000)) (pure ())-  <*> genUStoreFieldExt Gen.bool--genMyUStore :: Gen MyUStore-genMyUStore = mkUStore <$> genMyTemplate+genMyStore :: Gen MyStore+genMyStore = MyStore+  <$> Gen.map (Range.linear -100 100)+        ((, ()) <$> Gen.integral (Range.linearFrom 0 -1000 1000))+  <*> Gen.bool  genMySum :: Gen MySum genMySum = Gen.choice [MySumA <$> Gen.bool, MySumB <$> Gen.integral (Range.linear 0 1000)]@@ -76,7 +73,7 @@   , testIndigo "Snd" genIntegerPair genInteger (validateStSuccess (\(_,b) _ -> b)) exprSnd   , testIndigo "Some" genInteger genIntegerMaybe (validateStSuccess (\p _ -> Just p)) (exprSome @Integer)   , testIndigo "None" genInteger genIntegerMaybe (validateStSuccess (\_ _ -> Nothing)) (exprNone @Integer)-  , testIndigo "UStore" genInteger genMyUStore (validateStack2 ustoreCheck) exprUStore+  , testIndigo "UStore" genInteger genMyStore (validateStack2 storeCheck) exprStore    -- TODO: no `Arbitrary` instance for `Named`   -- , ToField@@ -146,12 +143,12 @@ divEqCheck :: Integer -> Integer -> Either MichelsonFailed Integer divEqCheck param st   | param == 0 = Left zeroDivFail-  | otherwise = Right $ st `div` param+  | otherwise = Right $ st `T.divMich` param  modNeqCheck :: Integer -> Integer -> Either MichelsonFailed Integer modNeqCheck param st   | param == 0 = Left zeroDivFail-  | st `mod` param /= 0 = Right 0+  | st `T.modMich` param /= 0 = Right 0   | otherwise = Right 1  isNatCheck :: Integer -> Maybe Natural -> Maybe Natural@@ -188,21 +185,20 @@       (partialParse C.parseSignature sdSignature)       sdBytes -ustoreCheck+storeCheck   :: Integer-  -> MyUStore-  -> Either MichelsonFailed (Integer, MyUStore)-ustoreCheck param st+  -> MyStore+  -> Either MichelsonFailed (Integer, MyStore)+storeCheck param st   | param == 0 || M.member 0 stBigMap = Left notNewKeyFail   | M.member -1 st1BigMap = Right (param, st)   | otherwise = Right (param, st2)   where-    myTemplate = either error id $ ustoreDecomposeFull st-    stBigMap = unUStoreSubMap $ ints myTemplate+    stBigMap = ints st     st1BigMap = M.insert param () stBigMap     st2BigMap = M.insert 0 () st1BigMap     -- st1 = mkUStore $ myTemplate {ints = UStoreSubMap st1BigMap}-    st2 = mkUStore $ myTemplate {ints = UStoreSubMap st2BigMap}+    st2 = st {ints = st2BigMap}  cryptoCheck   :: ByteString