hlint-induced tidyings

haskell-experiments/src/Datalog/NaiveDatabase.hs

@@ -107,7 +107,7 @@ data BodyConstraint = BodyConstraint
 data RuleContext = RuleContext
   { __relation :: Relation
   , -- _variableNames :: [Text],
-    _headVariables :: [RuleElement]
+    _headEntries :: [RuleElement]
   , _bodyConstraints :: [BodyConstraint]
   , _db :: NaiveDatabase
   }
@@ -122,7 +122,7 @@ withFactsAndRules facts rules =
  where
   extractRule :: Text -> (Literal, [Literal])
   extractRule ruleText =
-    case (parseDatalog ruleText) of
+    case parseDatalog ruleText of
       Right (Rule (HeadSingle lhs) rhs) -> (lhs, rhs)
       Right otherStatement -> throw $ NonRuleException ruleText otherStatement
       Left ex -> throw $ CannotParseStatementException ruleText ex
@@ -130,7 +130,7 @@ withFactsAndRules facts rules =
   digestHead db relation (Literal neg relationName terms) =
     RuleContext
       { __relation = relation
-      , _headVariables = variables'
+      , _headEntries = variables'
       , _bodyConstraints = []
       , _db = NaiveDatabase relationMap' constants'
       }
@@ -145,7 +145,7 @@ withFactsAndRules facts rules =
   digestBody context (Literal neg subRelationName terms) =
     RuleContext
       { __relation = relation
-      , _headVariables = variables'
+      , _headEntries = variables'
       , _bodyConstraints = constraints'
       , _db = NaiveDatabase relationMap' constants'
       }
@@ -156,8 +156,8 @@ withFactsAndRules facts rules =
     relationMap :: Map RelationId Relation = relations (_db context)
     relationMap' = Map.insert subRelationName subRelation relationMap
     extraVariables = toElement <$> terms
-    extraConstants = catMaybes $ maybeConstant <$> extraVariables
-    variables' = nub $ _headVariables context ++ extraVariables
+    extraConstants = mapMaybe maybeConstant extraVariables
+    variables' = nub $ _headEntries context ++ extraVariables
     constants' = Set.union (constants (_db context)) $ Set.fromList extraConstants
     constraints = _bodyConstraints context
     newConstraint = BodyConstraint subRelation (toConstraint <$> terms)
@@ -182,14 +182,14 @@ withFactsAndRules facts rules =
     context'' = foldl digestBody context' body
     db' = _db context''
     relationMap = relations db'
-    variables' = _headVariables context''
+    variables' = _headEntries context''
     extractVarName :: RuleElement -> Maybe Text
     extractVarName (RuleElementVariable varName) = Just varName
     extractVarName (RuleElementConstant constant) = Nothing
     newRule =
       RelationRule
-        { headVariables = catMaybes $ extractVarName <$> variables'
-        , bodyElements = fromBodyConstraint <$> (_bodyConstraints context'')
+        { headVariables = mapMaybe extractVarName variables'
+        , bodyElements = fromBodyConstraint <$> _bodyConstraints context''
         }
      where
       fromBodyConstraint :: BodyConstraint -> RuleBodyElement
@@ -206,7 +206,7 @@ withFactsAndRules facts rules =
         { _name = _name relation
         , _arity = newArity
         , _tuples = _tuples relation
-        , _rules = (_rules relation) ++ [newRule]
+        , _rules = newRule : _rules relation
         }
     newRelationMap = Map.insert relationName relation' relationMap
     constants' = constants db'
@@ -216,7 +216,7 @@ withFactsAndRules facts rules =
 
 query :: NaiveDatabase -> Text -> Text
 query db qText =
-  case (parseDatalog qText) of
+  case parseDatalog qText of
     Right (Query texts literals) -> "#NYI"
     Right otherStatement -> throw $ NonQueryException qText otherStatement
     Left ex -> throw $ CannotParseStatementException qText ex

haskell-experiments/test/Test/Datalog/NaiveDatabaseSpec.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE NoFieldSelectors #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 
 module Test.Datalog.NaiveDatabaseSpec where
 
@@ -35,7 +36,7 @@ spec = do
         `shouldBe` Map.fromList
           [
             ( "parent"
-            , Relation "parent" 2 (Set.fromList $ map (Sym <$>) [["alice", "bob"], ["bob", "carol"]]) []
+            , Relation "parent" 2 (Set.fromList $ Sym <<$>> [["alice", "bob"], ["bob", "carol"]]) []
             )
           ]
     it "can ingest facts and rules" do
@@ -84,7 +85,7 @@ spec = do
               , _rules = [ancestorRule]
               }
       constants db
-        `shouldBe` (Set.fromList $ Sym <$> ["alice", "bob", "carol"])
+        `shouldBe` Set.fromList (Sym <$> ["alice", "bob", "carol"])
       relations db
         `shouldBe` Map.fromList
           [ ("ancestor", ancestorRelation)
@@ -114,7 +115,7 @@ spec = do
           ]
 
       constants db
-        `shouldBe` (Set.fromList $ Sym <$> ["patriarch"])
+        `shouldBe` Set.fromList (Sym <$> ["patriarch"])
 
     it "can do basic queries" do
       let db =
@@ -123,3 +124,13 @@ spec = do
               , "parent(\"bob\", \"carol\")."
               ]
       query db "?- parent(alice,X)." `shouldBe` "#NYI" -- ideally, 'bob'
+
+(<<$>>) :: (Functor f1, Functor f2) => (a -> b) -> f1 (f2 a) -> f1 (f2 b)
+(<<$>>) = fmap fmap fmap
+
+-- (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => f1 (f2 (a -> b)) -> f1 (f2 (f3 a -> f3 b))
+-- (<<<$>>>) :: Functor f => (a1 -> b) -> (a2 -> a1) -> f a2 -> f b
+-- (<<<$>>>) :: (Functor f1, Functor f2) => (a1 -> a2 -> b) -> f1 a1 -> f1 (f2 a2 -> f2 b)
+-- (<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => f1 (a -> b) -> f1 (f2 (f3 a) -> f2 (f3 b))
+(<<<$>>>) :: (Functor f1, Functor f2, Functor f3) => (a -> b) -> f1 (f2 (f3 a)) -> f1 (f2 (f3 b))
+(<<<$>>>) = fmap fmap fmap fmap fmap fmap fmap fmap