28c57c9 · project-m36 · git.iko.soy

git.iko.soy/project-m36

updates for latest hlint suggestions

commit28c57c9deb50ed4f9eae47d2d0fea4323d260131 authorAgentM <agentm@themactionfaction.com> dateTue 25 Feb 2020, 22:54 (7 years ago) parent630af15

7 files changed+36−12

compare with master

unifiedsplit

src/lib/ProjectM36/AtomType.hs+6−1 src/lib/ProjectM36/Client.hs+12−3 src/lib/ProjectM36/RelationalExpression.hs+7−3 src/lib/ProjectM36/ScriptSession.hs+1−1 src/lib/ProjectM36/Server.hs+7−1 test/Relation/Basic.hs+1−1 test/TutorialD/Interpreter.hs+2−2

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

@@ -346,7 +346,12 @@ atomTypeVerify x y = if x == y then

346346

347347-- | Determine if two typeVars are logically compatible.

348348typeVarMapsVerify :: TypeVarMap -> TypeVarMap -> Bool

349−typeVarMapsVerify a b = M.keysSet a == M.keysSet b && (length . rights) (map (\((_,v1),(_,v2)) -> atomTypeVerify v1 v2) (zip (M.toAscList a) (M.toAscList b))) == M.size a

349+typeVarMapsVerify a b = M.keysSet a == M.keysSet b && (length . rights) zipped == M.size a

350+ where

351+ zipped = zipWith

352+ (curry (\ ((_, v1), (_, v2)) -> atomTypeVerify v1 v2))

353+ (M.toAscList a)

354+ (M.toAscList b)

350355

351356prettyAtomType :: AtomType -> T.Text

352357prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map prettyAttribute (V.toList attrs)) `T.append` "}"

src/lib/ProjectM36/Client.hs+12−3

@@ -135,7 +135,10 @@ import GHC.Conc.Sync

135135

136136import Network.Transport (Transport(closeTransport))

137137

138−#if MIN_VERSION_network_transport_tcp(0,6,0)

138+#if MIN_VERSION_network_transport_tcp(0,7,0)

139+import Network.Transport.TCP (createTransport, defaultTCPParameters, defaultTCPAddr)

140+import Network.Transport.TCP.Internal (encodeEndPointAddress)

141+#elif MIN_VERSION_network_transport_tcp(0,6,0)

139142import Network.Transport.TCP (createTransport, defaultTCPParameters)

140143import Network.Transport.TCP.Internal (encodeEndPointAddress)

141144#else

@@ -269,7 +272,9 @@ remoteDBLookupName = (++) "db-"

269272

270273createLocalNode :: IO (LocalNode, Transport)

271274createLocalNode = do

272−#if MIN_VERSION_network_transport_tcp(0,6,0)

275+#if MIN_VERSION_network_transport_tcp(0,7,0)

276+ eLocalTransport <- createTransport (defaultTCPAddr "127.0.0.1" "0") defaultTCPParameters

277+#elif MIN_VERSION_network_transport_tcp(0,6,0)

273278 eLocalTransport <- createTransport "127.0.0.1" "0" (\sn -> ("127.0.0.1", sn)) defaultTCPParameters

274279#else

275280 eLocalTransport <- createTransport "127.0.0.1" "0" defaultTCPParameters

@@ -1159,7 +1164,11 @@ executeDataFrameExpr sessionId conn@(InProcessConnection _) dfExpr = do

11591164 case verified of

11601165 Left err -> pure (Left err)

11611166 Right attrs -> do

