eb07d28 · project-m36 · git.iko.soy

git.iko.soy/project-m36

implement hlint suggestions

commiteb07d288d73aaf263e1c134a0ba2e77c72f3485d authorAgentM <agentm@themactionfaction.com> dateSun 7 Mar 2021, 21:32 (6 years ago) parent53ee56a

7 files changed+16−14

compare with master

unifiedsplit

src/bin/ProjectM36/Server/WebSocket.hs+2−1 src/bin/TutorialD/Interpreter.hs+2−1 src/lib/ProjectM36/Attribute.hs+6−6 src/lib/ProjectM36/Base.hs+2−2 src/lib/ProjectM36/Relation.hs+2−2 src/lib/ProjectM36/StaticOptimizer.hs+1−1 src/lib/ProjectM36/TransactionGraph.hs+1−1

src/bin/ProjectM36/Server/WebSocket.hs+2−1

@@ -22,6 +22,7 @@ import Data.Attoparsec.Text

2222import Control.Applicative

2323import Text.Megaparsec.Error

2424import Data.Functor

25+import Data.Either (fromRight)

2526

2627#if MIN_VERSION_megaparsec(7,0,0)

2728import Data.List.NonEmpty as NE

@@ -117,7 +118,7 @@ promptInfo :: SessionId -> Connection -> IO (HeadName, SchemaName)

117118promptInfo sessionId conn = do

118119 eHeadName <- headName sessionId conn

119120 eSchemaName <- currentSchemaName sessionId conn

120− pure (either (const "<unknown>") id eHeadName, either (const "<no schema>") id eSchemaName)

121+ pure (fromRight "<unknown>" eHeadName, fromRight "<no schema>" eSchemaName)

121122

122123sendPromptInfo :: (HeadName, SchemaName) -> WS.Connection -> IO ()

123124sendPromptInfo (hName, sName) conn = WS.sendTextData conn (encode (object ["promptInfo" .= object ["headname" .= hName, "schemaname" .= sName]]))

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

@@ -34,6 +34,7 @@ import Data.Monoid

3434import Data.List (isPrefixOf)

3535import Control.Exception

3636import System.Exit

37+import Data.Either (fromRight)

3738

