chore: changes in preparation for hlint 3.6

We will shortly bump our haskell.nix, which will bring in a new version of hlint. This adds some new linting checks which, before this commit, we would fail. Signed-off-by: Ben Price <[email protected]>
hackworthltd · Jul 10, 2023 · a4d5d28 · a4d5d28
1 parent ff6c255
commit a4d5d28
Show file tree

Hide file tree

Showing 6 changed files with 27 additions and 12 deletions.
diff --git a/primer/gen/Primer/Gen/Core/Typed.hs b/primer/gen/Primer/Gen/Core/Typed.hs
@@ -272,7 +272,10 @@ genSyns ty = do
           Just . (APP () s aTy,) <$> substTy a aTy instTy
         _ -> pure Nothing
     genPrimCon' = do
-      genPrimCon <&> map (bimap (fmap $ PrimCon ()) (TCon ())) <&> filter (consistentTypes ty . snd) <&> \case
+      consistentCons <-
+        filter (consistentTypes ty . snd) . map (bimap (fmap $ PrimCon ()) (TCon ()))
+          <$> genPrimCon
+      pure $ case consistentCons of
         [] -> Nothing
         gens -> Just $ Gen.choice $ (\(g, t) -> (,t) <$> g) <$> gens
     genLet =

diff --git a/primer/src/Primer/Action.hs b/primer/src/Primer/Action.hs
@@ -737,7 +737,7 @@ conInfo ::
   m (Either Text (TC.Type, Int))
 conInfo c =
   asks (flip lookupConstructor c . TC.typeDefs) <&> \case
-    Just (vc, tc, td) -> Right (valConType tc td vc, length $ vc.valConArgs)
+    Just (vc, tc, td) -> Right (valConType tc td vc, length vc.valConArgs)
     Nothing -> Left $ "Could not find constructor " <> show c
 
 getTypeCache :: MonadError ActionError m => Expr -> m TypeCache

diff --git a/primer/src/Primer/Action/Available.hs b/primer/src/Primer/Action/Available.hs
@@ -34,7 +34,11 @@ import Data.Tuple.Extra (
   uncurry3,
  )
 import Optics (
+  Field2 (_2),
   afailing,
+  elemOf,
+  folded,
+  getting,
   to,
   view,
   (%),
@@ -85,7 +89,7 @@ import Primer.Core (
   _typeMetaLens,
  )
 import Primer.Core.Transform (decomposeTAppCon)
-import Primer.Core.Utils (forgetTypeMetadata, freeVars, freeVarsTy)
+import Primer.Core.Utils (forgetTypeMetadata, freeVars, _freeVarsTy)
 import Primer.Def (
   ASTDef (..),
   DefMap,
@@ -385,7 +389,10 @@ forTypeDefParamNode paramName l Editable tydefs defs tdName td =
         ( l == Expert
             && not
               ( typeInUse tdName td tydefs defs
-                  || any (elem paramName . freeVarsTy) (concatMap valConArgs $ astTypeDefConstructors td)
+                  || elemOf
+                    (to astTypeDefConstructors % folded % to valConArgs % folded % getting _freeVarsTy % _2)
+                    paramName
+                    td
               )
         )
         [NoInput DeleteTypeParam]

diff --git a/primer/src/Primer/App.hs b/primer/src/Primer/App.hs
@@ -85,6 +85,7 @@ import Optics (
   ReversibleOptic (re),
   elemOf,
   folded,
+  getting,
   ifoldMap,
   mapped,
   over,
@@ -171,7 +172,7 @@ import Primer.Core (
 import Primer.Core.DSL (S, create, emptyHole, tEmptyHole)
 import Primer.Core.DSL qualified as DSL
 import Primer.Core.Transform (renameTyVar, renameVar, unfoldTApp)
-import Primer.Core.Utils (freeVars, freeVarsTy, generateTypeIDs, regenerateExprIDs, regenerateTypeIDs, _freeTmVars, _freeTyVars, _freeVarsTy)
+import Primer.Core.Utils (freeVars, generateTypeIDs, regenerateExprIDs, regenerateTypeIDs, _freeTmVars, _freeTyVars, _freeVarsTy)
 import Primer.Def (
   ASTDef (..),
   Def (..),
@@ -799,8 +800,8 @@ applyProgAction prog = \case
             traverseOf
               #astTypeDefConstructors
               ( \cons -> do
-                  when
-                    (vcName `notElem` map valConName cons)
+                  unless
+                    (vcName `elem` map valConName cons)
                     (throwError $ ConNotFound vcName)
                   pure $ filter ((/= vcName) . valConName) cons
               )
@@ -907,13 +908,17 @@ applyProgAction prog = \case
         ( \td -> do
             checkTypeNotInUse tdName td $ m : ms
             when
-              (any (elem paramName . freeVarsTy) $ concatMap valConArgs $ astTypeDefConstructors td)
+              ( elemOf
+                  (to astTypeDefConstructors % folded % to valConArgs % folded % getting _freeVarsTy % _2)
+                  paramName
+                  td
+              )
               (throwError $ TypeParamInUse tdName paramName)
             traverseOf
               #astTypeDefParameters
               ( \ps -> do
-                  when
-                    (paramName `notElem` map fst ps)
+                  unless
+                    (paramName `elem` map fst ps)
                     (throwError $ ParamNotFound paramName)
                   pure $ filter ((/= paramName) . fst) ps
               )

diff --git a/primer/src/Primer/TypeDef.hs b/primer/src/Primer/TypeDef.hs
@@ -86,7 +86,7 @@ data ValCon b = ValCon
 valConType :: TyConName -> ASTTypeDef () -> ValCon () -> Type' ()
 valConType tc td vc =
   let ret = mkTAppCon tc (TVar () . fst <$> astTypeDefParameters td)
-      args = foldr (TFun ()) ret (forgetTypeMetadata <$> valConArgs vc)
+      args = foldr (TFun () . forgetTypeMetadata) ret (valConArgs vc)
       foralls = foldr (\(n, k) t -> TForall () n k t) args (astTypeDefParameters td)
    in foralls
 

diff --git a/primer/src/Primer/Zipper.hs b/primer/src/Primer/Zipper.hs
@@ -342,7 +342,7 @@ focusOn' i = fmap snd . search matchesID
       -- If the target has an embedded type, search the type for a match.
       -- If the target is a case expression with bindings, search each binding for a match.
       | otherwise =
-          let inType = focusType z >>= search (guarded (== i) . getID . target) <&> fst <&> InType
+          let inType = focusType z >>= search (guarded (== i) . getID . target) <&> InType . fst
               inCaseBinds = findInCaseBinds i z
            in inType <|> inCaseBinds