af7107a · project-m36 · git.iko.soy

src/lib/ProjectM36/RelationalExpression.hs+2−1

compare with master

unifiedsplit

@@ -741,6 +741,7 @@ evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions modName funcName

741 Right dbcListFunc -> let newContext = currentContext { dbcFunctions = mergedFuncs }

742 mergedFuncs = HS.union (dbcFunctions currentContext) (HS.fromList dbcListFunc)

743 in putDBCIOContext newContext

744+#endif

744evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs range) = do

745evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs range) = do

745 --Define

746 --Define

746 currentContext <- getDBCIOContext

747 currentContext <- getDBCIOContext

@@ -771,7 +772,7 @@ evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs

771 case runDatabaseContextEvalMonad currentContext evalEnv (setRelVar relVarName (ExistingRelation rel)) of

772 case runDatabaseContextEvalMonad currentContext evalEnv (setRelVar relVarName (ExistingRelation rel)) of

772 Left err -> pure (Left err)

773 Left err -> pure (Left err)

773 Right dbstate' -> putDBCIOContext (dbc_context dbstate')

774 Right dbstate' -> putDBCIOContext (dbc_context dbstate')

774−#endif

775+

775{-

776{-

776updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> TransactionGraph -> RelationTuple -> Either RelationalError RelationTuple

777updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> TransactionGraph -> RelationTuple -> Either RelationalError RelationTuple

777updateTupleWithAtomExprs exprMap context graph tupIn = do

778updateTupleWithAtomExprs exprMap context graph tupIn = do

src/lib/ProjectM36/ScriptSession.hs+4−1

@@ -18,6 +18,7 @@ import System.Info (os, arch)

18import Data.Text (Text, unpack)

19import Data.Maybe

20import GHC.Paths (libdir)

21+import System.Environment

21#if __GLASGOW_HASKELL__ >= 800

22#if __GLASGOW_HASKELL__ >= 800

22import GHC.LanguageExtensions

23import GHC.LanguageExtensions

23import GHCi.ObjLink

24import GHCi.ObjLink

@@ -78,6 +79,8 @@ initScriptSession ghcPkgPaths = do

78 handleGhcException excHandler $ runGhc (Just libdir) $ do

79 handleGhcException excHandler $ runGhc (Just libdir) $ do

79 dflags <- getSessionDynFlags

80 dflags <- getSessionDynFlags

80 let ghcVersion = projectVersion dflags

81 let ghcVersion = projectVersion dflags

82+ -- get nix packages dir, if available

83+ mNixLibDir <- liftIO $ lookupEnv "NIX_GHC_LIBDIR"

81

84

82 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [

85 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [

83 --"./dist-newstyle/packagedb/ghc-" ++ ghcVersion, --rely on cabal 3's ghc.environment install: "cabal install --lib project-m36"

86 --"./dist-newstyle/packagedb/ghc-" ++ ghcVersion, --rely on cabal 3's ghc.environment install: "cabal install --lib project-m36"

@@ -89,7 +92,7 @@ initScriptSession ghcPkgPaths = do

89 --homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"

92 --homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"

90 ]

93 ]

91

94

92− let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths)

95+ let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths ++ maybeToList mNixLibDir)

93

96

94 let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

97 let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,

95 ghcLink = LinkInMemory,

98 ghcLink = LinkInMemory,

test/Relation/Tupleable.hs−1

@@ -17,7 +17,6 @@ import ProjectM36.Error

17import Data.Binary

18import ProjectM36.Base

19import Control.DeepSeq (NFData)

20−import GHC.Generics

21import qualified Data.Vector as V

20import qualified Data.Vector as V

22import qualified Data.Map as M

21import qualified Data.Map as M

23import qualified Data.Text as T

22import qualified Data.Text as T

test/TransactionGraph/Persist.hs+3−3

@@ -99,11 +99,11 @@ testMerkleHashValidation = TestCase $

99 --alter the on-disk representation and check that the hash validation fails

100 eGraph <- transactionGraphLoad dbdir emptyTransactionGraph Nothing

101 case eGraph of

102− Left err -> assertFailure "failed to load graph"

102+ Left err -> assertFailure $ "failed to load graph" ++ show err

103 Right graph -> do

104 let trans = transactionHeadsForGraph graph M.! "master"

105 updatedTrans = Transaction (transactionId trans) (transactionInfo trans) updatedSchemas

106− transactionDir = dbdir </> show (transactionId trans)

106+ transactionDir' = dbdir </> show (transactionId trans)

107 updatedSchemas =

108 case schemas trans of

109 Schemas ctx sschemas ->

@@ -120,7 +120,7 @@ testMerkleHashValidation = TestCase $

120 let val'' = TG.validateMerkleHashes maliciousGraph

121 assertEqual "loaded graph merkle hashes" (Left [MerkleValidationError (transactionId trans) regMerkleHash malMerkleHash]) val''

122 --delete existing transaction directory

123− removeDirectoryRecursive transactionDir

123+ removeDirectoryRecursive transactionDir'

124 writeTransaction NoDiskSync dbdir updatedTrans

125

126 --read graph from disk