start the nightmare

pact-core-tests/Pact/Core/Test/ReplTests.hs

@@ -24,7 +24,7 @@ import Pact.Core.Persistence.MockPersistence
 import Pact.Core.Interpreter
 
 import Pact.Core.Repl.Utils
-import Pact.Core.Persistence (PactDb(..), ModuleData(..))
+import Pact.Core.Persistence (PactDb(..), ModuleData(..), builtinModuleData, infoModuleData)
 import Pact.Core.Persistence.SQLite (withSqlitePactDb)
 
 import Pact.Core.Info (SpanInfo)
@@ -35,46 +35,48 @@ import Pact.Core.PactValue
 import Pact.Core.Environment
 import Pact.Core.Builtin
 import Pact.Core.Errors
+import Pact.Core.Serialise
+import Control.Lens
 
 tests :: IO TestTree
 tests = do
   files <- replTestFiles
   pure $ testGroup "Repl Tests"
-    [ testGroup "in-memory db" (runFileReplTest mockPactDb <$> files)
+    [ testGroup "in-memory db" (runFileReplTest <$> files)
     , testGroup "sqlite db" (runFileReplTestSqlite <$> files)
     ]
 
 
-enhanceModuleData :: ModuleData RawBuiltin () -> ModuleData ReplRawBuiltin SpanInfo
-enhanceModuleData = \case
-  ModuleData _em _defs -> undefined
-  InterfaceData _ifd _defs -> undefined
-
-stripModuleData :: ModuleData ReplRawBuiltin SpanInfo -> ModuleData RawBuiltin ()
-stripModuleData = \case
-  ModuleData _em _defs -> undefined
-  InterfaceData _ifd _defs -> undefined
-
-enhanceEvalModule :: EvalModule RawBuiltin () -> EvalModule ReplRawBuiltin SpanInfo
-enhanceEvalModule Module
-  { _mName
-  , _mGovernance
-  , _mDefs
-  , _mBlessed
-  , _mImports
-  , _mImplements
-  , _mHash
-  , _mInfo
-  } = Module
-      { _mName
-      , _mGovernance
-      , _mDefs = undefined _mDefs
-      , _mBlessed
-      , _mImports
-      , _mImplements
-      , _mHash
-      , _mInfo = def
-      }
+-- enhanceModuleData :: ModuleData RawBuiltin () -> ModuleData ReplRawBuiltin SpanInfo
+-- enhanceModuleData = \case
+--   ModuleData _em _defs -> undefined
+--   InterfaceData _ifd _defs -> undefined
+
+-- stripModuleData :: ModuleData ReplRawBuiltin SpanInfo -> ModuleData RawBuiltin ()
+-- stripModuleData = \case
+--   ModuleData _em _defs -> undefined
+--   InterfaceData _ifd _defs -> undefined
+
+-- enhanceEvalModule :: EvalModule RawBuiltin () -> EvalModule ReplRawBuiltin SpanInfo
+-- enhanceEvalModule Module
+--   { _mName
+--   , _mGovernance
+--   , _mDefs
+--   , _mBlessed
+--   , _mImports
+--   , _mImplements
+--   , _mHash
+--   , _mInfo
+--   } = Module
+--       { _mName
+--       , _mGovernance
+--       , _mDefs = undefined _mDefs
+--       , _mBlessed
+--       , _mImports
+--       , _mImplements
+--       , _mHash
+--       , _mInfo = def
+--       }
 
 
 replTestDir :: [Char]
@@ -84,17 +86,29 @@ replTestFiles :: IO [FilePath]
 replTestFiles = do
   filter (\f -> isExtensionOf "repl" f || isExtensionOf "pact" f) <$> getDirectoryContents replTestDir
 
-runFileReplTest :: IO (PactDb (ReplBuiltin RawBuiltin) SpanInfo) -> TestName -> TestTree
-runFileReplTest mkPactDb file = testCase file $ do
-  pdb <- mkPactDb
+runFileReplTest :: TestName -> TestTree
+runFileReplTest file = testCase file $ do
+  pdb <- mockPactDb
   B.readFile (replTestDir </> file) >>= runReplTest pdb file
 
 runFileReplTestSqlite :: TestName -> TestTree
 runFileReplTestSqlite file = testCase file $ do
   ctnt <- B.readFile (replTestDir </> file)
-  withSqlitePactDb undefined ":memory:" $ \pdb -> do
+  withSqlitePactDb (enhance serialisePact) ":memory:" $ \pdb -> do
     runReplTest pdb file ctnt
-
+  where
+    enhance :: PactSerialise RawBuiltin () -> PactSerialise ReplRawBuiltin SpanInfo
+    enhance s = s{ _encodeModuleData = \md ->
+                     let encMod = md & builtinModuleData %~ (\(RBuiltinWrap r) -> r)
+                                     & infoModuleData %~ const ()
+                     in _encodeModuleData s encMod
+                 , _decodeModuleData = \bs -> case _decodeModuleData s bs of
+                     Just mdDoc -> Just $ LegacyDocument $ view document mdDoc
+                       & builtinModuleData %~ RBuiltinWrap
+                       & infoModuleData %~ const def
+                     Nothing -> error "unexpected decoding error"
+                 }
+
 
 
 runReplTest :: PactDb ReplRawBuiltin SpanInfo -> FilePath -> ByteString -> Assertion

pact-core/Pact/Core/Persistence.hs

@@ -34,6 +34,7 @@ module Pact.Core.Persistence
  , dbOpDisallowed
  , toUserTable
  , FQKS
+ , builtinModuleData , infoModuleData
  ) where
 
 import Control.Lens