1162− let attrOrders = map (\(attr',order') -> DF.AttributeOrder (attributeName attr') order') (zip attrs orders)

1167+ let attrOrders = zipWith

1168+ (\attr' order'

1169+ -> DF.AttributeOrder (attributeName attr') order')

1170+ attrs

1171+ orders

11631172 case DF.sortDataFrameBy attrOrders . DF.toDataFrame $ rel of

11641173 Left err -> pure (Left err)

11651174 Right dFrame -> do

src/lib/ProjectM36/RelationalExpression.hs+7−3

@@ -501,9 +501,13 @@ evalDatabaseContextExpr (ExecuteDatabaseContextFunction funcName atomArgExprs) =

501501 _:_ -> pure (Left (someErrors (lefts eAtomTypes)))

502502 [] -> do

503503 let atomTypes = rights eAtomTypes

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

505− Left err -> Just err

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

504+ let mValidTypes = zipWith

505+ (\expType actType

506+ -> case atomTypeVerify expType actType of

507+ Left err -> Just err

508+ Right _ -> Nothing)

509+ (dbcFuncType func)

510+ atomTypes

507511 typeErrors = catMaybes mValidTypes

508512 eAtomArgs = map (\arg -> runReader (evalAtomExpr emptyTuple arg) relExprState) atomArgExprs

509513 if length (lefts eAtomArgs) > 1 then

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

@@ -170,7 +170,7 @@ initScriptSession ghcPkgPaths = do

170170addImport :: String -> Ghc ()

171171addImport moduleNam = do

172172 ctx <- getContext

173− setContext ( (IIDecl $ simpleImportDecl (mkModuleName moduleNam)) : ctx )

173+ setContext (IIDecl (simpleImportDecl (mkModuleName moduleNam)) : ctx)

174174

175175showType :: DynFlags -> Type -> String

176176showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)

src/lib/ProjectM36/Server.hs+7−1

@@ -8,7 +8,11 @@ import ProjectM36.Server.Config (ServerConfig(..))

88import ProjectM36.FSType

1010import Control.Monad.IO.Class (liftIO)

11+#if MIN_VERSION_network_transport_tcp(0,7,0)

12+import Network.Transport.TCP (createTransport, defaultTCPParameters, defaultTCPAddr)

13+#else

1114import Network.Transport.TCP (createTransport, defaultTCPParameters)

15+#endif

1216import Network.Transport (EndPointAddress(..), newEndPoint, address)

1317import Control.Distributed.Process.Node (initRemoteTable, runProcess, newLocalNode, initRemoteTable)

1418import Control.Distributed.Process.Extras.Time (Delay(..))

@@ -113,7 +117,9 @@ launchServer daemonConfig mAddressMVar = do

113117 Right conn -> do

114118 let hostname = bindHost daemonConfig

115119 port = bindPort daemonConfig

116−#if MIN_VERSION_network_transport_tcp(0,6,0)

120+#if MIN_VERSION_network_transport_tcp(0,7,0)

121+ etransport <- createTransport (defaultTCPAddr hostname (show port)) defaultTCPParameters

122+#elif MIN_VERSION_network_transport_tcp(0,6,0)

117123 etransport <- createTransport hostname (show port) (\nam -> (hostname, nam)) defaultTCPParameters

118124#else

119125 etransport <- createTransport hostname (show port) defaultTCPParameters

test/Relation/Basic.hs+1−1

@@ -64,7 +64,7 @@ validateAttrTypesMatchTupleAttrTypes rel@(Relation attrs tupSet) = foldr (\tuple

6464 tupleAtomCheck tuple = V.all (== True) (attrChecks tuple)

6565 attrChecks tuple = V.map (\attr -> case atomForAttributeName (A.attributeName attr) tuple of

6666 Left _ -> False

67− Right atom -> (Right $ atomTypeForAtom atom) ==

67+ Right atom -> Right (atomTypeForAtom atom) ==

6868 A.atomTypeForAttributeName (A.attributeName attr) attrs) (attributes rel)

6969

7070simpleRel :: Relation

test/TutorialD/Interpreter.hs+2−2

@@ -134,7 +134,7 @@ main = do

134134 Right $ updateTupleWithAtoms (M.singleton "status" (IntegerAtom (castInteger statusAtom + 10))) tuple

135135 else Right tuple) suppliersRel

136136 dateExampleRelTests = [("x:=s where true", Right suppliersRel),

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

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

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

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

140140 ("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])])),

@@ -142,7 +142,7 @@ main = do

142142 --atom function tests

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

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

145− ("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),

145+ ("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),

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

147147 --relatom function tests

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