56286b0 · project-m36 · git.iko.soy

git.iko.soy/project-m36

fix new hlint warnings regarding use of fmap

commit56286b04df43e26cce2f373111c6a455deeebb09 authorAgentM <agentm@themactionfaction.com> dateSat 13 Jan 2018, 23:19 (9 years ago) parent6b3a1f3

11 files changed+39−67

compare with master

unifiedsplit

src/bin/TutorialD/Interpreter/DatabaseContextExpr.hs+2−5 src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+5−10 src/bin/TutorialD/Interpreter/RelationalExpr.hs+8−16 src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+3−6 src/lib/ProjectM36/Base.hs+1−3 src/lib/ProjectM36/Relation.hs+3−5 src/lib/ProjectM36/Relation/Parse/CSV.hs+1−1 src/lib/ProjectM36/Transaction/Persist.hs+8−9 src/lib/ProjectM36/TransactionGraph.hs+5−6 src/lib/ProjectM36/TransactionGraph/Persist.hs+1−3 src/lib/ProjectM36/Tuple.hs+2−3

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

@@ -77,15 +77,12 @@ defineP = do

7777undefineP :: Parser DatabaseContextExpr

7878undefineP = do

7979 reservedOp "undefine"

80− relVarName <- identifier

81− return $ Undefine relVarName

80+ Undefine <$> identifier

8281

8382deleteP :: Parser DatabaseContextExpr

8483deleteP = do

8584 reservedOp "delete"

86− relVarName <- identifier

87− predicate <- option TruePredicate (reservedOp "where" *> restrictionPredicateP)

88− return $ Delete relVarName predicate

85+ Delete <$> identifier <*> option TruePredicate (reservedOp "where" *> restrictionPredicateP)

8986

9087updateP :: Parser DatabaseContextExpr

9188updateP = do

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs+5−10

@@ -30,20 +30,17 @@ data RODatabaseContextOperator where

3030typeP :: Parser RODatabaseContextOperator

3131typeP = do

3232 reservedOp ":type"

33− expr <- relExprP

34− return $ ShowRelationType expr

33+ ShowRelationType <$> relExprP

3534

3635showRelP :: Parser RODatabaseContextOperator

3736showRelP = do

3837 reservedOp ":showexpr"

39− expr <- relExprP

40− return $ ShowRelation expr

38+ ShowRelation <$> relExprP

4139

4240showPlanP :: Parser RODatabaseContextOperator

4341showPlanP = do

4442 reservedOp ":showplan"

45− expr <- databaseContextExprP

46− return $ ShowPlan expr

43+ ShowPlan <$> databaseContextExprP

4744

4845showTypesP :: Parser RODatabaseContextOperator

4946showTypesP = reserved ":showtypes" >> pure ShowTypes

@@ -59,14 +56,12 @@ quitP = do

5956showConstraintsP :: Parser RODatabaseContextOperator

6057showConstraintsP = do

6158 reservedOp ":constraints"

62− constraintName <- option "" identifier

63− return $ ShowConstraint constraintName

59+ ShowConstraint <$> option "" identifier

6460

6561plotRelExprP :: Parser RODatabaseContextOperator

6662plotRelExprP = do

6763 reserved ":plotexpr"

68− expr <- relExprP

69− return $ PlotRelation expr

64+ PlotRelation <$> relExprP

7065

7166roDatabaseContextOperatorP :: Parser RODatabaseContextOperator

7267roDatabaseContextOperatorP = typeP

src/bin/TutorialD/Interpreter/RelationalExpr.hs+8−16

@@ -112,8 +112,7 @@ ungroupP = do

112112extendP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a)

113113extendP = do

114114 reservedOp ":"

115− tupleExpr <- braces extendTupleExpressionP

116− return $ Extend tupleExpr

115+ Extend <$> braces extendTupleExpressionP

117116

118117semijoinP :: RelationalMarkerExpr a => Parser (RelationalExprBase a -> RelationalExprBase a -> RelationalExprBase a)

119118semijoinP = do

@@ -169,17 +168,15 @@ restrictionPredicateP = makeExprParser predicateTerm predicateOperators