3839{-

3940context ops are read-only operations which only operate on the database context (relvars and constraints)

@@ -77,7 +78,7 @@ safeInterpreterParserP = fmap RODatabaseContextOp (roDatabaseContextOperatorP <*

7778promptText :: Either RelationalError HeadName -> Either RelationalError SchemaName -> StringType

7879promptText eHeadName eSchemaName = "TutorialD (" <> transInfo <> "): "

7980 where

80− transInfo = either (const "<unknown>") id eHeadName <> "/" <> either (const "<no schema>") id eSchemaName

81+ transInfo = fromRight "<unknown>" eHeadName <> "/" <> fromRight "<no schema>" eSchemaName

8182

8283parseTutorialD :: T.Text -> Either ParserError ParsedOperation

8384parseTutorialD = parse interpreterParserP ""

src/lib/ProjectM36/Attribute.hs+6−6

@@ -87,12 +87,12 @@ joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length

8787 overlappingAttributes = V.filter (`V.elem` attrs2) attrs1

8888-}

8989joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes

90−joinAttributes attrs1 attrs2 =

91− if S.size overlappingNames == 0 then -- fast path, no overlapping names

90+joinAttributes attrs1 attrs2

91+ | S.size overlappingNames == 0 = -- fast path, no overlapping names

9292 pure (concated id)

93− else if attributesForNames overlappingNames attrs1 == attributesForNames overlappingNames attrs2 then -- check that atomtypes match

93+ | attributesForNames overlappingNames attrs1 == attributesForNames overlappingNames attrs2 = -- that atomtypes match

9494 pure (concated vectorUniqueify)

95− else

95+ | otherwise =

9696 --special handling to validate that overlapping names have the same atom types

9797 Left (TupleAttributeTypeMismatchError (attributesForNames overlappingNames attrs1))

9898 where

@@ -111,7 +111,7 @@ member :: Attribute -> Attributes -> Bool

111111member attr attrs = HS.member attr (attributesSet attrs)

112112

113113deleteAttributeName :: AttributeName -> Attributes -> Attributes

114−deleteAttributeName attrName attrs = deleteAttributeNames (S.singleton attrName) attrs

114+deleteAttributeName attrName = deleteAttributeNames (S.singleton attrName)

115115

116116deleteAttributeNames :: S.Set AttributeName -> Attributes -> Attributes

117117deleteAttributeNames attrNames attrs = Attributes {

@@ -215,7 +215,7 @@ attributesDifference attrsA attrsB =

215215 hset = HS.difference setA setB <> HS.difference setB setA

216216 setA = attributesSet attrsA

217217 setB = attributesSet attrsB

218− vec = V.filter (\attr -> HS.member attr hset) (attributesVec attrsA <> attributesVec attrsB)

218+ vec = V.filter (`HS.member` hset) (attributesVec attrsA <> attributesVec attrsB)

219219

220220vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a

221221vectorUniqueify vecIn = V.fromList $ HS.toList $ HS.fromList $ V.toList vecIn

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

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

1−{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,FlexibleInstances,OverloadedStrings, DeriveTraversable, DerivingVia, TemplateHaskell, TypeFamilies, DeriveFoldable, DeriveTraversable #-}

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

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

44module ProjectM36.Base where

@@ -102,7 +102,7 @@ instance Hashable Attribute where

102102type AttributesHash = Int

103103

104104-- | 'Attributes' represent the head of a relation.

105−data Attributes = Attributes {

105+newtype Attributes = Attributes {

106106 attributesVec :: V.Vector Attribute

107107 --,attributesSet :: HS.HashSet Attribute --compare with this generated in heap profile and benchmarks

108108 }

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

@@ -244,8 +244,8 @@ relMap mapper (Relation attrs tupleSet) =

244244

245245relMogrify :: (RelationTuple -> Either RelationalError RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

246246relMogrify mapper newAttributes (Relation _ tupSet) = do

247− newTuples <- mapM (\tup ->

248− reorderTuple newAttributes <$> mapper tup) (asList tupSet)

247+ newTuples <- mapM (fmap (reorderTuple newAttributes) . mapper) (asList tupSet)

248+

249249 mkRelationFromTuples newAttributes newTuples

250250

251251relFold :: (RelationTuple -> a -> a) -> a -> Relation -> a

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

@@ -177,7 +177,7 @@ fullOptimizeGraphRefRelationalExpr expr = do

177177optimizeGraphRefRelationalExpr :: GraphRefRelationalExpr -> GraphRefSOptRelationalExprM GraphRefRelationalExpr

178178optimizeGraphRefRelationalExpr e@(MakeStaticRelation _ _) = pure e

179179

180−optimizeGraphRefRelationalExpr e@(MakeRelationFromExprs{}) = pure e

180+optimizeGraphRefRelationalExpr e@MakeRelationFromExprs{} = pure e

181181

182182optimizeGraphRefRelationalExpr e@(ExistingRelation _) = pure e

183183

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

@@ -384,7 +384,7 @@ subGraphOfFirstCommonAncestor origGraph resultHeads currentTrans' goalTrans trav

384384 else do

385385 currentTransChildren <- childTransactions currentTrans' origGraph

386386 let searchChildren = S.difference (S.insert currentTrans' traverseSet) currentTransChildren

387− searchChild start = pathToTransaction origGraph start goalTrans (S.insert currentTrans' traverseSet)

387+ searchChild start' = pathToTransaction origGraph start' goalTrans (S.insert currentTrans' traverseSet)

388388 childSearches = map searchChild (S.toList searchChildren)

389389 errors = lefts childSearches

390390 pathsFound = rights childSearches