01340e6 · project-m36 · git.iko.soy

git.iko.soy/project-m36

implement hlint suggestions

commit01340e6f9d8396d13e5f7d8b3cce22d3aca06de4 authorAgentM <agentm@themactionfaction.com> dateSun 24 May 2020, 14:49 (6 years ago) parentbb13048

19 files changed+68−88

compare with master

unifiedsplit

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+1−2

@@ -206,8 +206,7 @@ interpretDatabaseContextExpr context transId graph tutdstring =

206206 Left err -> Left $ PM36E.ParseError (T.pack (show err))

207207 Right parsed -> do

208208 let env = RE.mkDatabaseContextEvalEnv transId graph

209− x <- RE.dbc_context <$> RE.runDatabaseContextEvalMonad context env (optimizeAndEvalDatabaseContextExpr True parsed)

210− pure x

209+ RE.dbc_context <$> RE.runDatabaseContextEvalMonad context env (optimizeAndEvalDatabaseContextExpr True parsed)

211210

212211{-

213212--no optimization

src/lib/ProjectM36/AtomType.hs+1−1

@@ -320,7 +320,7 @@ validateAtomType _ _ = pure ()

320320

321321validateAttributes :: TypeConstructorMapping -> Attributes -> Either RelationalError ()

322322validateAttributes tConss attrs =

323− if length errs > 0 then

323+ if not (null errs) then

324324 Left (someErrors errs)

325325 else

326326 pure ()

src/lib/ProjectM36/Base.hs+1−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveFoldable, DeriveFunctor, DeriveTraversable #-}

1+{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable #-}

22{-# OPTIONS_GHC -fno-warn-orphans #-}

44module ProjectM36.Base where

src/lib/ProjectM36/Client.hs+1−1

@@ -1,4 +1,4 @@

1−{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables, BangPatterns, MonoLocalBinds #-}

1+{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ScopedTypeVariables, MonoLocalBinds #-}

22{-|

33Module: ProjectM36.Client

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

@@ -1,5 +1,6 @@

11module ProjectM36.DatabaseContext where

22import ProjectM36.Base

3+import Control.Monad (void)

34import qualified Data.Map as M

45import qualified Data.HashSet as HS

56import ProjectM36.DataTypes.Basic

@@ -17,7 +18,7 @@ empty = DatabaseContext { inclusionDependencies = M.empty,

1718

1819-- | Remove TransactionId markers on GraphRefRelationalExpr

1920stripGraphRefRelationalExpr :: GraphRefRelationalExpr -> RelationalExpr

20−stripGraphRefRelationalExpr = fmap (const ())

21+stripGraphRefRelationalExpr = void

2122

2223-- | convert an existing database context into its constituent expression.

2324databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr

src/lib/ProjectM36/GraphRefRelationalExpr.hs+6−9

@@ -26,15 +26,12 @@ instance Monoid SingularTransactionRef where

2626

2727-- | return `Just transid` if this GraphRefRelationalExpr refers to just one transaction in the graph. This is useful for determining if certain optimizations can apply.

2828singularTransaction :: Foldable t => t GraphRefTransactionMarker -> SingularTransactionRef

29−singularTransaction expr =

30− if S.null transSet then

31− NoTransactionsRef

32− else if S.size transSet == 1 then

33− SingularTransactionRef (head (S.toList transSet))

34− else

35− MultipleTransactionsRef

29+singularTransaction expr

30+ | S.null transSet = NoTransactionsRef

31+ | S.size transSet == 1 = SingularTransactionRef (head (S.toList transSet))

32+ | otherwise = MultipleTransactionsRef

3633 where

37− transSet = foldr (\transId acc -> S.insert transId acc) S.empty expr

34+ transSet = foldr S.insert S.empty expr

3835

3936-- | Return True if two 'GraphRefRelationalExpr's both refer exclusively to the same transaction (or none at all).

4037inSameTransaction :: GraphRefRelationalExpr -> GraphRefRelationalExpr -> Maybe GraphRefTransactionMarker

@@ -45,4 +42,4 @@ inSameTransaction exprA exprB = case (stA, stB) of

4542 stB = singularTransaction exprB

4643

4744singularTransactions :: (Foldable f, Foldable t) => f (t GraphRefTransactionMarker) -> SingularTransactionRef

48−singularTransactions fs = foldMap singularTransaction fs

45+singularTransactions = foldMap singularTransaction

src/lib/ProjectM36/NormalizeExpr.hs+1−1

@@ -121,7 +121,7 @@ processTupleExprs (TupleExprs () tupleExprs) = do

121121 TupleExprs marker <$> mapM processTupleExpr tupleExprs

122122

123123processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr

124−processTupleExpr (TupleExpr tMap) = do

124+processTupleExpr (TupleExpr tMap) =

125125 TupleExpr . M.fromList <$> mapM (\(k,v) -> (,) k <$> processAtomExpr v) (M.toList tMap)

126126

127127--convert AttributeExpr to GraphRefAttributeExpr

src/lib/ProjectM36/RelationalExpression.hs+30−28

@@ -22,6 +22,7 @@ import qualified Data.Map as M

2222import qualified Data.HashSet as HS

2323import qualified Data.Set as S

2424import Control.Monad.State hiding (join)

25+import Data.Bifunctor (second)

2526import Data.Maybe

2627import Data.Either

2728import Data.Char (isUpper)

@@ -90,10 +91,10 @@ runRelationalExprM :: RelationalExprEnv -> RelationalExprM a -> Either Relationa

9091runRelationalExprM env m = runIdentity (runExceptT (runReaderT m env))

9192

9293reGraph :: RelationalExprM TransactionGraph

93−reGraph = re_graph <$> R.ask

94+reGraph = asks re_graph

9495

9596reContext :: RelationalExprM DatabaseContext

96−reContext = re_context <$> R.ask

97+reContext = asks re_context

9798

9899mkRelationalExprEnv :: DatabaseContext -> TransactionGraph -> RelationalExprEnv

99100mkRelationalExprEnv ctx graph =

@@ -138,12 +139,12 @@ data DatabaseContextEvalEnv = DatabaseContextEvalEnv

138139 }

139140

140141mkDatabaseContextEvalEnv :: TransactionId -> TransactionGraph -> DatabaseContextEvalEnv

141−mkDatabaseContextEvalEnv tid graph = DatabaseContextEvalEnv tid graph

142+mkDatabaseContextEvalEnv = DatabaseContextEvalEnv

142143

143144type DatabaseContextEvalMonad a = RWST DatabaseContextEvalEnv () DatabaseContextEvalState (ExceptT RelationalError Identity) a

144145

145146runDatabaseContextEvalMonad :: DatabaseContext -> DatabaseContextEvalEnv -> DatabaseContextEvalMonad () -> Either RelationalError DatabaseContextEvalState

146−runDatabaseContextEvalMonad ctx env m = runIdentity (runExceptT (fst <$> (execRWST m env freshEnv)))

147+runDatabaseContextEvalMonad ctx env m = runIdentity (runExceptT (fst <$> execRWST m env freshEnv))

147148 where

148149 freshEnv = mkDatabaseContextEvalState ctx

149150

@@ -159,7 +160,7 @@ dbcRelationalExprEnv =

159160 mkRelationalExprEnv <$> getStateContext <*> dbcGraph

160161

161162getStateContext :: DatabaseContextEvalMonad DatabaseContext

162−getStateContext = dbc_context <$> get

163+getStateContext = gets dbc_context

163164

164165putStateContext :: DatabaseContext -> DatabaseContextEvalMonad ()

165166putStateContext ctx' = do

@@ -200,7 +201,7 @@ freshGraphRefRelationalExprEnv mctx graph = GraphRefRelationalExprEnv {

200201 }

201202

202203gfGraph :: GraphRefRelationalExprM TransactionGraph

203−gfGraph = gre_graph <$> R.ask

204+gfGraph = asks gre_graph

204205

205206envContext :: RelationalExprEnv -> DatabaseContext

206207envContext = re_context

@@ -544,9 +545,9 @@ evalGraphRefDatabaseContextExpr (RemoveTypeConstructor tConsName) = do

544545 let newTypes = filter (\(tCons, _) -> TCD.name tCons /= tConsName) oldTypes

545546 putStateContext $ currentContext { typeConstructorMapping = newTypes }

546547

547−evalGraphRefDatabaseContextExpr (MultipleExpr exprs) = do

548+evalGraphRefDatabaseContextExpr (MultipleExpr exprs) =

548549 --the multiple expressions must pass the same context around- not the old unmodified context

549− mapM_ (\expr -> evalGraphRefDatabaseContextExpr expr) exprs

550+ mapM_ evalGraphRefDatabaseContextExpr exprs

550551

551552evalGraphRefDatabaseContextExpr (RemoveAtomFunction funcName) = do

552553 currentContext <- getStateContext

@@ -576,7 +577,7 @@ evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArg

576577 context <- getStateContext

577578 graph <- dbcGraph

578579 --resolve atom arguments

579− let eAtomTypes = mapM (\atomExpr -> runGraphRefRelationalExprM gfEnv (typeForGraphRefAtomExpr emptyAttributes atomExpr)) atomArgExprs

580+ let eAtomTypes = mapM (runGraphRefRelationalExprM gfEnv . typeForGraphRefAtomExpr emptyAttributes) atomArgExprs

580581 eFunc = databaseContextFunctionForName funcName (dbcFunctions context)

581582 gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

582583 case eFunc of

@@ -591,11 +592,13 @@ evalGraphRefDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArg

591592 case eAtomTypes of

592593 Left err -> dbErr err

593594 Right atomTypes -> do

594− let mValidTypes = map (\(expType, actType) -> case atomTypeVerify expType actType of

595− Left err -> Just err

596− Right _ -> Nothing) (zip (dbcFuncType func) atomTypes)

595+ let mValidTypes = zipWith (\ expType actType

596+ -> case atomTypeVerify expType actType of

597+ Left err -> Just err

598+ Right _ -> Nothing)

599+ (dbcFuncType func) atomTypes

597600 typeErrors = catMaybes mValidTypes

598− eAtomArgs = map (\arg -> runGraphRefRelationalExprM gfEnv (evalGraphRefAtomExpr emptyTuple arg)) atomArgExprs

601+ eAtomArgs = map (runGraphRefRelationalExprM gfEnv . evalGraphRefAtomExpr emptyTuple) atomArgExprs

599602 if length (lefts eAtomArgs) > 1 then

600603 dbErr (someErrors (lefts eAtomArgs))

601604 else if not (null typeErrors) then

@@ -639,8 +642,7 @@ getDBCIOContext = dbc_context <$> RWS.get

639642getDBCIORelationalExprEnv :: DatabaseContextIOEvalMonad RelationalExprEnv

640643getDBCIORelationalExprEnv = do

641644 context <- getDBCIOContext

642− env <- RWS.ask

643− pure $ mkRelationalExprEnv context (dbcio_graph env)

645+ mkRelationalExprEnv context . dbcio_graph <$> RWS.ask

644646

645647evalGraphRefDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())

646648#if !defined(PM36_HASKELL_SCRIPTING)

@@ -827,7 +829,7 @@ typeForRelationalExpr expr = do

827829 let gfExpr = runProcessExprM UncommittedContextMarker (processRelationalExpr expr)

828830 gfEnv = freshGraphRefRelationalExprEnv (Just context) graph

829831 runGf = runGraphRefRelationalExprM gfEnv (typeForGraphRefRelationalExpr gfExpr)

830− lift $ except $ runGf

832+ lift $ except runGf

831833

832834--returns a database context with all tuples removed

833835--this is useful for type checking and optimization

@@ -929,7 +931,7 @@ tupleExprCheckNewAttrName attrName rel = if isRight (attributeForName attrName r

929931 Right rel

930932

931933extendGraphRefTupleExpressionProcessor :: Relation -> GraphRefExtendTupleExpr -> GraphRefRelationalExprM (Attributes, RelationTuple -> Either RelationalError RelationTuple)

932−extendGraphRefTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) = do

934+extendGraphRefTupleExpressionProcessor relIn (AttributeExtendTupleExpr newAttrName atomExpr) =

933935-- renv <- askEnv

934936 -- check that the attribute name is not in use

935937 case tupleExprCheckNewAttrName newAttrName relIn of

@@ -971,7 +973,7 @@ evalGraphRefAtomExpr tupIn (FunctionAtomExpr funcName arguments tid) = do

971973 throwError (FunctionArgumentCountMismatchError expectedArgCount actualArgCount)

972974 else do

973975 let zippedArgs = zip (safeInit (atomFuncType func)) argTypes

974− mapM_ (\(expType, actType) -> do

976+ mapM_ (\(expType, actType) ->

975977 lift $ except (atomTypeVerify expType actType)) zippedArgs

976978 evaldArgs <- mapM (evalGraphRefAtomExpr tupIn) arguments

977979 case evalAtomFunction func evaldArgs of

@@ -1160,14 +1162,14 @@ evalGraphRefTupleExprs mAttrs (TupleExprs fixedMarker tupleExprL) = do

11601162 pure (A.attributesFromList mostResolvedTypes)

11611163 --strategy: if all the tuple expr transaction markers refer to one location, then we can pass the type constructor mapping from that location, otherwise, we cannot assume that the types are the same

11621164 tConsMap <- case singularTransactions tupleExprL of

1163− SingularTransactionRef commonTransId -> do

1165+ SingularTransactionRef commonTransId ->

11641166 typeConstructorMapping <$> gfDatabaseContextForMarker commonTransId

1165− NoTransactionsRef -> do

1167+ NoTransactionsRef ->

11661168 typeConstructorMapping <$> gfDatabaseContextForMarker fixedMarker

11671169 -- if there are multiple transaction markers in the TupleExprs, then we can't assume a single type constructor mapping- this could be improved in the future, but if all the tuples are fully resolved, then we don't need further resolution

11681170 _ -> throwError TupleExprsReferenceMultipleMarkersError

11691171 lift $ except $ validateAttributes tConsMap finalAttrs

1170− mapM (\tup -> lift $ except $ resolveTypesInTuple finalAttrs tConsMap tup) tuples

1172+ mapM (lift . except . resolveTypesInTuple finalAttrs tConsMap) tuples

11711173

11721174

11731175--resolveAttributes (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",IntegerAtomType),("b",TypeVariableType "b")]))) (Attribute "gonk" (ConstructedAtomType "Either" (fromList [("a",TypeVariableType "a"),("b",TextAtomType)])))

@@ -1313,7 +1315,7 @@ evalGraphRefRelationalExpr (Extend extendTupleExpr expr) = do

13131315 rel <- evalGraphRefRelationalExpr expr

13141316 (newAttrs, tupProc) <- extendGraphRefTupleExpressionProcessor rel extendTupleExpr

13151317 lift $ except $ relMogrify tupProc newAttrs rel

1316−evalGraphRefRelationalExpr expr@With{} = do

1318+evalGraphRefRelationalExpr expr@With{} =

13171319 --strategy A: add relation variables to the contexts in the graph

13181320 --strategy B: drop in macros in place (easier programmatically)

13191321 --strategy B implementation

@@ -1341,7 +1343,7 @@ typeForGraphRefRelationalExpr (ExistingRelation rel) = pure (emptyRelationWithAt

13411343typeForGraphRefRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

13421344 mAttrs <- case mAttrExprs of

13431345 Just attrExprs -> do

1344− attrs <- mapM (\e -> evalGraphRefAttributeExpr e) attrExprs

1346+ attrs <- mapM evalGraphRefAttributeExpr attrExprs

13451347 pure (Just (attributesFromList attrs))

13461348 Nothing -> pure Nothing

13471349 tuples <- evalGraphRefTupleExprs mAttrs tupleExprs

@@ -1386,9 +1388,9 @@ typeForGraphRefRelationalExpr (Restrict pred' expr) = do

13861388 expr' <- typeForGraphRefRelationalExpr expr

13871389 filt <- predicateRestrictionFilter (attributes expr') pred'

13881390 lift $ except $ restrict filt expr'

1389−typeForGraphRefRelationalExpr Equals{} = do

1391+typeForGraphRefRelationalExpr Equals{} =

13901392 pure relationFalse

1391−typeForGraphRefRelationalExpr NotEquals{} = do

1393+typeForGraphRefRelationalExpr NotEquals{} =

13921394 pure relationFalse

13931395typeForGraphRefRelationalExpr (Extend extendTupleExpr expr) = do

13941396 rel <- typeForGraphRefRelationalExpr expr

@@ -1400,7 +1402,7 @@ typeForGraphRefRelationalExpr expr@(With withs _) = do

14001402 case M.lookup macroName rvs of

14011403 Just _ -> lift $ except $ Left (RelVarAlreadyDefinedError macroName) --this error does not include the transaction marker, but should be good enough to identify the cause

14021404 Nothing -> pure ()

1403− mapM_ checkMacroName (map fst withs)

1405+ mapM_ (checkMacroName . fst) withs

14041406 typeForGraphRefRelationalExpr expr'

14051407

14061408evalGraphRefAttributeNames :: GraphRefAttributeNames -> GraphRefRelationalExpr -> GraphRefRelationalExprM (S.Set AttributeName)

@@ -1446,7 +1448,7 @@ evalGraphRefAttributeExpr (AttributeAndTypeNameExpr attrName tCons tid) = do

14461448evalGraphRefAttributeExpr (NakedAttributeExpr attr) = pure attr

14471449

14481450mkEmptyRelVars :: RelationVariables -> RelationVariables

1449−mkEmptyRelVars rvMap = M.map mkEmptyRelVar rvMap

1451+mkEmptyRelVars = M.map mkEmptyRelVar

14501452 where

14511453 mkEmptyRelVar expr@MakeRelationFromExprs{} = expr --do not truncate here because we might lose essential type information in emptying the tuples

14521454 mkEmptyRelVar (MakeStaticRelation attrs _) = MakeStaticRelation attrs emptyTupleSet

@@ -1463,7 +1465,7 @@ mkEmptyRelVars rvMap = M.map mkEmptyRelVar rvMap

14631465 mkEmptyRelVar (Equals exprA exprB) = Equals (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

14641466 mkEmptyRelVar (NotEquals exprA exprB) = NotEquals (mkEmptyRelVar exprA) (mkEmptyRelVar exprB)

14651467 mkEmptyRelVar (Extend extTuple expr) = Extend extTuple (mkEmptyRelVar expr)

1466− mkEmptyRelVar (With macros expr) = With (map (\(rv, expr') -> (rv, mkEmptyRelVar expr')) macros) (mkEmptyRelVar expr)

1468+ mkEmptyRelVar (With macros expr) = With (map (second mkEmptyRelVar) macros) (mkEmptyRelVar expr)

14671469

14681470

14691471dbErr :: RelationalError -> DatabaseContextEvalMonad ()

src/lib/ProjectM36/StaticOptimizer.hs+14−17

@@ -1,4 +1,3 @@

1−{-# LANGUAGE TypeSynonymInstances #-}

21{-# LANGUAGE FlexibleInstances #-}

32{-# LANGUAGE FlexibleContexts #-}

43module ProjectM36.StaticOptimizer where

@@ -59,22 +58,22 @@ class Monad m => AskGraphContext m where

5958 askContext :: m DatabaseContext

6059

6160instance AskGraphContext (ReaderT GraphRefSOptDatabaseContextExprEnv (ExceptT RelationalError Identity)) where

62− askGraph = odce_graph <$> ask

63− askContext = odce_context <$> ask

61+ askGraph = asks odce_graph

62+ askContext = asks odce_context

6463

6564instance AskGraphContext (ReaderT GraphRefSOptRelationalExprEnv (ExceptT RelationalError Identity)) where

66− askGraph = ore_graph <$> ask

65+ askGraph = asks ore_graph

6766 askContext = do

68− mctx <- ore_mcontext <$> ask

67+ mctx <- asks ore_mcontext

6968 case mctx of

7069 Nothing -> throwError NoUncommittedContextInEvalError

7170 Just ctx -> pure ctx

7271

7372askTransId :: GraphRefSOptDatabaseContextExprM TransactionId

74−askTransId = odce_transId <$> ask

73+askTransId = asks odce_transId

7574

7675askMaybeContext :: GraphRefSOptRelationalExprM (Maybe DatabaseContext)

77−askMaybeContext = ore_mcontext <$> ask

76+askMaybeContext = asks ore_mcontext

7877

7978optimizeDatabaseContextExpr :: DatabaseContextExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextExpr

8079optimizeDatabaseContextExpr expr = do

@@ -83,8 +82,8 @@ optimizeDatabaseContextExpr expr = do

8382

8483optimizeAndEvalDatabaseContextExpr :: Bool -> DatabaseContextExpr -> DatabaseContextEvalMonad ()

8584optimizeAndEvalDatabaseContextExpr optimize expr = do

86− graph <- dce_graph <$> ask

87− transId <- dce_transId <$> ask

85+ graph <- asks dce_graph

86+ transId <- asks dce_transId

8887 context <- getStateContext

8988 let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextExpr expr)

9089 eOptExpr = if optimize then

@@ -105,9 +104,9 @@ optimizeAndEvalTransGraphRelationalExpr graph tgExpr = do

105104

106105optimizeAndEvalDatabaseContextIOExpr :: DatabaseContextIOExpr -> DatabaseContextIOEvalMonad (Either RelationalError ())

107106optimizeAndEvalDatabaseContextIOExpr expr = do

108− transId <- dbcio_transId <$> ask

107+ transId <- asks dbcio_transId

109108 ctx <- getDBCIOContext

110− graph <- dbcio_graph <$> ask

109+ graph <- asks dbcio_graph

111110 let gfExpr = runProcessExprM UncommittedContextMarker (processDatabaseContextIOExpr expr)

112111 eOptExpr = runGraphRefSOptDatabaseContextExprM transId ctx graph (optimizeDatabaseContextIOExpr gfExpr)

113112 case eOptExpr of

@@ -164,8 +163,8 @@ optimizeGraphRefRelationalExpr' mctx graph expr =

164163-- | optimize relational expression within database context expr monad

165164liftGraphRefRelExpr :: GraphRefSOptRelationalExprM a -> GraphRefSOptDatabaseContextExprM a

166165liftGraphRefRelExpr m = do

167− context <- odce_context <$> ask

168− graph <- odce_graph <$> ask

166+ context <- asks odce_context

167+ graph <- asks odce_graph

169168 lift $ except $ runGraphRefSOptRelationalExprM (Just context) graph m

170169

171170fullOptimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr

@@ -358,10 +357,8 @@ applyStaticPredicateOptimization predi = do

358357 OrPredicate pred1 pred2 -> do

359358 optPredA <- applyStaticPredicateOptimization pred1

360359 optPredB <- applyStaticPredicateOptimization pred2

361− if optPredA == optPredB then

360+ if (optPredA == optPredB) || isTrueExpr optPredA then

362361 pure optPredA

363− else if isTrueExpr optPredA then

364− pure optPredA -- True or x -> True

365362 else if isTrueExpr optPredB then

366363 pure optPredB

367364 else

@@ -577,4 +574,4 @@ applyStaticRestrictionPushdown expr = case expr of

577574

578575-- no optimizations available

579576optimizeDatabaseContextIOExpr :: GraphRefDatabaseContextIOExpr -> GraphRefSOptDatabaseContextExprM GraphRefDatabaseContextIOExpr

580−optimizeDatabaseContextIOExpr x = pure x

577+optimizeDatabaseContextIOExpr = pure

src/lib/ProjectM36/TransGraphPlanExpr.hsdeleted−5

@@ -1,5 +0,0 @@

1−module ProjectM36.TransGraphPlanExpr where

2−import ProjectM36.Base

3−-- used to create an execution plan which can potentially read from the query cache

4−

5−data TransGraphPlanExpr = ExecuteTransGraphRelationalExprPlan TransGraphRelationalExpr

src/lib/ProjectM36/TransGraphRelationalExpression.hs+2−2

@@ -47,7 +47,7 @@ type TransGraphWithNameExpr = WithNameExprBase TransactionIdLookup

4747

4848instance Binary TransGraphWithNameExpr

4949

50−data TransGraphEvalEnv = TransGraphEvalEnv {

50+newtype TransGraphEvalEnv = TransGraphEvalEnv {

5151 tge_graph :: TransactionGraph

5252 }

5353

@@ -169,7 +169,7 @@ evalTransGraphRestrictionPredicateExpr (AttributeEqualityPredicate attrName expr

169169 AttributeEqualityPredicate attrName <$> expr'

170170

171171processTransGraphExtendTupleExpr :: TransGraphExtendTupleExpr -> TransGraphEvalMonad GraphRefExtendTupleExpr

172−processTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) = do

172+processTransGraphExtendTupleExpr (AttributeExtendTupleExpr attrName expr) =

173173 AttributeExtendTupleExpr attrName <$> processTransGraphAtomExpr expr

174174

175175processTransGraphAttributeExpr :: TransGraphAttributeExpr -> TransGraphEvalMonad GraphRefAttributeExpr

src/lib/ProjectM36/Transaction.hs+2−2

@@ -18,7 +18,7 @@ singleParent tid = tid NE.:| []

1818filterTransactionInfoTransactions :: S.Set TransactionId -> TransactionInfo -> TransactionInfo

1919filterTransactionInfoTransactions filterIds tinfo =

2020 TransactionInfo { parents = case

21− NE.filter (\parent -> S.member parent filterIds) (parents tinfo) of

21+ NE.filter (`S.member` filterIds) (parents tinfo) of

2222 [] -> rootParent

2323 xs -> NE.fromList xs,

2424 stamp = stamp tinfo }

@@ -43,7 +43,7 @@ subschemas :: Transaction -> Subschemas

4343subschemas (Transaction _ _ (Schemas _ sschemas)) = sschemas

4444

4545fresh :: TransactionId -> UTCTime -> Schemas -> Transaction

46−fresh freshId stamp' newSchemas = Transaction freshId (TransactionInfo rootParent stamp') newSchemas

46+fresh freshId stamp' = Transaction freshId (TransactionInfo rootParent stamp')

4747

4848timestamp :: Transaction -> UTCTime

4949timestamp (Transaction _ tinfo _) = stamp tinfo

src/lib/ProjectM36/Transaction/Persist.hs+1−1

@@ -102,7 +102,7 @@ writeRelVars sync transDir relvars = do

102102 writeBSFileSync sync path (B.encode relvars)

103103

104104readRelVars :: FilePath -> IO RelationVariables

105−readRelVars transDir = do

105+readRelVars transDir =

106106 B.decodeFile (relvarsPath transDir)

107107

108108writeAtomFuncs :: DiskSync -> FilePath -> AtomFunctions -> IO ()

src/lib/ProjectM36/TransactionGraph.hs+2−7

@@ -30,11 +30,6 @@ import Data.Monoid

3030import Control.Arrow

3131import Data.Maybe

3232import Data.UUID.V4

33−#if __GLASGOW_HASKELL__ <= 802

34−import Data.Monoid

35−#endif

36−

37−--import Debug.Trace

3833

3934-- | Record a lookup for a specific transaction in the graph.

4035data TransactionIdLookup = TransactionIdLookup TransactionId |

@@ -79,7 +74,7 @@ freshTransactionGraph :: DatabaseContext -> IO (TransactionGraph, TransactionId)

7974freshTransactionGraph ctx = do

8075 now <- getCurrentTime

8176 freshId <- nextRandom

82− pure $ (bootstrapTransactionGraph now freshId ctx, freshId)

77+ pure (bootstrapTransactionGraph now freshId ctx, freshId)

8378

8479

8580emptyTransactionGraph :: TransactionGraph

@@ -112,7 +107,7 @@ rootTransactions graph = S.filter isRootTransaction (transactionsForGraph graph)

112107

113108-- the first transaction has no parent - all other do have parents- merges have two parents

114109parentTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

115−parentTransactions trans graph = transactionsForIds (parentIds trans) graph

110+parentTransactions trans = transactionsForIds (parentIds trans)

116111

117112childTransactions :: Transaction -> TransactionGraph -> Either RelationalError (S.Set Transaction)

118113childTransactions trans graph = transactionsForIds childIds graph

src/lib/ProjectM36/TransactionGraph/Merge.hs+1−1

@@ -47,7 +47,7 @@ unionMergeRelVars prefer relvarsA relvarsB = do

4747 lookupA = findRel relvarsA

4848 lookupB = findRel relvarsB

4949 case (lookupA, lookupB) of

50− (Just relA, Just relB) -> do

50+ (Just relA, Just relB) ->

5151 unionMergeRelation prefer relA relB

5252 (Nothing, Just relB) -> pure relB

5353 (Just relA, Nothing) -> pure relA

src/lib/ProjectM36/TransactionGraph/Persist.hs−3

@@ -32,9 +32,6 @@ import Control.Arrow

3232import Data.Time.Clock

3333import Data.Text.Read

3434import System.FilePath.Glob

35−#if __GLASGOW_HASKELL__ <= 802

36−import Data.Monoid

37−#endif

3835

3936type LockFileHash = ByteString

4037

src/lib/ProjectM36/Tupleable.hs−3

@@ -26,9 +26,6 @@ import ProjectM36.Error

2626import ProjectM36.Tuple

2727import ProjectM36.TupleSet

2828import qualified Data.Set as S

29−#if __GLASGOW_HASKELL__ <= 802

30−import Data.Monoid

31−#endif

3229

3330{-import Data.Binary

3431import Control.DeepSeq

src/lib/ProjectM36/WithNameExpr.hs+1−1

@@ -17,7 +17,7 @@ substituteWithNameMacros macros e@(RelationVariable rvname tid) =

1717 macroFilt (WithNameExpr macroName macroTid, _) = rvname == macroName && tid== macroTid in

1818 case filter macroFilt macros of

1919 [] -> e

20− (_,replacement):[] -> replacement

20+ [(_,replacement)] -> replacement

2121 _ -> error "more than one macro matched!"

2222substituteWithNameMacros macros (Project attrs expr) =

2323 Project attrs (substituteWithNameMacros macros expr)

test/TutorialD/Interpreter.hs+2−2

@@ -149,7 +149,7 @@ dateExampleRelTests = TestCase $ do

149149 else Right tuple) suppliersRel

150150 extendTestAttributes = A.attributesFromList [Attribute "a" IntegerAtomType, Attribute "b" $ RelationAtomType (R.attributes suppliersRel)]

151151 testTups = [("x:=s where true", Right suppliersRel),

152− ("x:=s where city = \"London\"", restrict (\tuple -> pure $ atomForAttributeName "city" tuple == (Right $ TextAtom "London")) suppliersRel),

152+ ("x:=s where city = \"London\"", restrict (\tuple -> pure $ atomForAttributeName "city" tuple == Right (TextAtom "London")) suppliersRel),

153153 ("x:=s where false", Right $ Relation (R.attributes suppliersRel) emptyTupleSet),

154154 ("x:=p where color=\"Blue\" and city=\"Paris\"", mkRelationFromList (R.attributes productsRel) [[TextAtom "P5", TextAtom "Cam", TextAtom "Blue", IntegerAtom 12, TextAtom "Paris"]]),

155155 ("a:=s; update a (status:=50); x:=a{status}", mkRelation (A.attributesFromList [Attribute "status" IntegerAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "status" IntegerAtomType]) (V.fromList [IntegerAtom 50])])),

@@ -157,7 +157,7 @@ dateExampleRelTests = TestCase $ do

157157 --atom function tests

158158 ("x:=((s : {status2 := add(10,@status)}) where status2=add(10,@status)){city,s#,sname,status}", Right suppliersRel),

159159 ("x:=relation{tuple{a 5}} : {b:=s}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [IntegerAtom 5, RelationAtom suppliersRel])])),

160− ("x:=s; update x where sname=\"Blake\" (city:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "sname" tuple == (Right $ TextAtom "Blake") then Right $ updateTupleWithAtoms (M.singleton "city" (TextAtom "Boston")) tuple else Right tuple) suppliersRel),

160+ ("x:=s; update x where sname=\"Blake\" (city:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "sname" tuple == Right (TextAtom "Blake") then Right $ updateTupleWithAtoms (M.singleton "city" (TextAtom "Boston")) tuple else Right tuple) suppliersRel),

161161 ("x:=s; update x where city=\"Paris\" (status:=add(@status,10))", updateParisPlus10),

162162 --relatom function tests

163163 ("x:=((s group ({city} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ IntegerAtom 1)])),