169168 <|> relationalBooleanExprP

170169

171170relationalBooleanExprP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

172−relationalBooleanExprP = do

173− relexpr <- parens relExprP <|> relTerm

171+relationalBooleanExprP =

174172 --we can't actually detect if the type is relational boolean, so we just pass it to the next phase

175− return $ RelationalExprPredicate relexpr

173+ RelationalExprPredicate <$> (parens relExprP <|> relTerm)

176174

177175restrictionAttributeEqualityP :: RelationalMarkerExpr a => Parser (RestrictionPredicateExprBase a)

178176restrictionAttributeEqualityP = do

179177 attributeName <- identifier

180178 reservedOp "="

181− atomexpr <- atomExprP

182− return $ AttributeEqualityPredicate attributeName atomexpr

179+ AttributeEqualityPredicate attributeName <$> atomExprP

183180

184181restrictionAtomExprP :: RelationalMarkerExpr a=> Parser (RestrictionPredicateExprBase a) --atoms which are of type "boolean"

185182restrictionAtomExprP = do

@@ -196,8 +193,7 @@ attributeExtendTupleExpressionP :: RelationalMarkerExpr a => Parser (ExtendTuple

196193attributeExtendTupleExpressionP = do

197194 newAttr <- identifier

198195 reservedOp ":="

199− atom <- atomExprP

200− return $ AttributeExtendTupleExpr newAttr atom

196+ AttributeExtendTupleExpr newAttr <$> atomExprP

201197

202198atomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

203199atomExprP = consumeAtomExprP True

@@ -213,8 +209,7 @@ consumeAtomExprP consume = try functionAtomExprP <|>

213209attributeAtomExprP :: Parser (AtomExprBase a)

214210attributeAtomExprP = do

215211 _ <- string "@"

216− attrName <- identifier

217− return $ AttributeAtomExpr attrName

212+ AttributeAtomExpr <$> identifier

218213

219214nakedAtomExprP :: Parser (AtomExprBase a)

220215nakedAtomExprP = NakedAtomExpr <$> atomP

@@ -234,11 +229,8 @@ atomP = stringAtomP <|>

234229 boolAtomP

235230

236231functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

237−functionAtomExprP = do

238− funcName <- identifier

239− argList <- parens (sepBy atomExprP comma)

240− marker <- parseMarkerP

241− return $ FunctionAtomExpr funcName argList marker

232+functionAtomExprP =

233+ FunctionAtomExpr <$> identifier <*> parens (sepBy atomExprP comma) <*> parseMarkerP

242234

243235relationalAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)

244236relationalAtomExprP = RelationAtomExpr <$> relExprP

src/bin/TutorialD/Interpreter/TransactionGraphOperator.hs+3−6

@@ -22,14 +22,12 @@ autoMergeToHeadP = do

2222jumpToHeadP :: Parser TransactionGraphOperator

2323jumpToHeadP = do

2424 reservedOp ":jumphead"

25− headid <- identifier

26− return $ JumpToHead headid

25+ JumpToHead <$> identifier

2726

2827jumpToTransactionP :: Parser TransactionGraphOperator

2928jumpToTransactionP = do

3029 reservedOp ":jump"

31− uuid <- uuidP

32− return $ JumpToTransaction uuid

30+ JumpToTransaction <$> uuidP

3331

3432walkBackToTimeP :: Parser TransactionGraphOperator

3533walkBackToTimeP = do

@@ -39,8 +37,7 @@ walkBackToTimeP = do

3937branchTransactionP :: Parser TransactionGraphOperator

4038branchTransactionP = do

4139 reservedOp ":branch"

42− branchName <- identifier

43− return $ Branch branchName

40+ Branch <$> identifier

4441

4542deleteBranchP :: Parser TransactionGraphOperator

4643deleteBranchP = do

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

@@ -58,9 +58,7 @@ instance Hashable Atom where

5858

5959instance Binary UTCTime where

6060 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

61− get = do

62− r <- get :: Get Rational

63− return (posixSecondsToUTCTime (fromRational r))

61+ get = posixSecondsToUTCTime . fromRational <$> (get :: Get Rational)