@@ -66,6 +67,60 @@ data ModuleData b i
   | InterfaceData (EvalInterface b i) (Map FullyQualifiedName (EvalDef b i))
   deriving (Show, Eq, Functor)
 
+builtinEvalModule :: Traversal (EvalModule b i) (EvalModule b' i) b b'
+builtinEvalModule = undefined
+
+infoEvalModule :: Traversal (EvalModule b i) (EvalModule b i') i i'
+infoEvalModule = undefined
+
+builtinEvalInterface :: Traversal (EvalInterface b i) (EvalInterface b' i) b b'
+builtinEvalInterface = undefined
+
+infoEvalInterface :: Traversal (EvalInterface b i) (EvalInterface b i') i i'
+infoEvalInterface = undefined
+
+builtinEvalDef :: Traversal (EvalDef b i) (EvalDef b' i) b b'
+builtinEvalDef = undefined
+
+infoDefun :: Traversal (Defun name ty builtin i) (Defun name ty builtin i') i i'
+infoDefun f (Defun n a r t i) = Defun n a r <$> termInfo' f t <*> f i
+
+infoConst :: Traversal (DefConst name ty builtin i) (DefConst name ty builtin i') i i'
+infoConst f (DefConst n r t i) = DefConst n r <$> termInfo' f t <*> f i
+
+infoDefCap :: Traversal (DefCap name ty builtin i) (DefCap name ty builtin i') i i'
+infoDefCap f (DefCap n ar arg rt t m i) = DefCap n ar arg rt <$> termInfo' f t <*> pure m <*> f i
+
+infoDefSchema :: Traversal (DefSchema ty i) (DefSchema ty i') i i'
+infoDefSchema f (DefSchema n schema i) = DefSchema n schema <$> f i
+
+infoDefTable :: Traversal (DefTable ty i) (DefTable ty i') i i'
+infoDefTable f (DefTable n schema i) = DefTable n schema <$> f i
+
+infoStep :: Traversal (Step name ty builtin i) (Step name ty builtin i') i i'
+infoStep f (Step t m) = Step <$> termInfo' f t <*> (traverse . traverse) (termInfo' f) m
+infoStep f (StepWithRollback t r m) = StepWithRollback <$> termInfo' f t <*> termInfo' f r <*> (traverse . traverse) (termInfo' f) m
+
+infoDefPact :: Traversal (DefPact name ty builtin i) (DefPact name ty builtin i') i i'
+infoDefPact f (DefPact n ad rt s i) = DefPact n ad rt <$> traverse (infoStep f) s <*> f i
+
+infoEvalDef :: Traversal (EvalDef b i) (EvalDef b i') i i'
+infoEvalDef f (Dfun defun) = Dfun <$> infoDefun f defun
+infoEvalDef f (DConst d) = DConst <$> infoConst f d
+infoEvalDef f (DCap cap) = DCap <$> infoDefCap f cap
+infoEvalDef f (DSchema schema) = DSchema <$> infoDefSchema f schema
+infoEvalDef f (DTable table) = DTable <$> infoDefTable f table
+infoEvalDef f (DPact pact) = DPact <$> infoDefPact f pact
+
+builtinModuleData :: Traversal (ModuleData b i) (ModuleData b' i) b b'
+builtinModuleData f (ModuleData m dep) = ModuleData <$> builtinEvalModule f m <*> traverse (builtinEvalDef f) dep
+builtinModuleData f (InterfaceData m dep) = InterfaceData <$> builtinEvalInterface f m <*> traverse (builtinEvalDef f) dep
+
+infoModuleData :: Traversal (ModuleData b i) (ModuleData b i') i i'
+infoModuleData f (ModuleData m dep) = ModuleData <$> infoEvalModule f m <*> traverse (infoEvalDef f) dep
+infoModuleData f (InterfaceData m dep) = InterfaceData <$> infoEvalInterface f m <*> traverse (infoEvalDef f) dep
+
+
 mdModuleName :: Lens' (ModuleData b i) ModuleName
 mdModuleName f = \case
   ModuleData ev deps ->

pact-core/Pact/Core/Serialise/CBOR_V1.hs

@@ -8,7 +8,6 @@ module Pact.Core.Serialise.CBOR_V1
   , encodeDefPactExec, decodeDefPactExec
   , encodeNamespace, decodeNamespace
   , encodeRowData, decodeRowData
-  , stripSpanInfo, addDefaultSpanInfo
   ) where
 
 import Codec.Serialise.Class
@@ -33,17 +32,10 @@ import Pact.Core.ModRefs
 import Pact.Core.ChainData
 import Pact.Core.Namespace
 import Pact.Time.Internal (UTCTime(..), NominalDiffTime(..))
---import Data.Either (either)
 import Codec.CBOR.Read (deserialiseFromBytes)
 import Codec.CBOR.Write (toStrictByteString)
 import Data.ByteString (ByteString, fromStrict)
 
-stripSpanInfo :: ModuleData RawBuiltin SpanInfo -> ModuleData RawBuiltin ()
-stripSpanInfo = undefined
-
-addDefaultSpanInfo :: ModuleData RawBuiltin () -> ModuleData RawBuiltin SpanInfo
-addDefaultSpanInfo = undefined
-
 encodeModuleData :: ModuleData RawBuiltin () -> ByteString
 encodeModuleData = toStrictByteString . encode