git.iko.soy/project-m36
on master help sign in
move haskell scripting if-block to not include arbitrary relation

fix some warnings

commitaf7107ae45dfb8d2b3742a148faf4e673ba84a66 authorA.M <agentm@themactionfaction.com> dateSun 9 Aug 2020, 12:18 (6 years ago) parentd7c3bf0
4 files changed+9−6
compare with master
unifiedsplit
src/lib/ProjectM36/RelationalExpression.hs+2−1 src/lib/ProjectM36/ScriptSession.hs+4−1 test/Relation/Tupleable.hs−1 test/TransactionGraph/Persist.hs+3−3
src/lib/ProjectM36/RelationalExpression.hs+2−1
@@ -741,6 +741,7 @@ evalGraphRefDatabaseContextIOExpr (LoadDatabaseContextFunctions modName funcName
741741 Right dbcListFunc -> let newContext = currentContext { dbcFunctions = mergedFuncs }
742742 mergedFuncs = HS.union (dbcFunctions currentContext) (HS.fromList dbcListFunc)
743743 in putDBCIOContext newContext
744+#endif
744745evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs range) = do
745746 --Define
746747 currentContext <- getDBCIOContext
@@ -771,7 +772,7 @@ evalGraphRefDatabaseContextIOExpr (CreateArbitraryRelation relVarName attrExprs
771772 case runDatabaseContextEvalMonad currentContext evalEnv (setRelVar relVarName (ExistingRelation rel)) of
772773 Left err -> pure (Left err)
773774 Right dbstate' -> putDBCIOContext (dbc_context dbstate')
774−#endif
775+
775776{-
776777updateTupleWithAtomExprs :: M.Map AttributeName AtomExpr -> DatabaseContext -> TransactionGraph -> RelationTuple -> Either RelationalError RelationTuple
777778updateTupleWithAtomExprs exprMap context graph tupIn = do
src/lib/ProjectM36/ScriptSession.hs+4−1
@@ -18,6 +18,7 @@ import System.Info (os, arch)
1818import Data.Text (Text, unpack)
1919import Data.Maybe
2020import GHC.Paths (libdir)
21+import System.Environment
2122#if __GLASGOW_HASKELL__ >= 800
2223import GHC.LanguageExtensions
2324import GHCi.ObjLink
@@ -78,6 +79,8 @@ initScriptSession ghcPkgPaths = do
7879 handleGhcException excHandler $ runGhc (Just libdir) $ do
7980 dflags <- getSessionDynFlags
8081 let ghcVersion = projectVersion dflags
82+ -- get nix packages dir, if available
83+ mNixLibDir <- liftIO $ lookupEnv "NIX_GHC_LIBDIR"
8184
8285 sandboxPkgPaths <- liftIO $ concat <$> mapM glob [
8386 --"./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
8992 --homeDir </> ".cabal/store/ghc-" ++ ghcVersion ++ "/package.db"
9093 ]
9194
92− let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths)
95+ let localPkgPaths = map PkgConfFile (ghcPkgPaths ++ sandboxPkgPaths ++ maybeToList mNixLibDir)
9396
9497 let dflags' = applyGopts . applyXopts $ dflags { hscTarget = HscInterpreted ,
9598 ghcLink = LinkInMemory,
test/Relation/Tupleable.hs−1
@@ -17,7 +17,6 @@ import ProjectM36.Error
1717import Data.Binary
1818import ProjectM36.Base
1919import Control.DeepSeq (NFData)
20−import GHC.Generics
2120import qualified Data.Vector as V
2221import qualified Data.Map as M
2322import qualified Data.Text as T
test/TransactionGraph/Persist.hs+3−3
@@ -99,11 +99,11 @@ testMerkleHashValidation = TestCase $
9999 --alter the on-disk representation and check that the hash validation fails
100100 eGraph <- transactionGraphLoad dbdir emptyTransactionGraph Nothing
101101 case eGraph of
102− Left err -> assertFailure "failed to load graph"
102+ Left err -> assertFailure $ "failed to load graph" ++ show err
103103 Right graph -> do
104104 let trans = transactionHeadsForGraph graph M.! "master"
105105 updatedTrans = Transaction (transactionId trans) (transactionInfo trans) updatedSchemas
106− transactionDir = dbdir </> show (transactionId trans)
106+ transactionDir' = dbdir </> show (transactionId trans)
107107 updatedSchemas =
108108 case schemas trans of
109109 Schemas ctx sschemas ->
@@ -120,7 +120,7 @@ testMerkleHashValidation = TestCase $
120120 let val'' = TG.validateMerkleHashes maliciousGraph
121121 assertEqual "loaded graph merkle hashes" (Left [MerkleValidationError (transactionId trans) regMerkleHash malMerkleHash]) val''
122122 --delete existing transaction directory
123− removeDirectoryRecursive transactionDir
123+ removeDirectoryRecursive transactionDir'
124124 writeTransaction NoDiskSync dbdir updatedTrans
125125
126126 --read graph from disk