6462

6563instance Binary Day where

6664 put day = put $ toGregorian day

src/lib/ProjectM36/Relation.hs+3−5

@@ -37,9 +37,8 @@ atomTypeForName :: AttributeName -> Relation -> Either RelationalError AtomType

3737atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrName attrs

3838

3939mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

40−mkRelationFromList attrs atomMatrix = do

41− tupSet <- mkTupleSetFromList attrs atomMatrix

42− return $ Relation attrs tupSet

40+mkRelationFromList attrs atomMatrix =

41+ Relation attrs <$> mkTupleSetFromList attrs atomMatrix

4342

4443emptyRelationWithAttrs :: Attributes -> Relation

4544emptyRelationWithAttrs attrs = Relation attrs emptyTupleSet

@@ -220,8 +219,7 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

220219 joinedTupSet <- singleTupleSetJoin newAttrs tuple1 tupSet2

221220 return $ joinedTupSet ++ accumulator

222221 newTupSetList <- foldM tupleSetJoiner [] (asList tupSet1)

223− newTupSet <- mkTupleSet newAttrs newTupSetList

224− return $ Relation newAttrs newTupSet

222+ Relation newAttrs <$> mkTupleSet newAttrs newTupSetList

225223

226224-- | Difference takes two relations of the same type and returns a new relation which contains only tuples which appear in the first relation but not the second.

227225difference :: Relation -> Relation -> Either RelationalError Relation

src/lib/ProjectM36/Relation/Parse/CSV.hs+1−1

@@ -57,7 +57,7 @@ csvAsRelation attrs tConsMap inString = case APBL.parse (csvWithHeader csvDecode

5757

5858

5959parseCSVAtomP :: AttributeName -> TypeConstructorMapping -> AtomType -> APT.Parser (Either RelationalError Atom)

60−parseCSVAtomP _ _ IntegerAtomType = (Right . IntegerAtom) <$> APT.decimal

60+parseCSVAtomP _ _ IntegerAtomType = Right . IntegerAtom <$> APT.decimal

6161parseCSVAtomP _ _ IntAtomType = Right . IntAtom <$> APT.decimal

6262parseCSVAtomP _ _ DoubleAtomType = Right . DoubleAtom <$> APT.double

6363parseCSVAtomP _ _ TextAtomType = do

src/lib/ProjectM36/Transaction/Persist.hs+8−9

@@ -23,9 +23,9 @@ import qualified Data.ByteString as BS

2323import qualified Data.ByteString.Lazy as BSL

2424

2525getDirectoryNames :: FilePath -> IO [FilePath]

26−getDirectoryNames path = do

27− subpaths <- getDirectoryContents path

28− return $ filter (\n -> n `notElem` ["..", "."]) subpaths

26+getDirectoryNames path =

27+ filter (\ n -> n `notElem` ["..", "."]) <$> getDirectoryContents path

28+

2929

3030tempTransactionDir :: FilePath -> TransactionId -> FilePath

3131tempTransactionDir dbdir transId = dbdir </> "." ++ show transId

@@ -109,10 +109,10 @@ readRelVars :: FilePath -> IO (M.Map RelVarName Relation)

109109readRelVars transDir = do

110110 let relvarsPath = relvarsDir transDir

111111 relvarNames <- getDirectoryNames relvarsPath

112− relvars <- mapM (\name -> do

112+ let relvars = mapM (\name -> do

113113 rel <- B.decode . decompress . BSL.fromStrict <$> BS.readFile (relvarsPath </> name)

114114 return (T.pack name, rel)) relvarNames

115− return $ M.fromList relvars

115+ M.fromList <$> relvars

116116

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

118118writeAtomFuncs sync transDir funcs = do

@@ -191,8 +191,8 @@ readDBCFuncs transDir mScriptSession = do

191191 funcNames <- getDirectoryNames (dbcFuncsDir transDir)

192192 --only Haskell script functions can be serialized

193193 --we always return the pre-compiled functions

194− funcs <- mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

195− return $ HS.union basicDatabaseContextFunctions (HS.fromList funcs)

194+ let funcs = mapM ((\name -> readDBCFunc transDir name mScriptSession precompiledDatabaseContextFunctions) . T.pack) funcNames

195+ HS.union basicDatabaseContextFunctions . HS.fromList <$> funcs

196196

197197readDBCFunc :: FilePath -> DatabaseContextFunctionName -> Maybe ScriptSession -> DatabaseContextFunctions -> IO DatabaseContextFunction

198198readDBCFunc transDir funcName mScriptSession precompiledFuncs = do

@@ -232,8 +232,7 @@ readIncDeps :: FilePath -> IO (M.Map IncDepName InclusionDependency)

232232readIncDeps transDir = do

233233 let incDepsPath = incDepsDir transDir

234234 incDepNames <- getDirectoryNames incDepsPath

235− incDeps <- mapM (readIncDep transDir . T.pack) incDepNames

236− return $ M.fromList incDeps

235+ M.fromList <$> mapM (readIncDep transDir . T.pack) incDepNames

237236

238237readSubschemas :: FilePath -> IO Subschemas

239238readSubschemas transDir = do

src/lib/ProjectM36/TransactionGraph.hs+5−6

@@ -98,9 +98,8 @@ transactionForId tid graph

9898 matchingTrans = S.filter (\(Transaction idMatch _ _) -> idMatch == tid) (transactionsForGraph graph)

9999

100100transactionsForIds :: S.Set TransactionId -> TransactionGraph -> Either RelationalError (S.Set Transaction)

101−transactionsForIds idSet graph = do

102− transList <- forM (S.toList idSet) (`transactionForId` graph)

103− return (S.fromList transList)

101+transactionsForIds idSet graph =

102+ S.fromList <$> forM (S.toList idSet) (`transactionForId` graph)

104103

105104isRootTransaction :: Transaction -> TransactionGraph -> Bool

106105isRootTransaction (Transaction _ (TransactionInfo pId _ _) _) _ = U.null pId

@@ -108,9 +107,9 @@ isRootTransaction (Transaction _ MergeTransactionInfo{} _) _ = False

108107

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

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

111−parentTransactions (Transaction _ (TransactionInfo pId _ _) _) graph = do

112− trans <- transactionForId pId graph

113− return (S.singleton trans)

110+parentTransactions (Transaction _ (TransactionInfo pId _ _) _) graph =

111+ S.singleton <$> transactionForId pId graph

112+

114113

115114parentTransactions (Transaction _ (MergeTransactionInfo pId1 pId2 _ _) _ ) graph = transactionsForIds (S.fromList [pId1, pId2]) graph

116115

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

@@ -211,7 +211,5 @@ readGraphTransactionIdFile dbdir = do

211211 (readUUID tid, readEpoch epochText, map readUUID parentIds)

212212 readUUID uuidText = fromMaybe (error "failed to read uuid") (U.fromText uuidText)

213213 readEpoch t = posixSecondsToUTCTime (realToFrac (either (error "failed to read epoch") fst (double t)))

214− --warning: uses lazy IO

215− graphTransactionIdData <- TIO.readFile (transactionLogPath dbdir)

216− return $ Right (map grapher $ T.lines graphTransactionIdData)

214+ Right . map grapher . T.lines <$> TIO.readFile (transactionLogPath dbdir)

217215

src/lib/ProjectM36/Tuple.hs+2−3

@@ -56,9 +56,8 @@ atomTypeForAttributeName attrName tup = do

5656-}

5757

5858atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> Either RelationalError (V.Vector Atom)

59−atomsForAttributeNames attrNames tuple = do

60− vindices <- vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

61− return $ V.map (\index -> tupleAtoms tuple V.! index) vindices

59+atomsForAttributeNames attrNames tuple =

60+ V.map (\index -> tupleAtoms tuple V.! index) <$> vectorIndicesForAttributeNames attrNames (tupleAttributes tuple)

6261

6362vectorIndicesForAttributeNames :: V.Vector AttributeName -> Attributes -> Either RelationalError (V.Vector Int)

6463vectorIndicesForAttributeNames attrNameVec attrs = if not $ V.null unknownAttrNames then