HLint everything and add to CI (#105)

Spring cleaning: thought I'd get rid of all the blue squiggles while
there weren't many open PRs. :)

I ran:
```bash
cabal install apply-refact hlint
for f in `git ls-files | grep -e '.*\.hs'`; do echo linting $f; hlint --refactor --refactor-options="-i" $f; done
```
And manually checked that nothing semantically changed.

~Also trying out a GitHub action that should generate lint suggestions
in the PRs.~
I thought the action would add PR suggestions in the web interface which
could be applied with one click, but it didn't do that, and going
through the CI logs feels a bit painful. This other action might do
that, but it needs some security/token set up so I'll save it for
another time:
https://github.com/haskell-actions/hlint-scan

For now, it just adds a hint to the PR diff view:

![image](https://github.com/plow-technologies/inferno/assets/10712637/525849ee-555d-455d-8c50-899040b29df8)

.github/hlint.json

@@ -0,0 +1,19 @@
+{
+  "problemMatcher": [
+    {
+      "owner": "hlint",
+      "pattern": [
+        {
+          "regexp": "^hlint\\t(?<file>[^\\t]*)\\t(?<fromPath>[^\\t]*)\\t(?<line>[^\\t]*)\\t(?<column>[^\\t]*)\\t(?<severity>[^\\t]*)\\t(?<code>[^\\t]*)\\t(?<message>[^\\t]*)$",
+          "file": 1,
+          "fromPath": 2,
+          "line": 3,
+          "column": 4,
+          "severity": 5,
+          "code": 6,
+          "message": 7
+        }
+      ]
+    }
+  ]
+}

.github/workflows/build.yml

@@ -19,7 +19,19 @@ jobs:
       MNIST_FNAME: /tmp/mnist/mnist.ts.pt
       MNIST_COMMIT: 94b288a631362aa44edc219eb8f54a7c39891169
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
+
+      # Lint code with HLint
+      - name: Set up HLint
+        uses: haskell-actions/hlint-setup@v2
+        with:
+          version: "3.8"
+      - name: Run HLint
+        uses: haskell-actions/hlint-run@v2
+        with:
+          path: '["inferno-core/", "inferno-lsp/", "inferno-ml/", "inferno-ml-server-types/", "inferno-types/", "inferno-vc/"]'
+          fail-on: error
+
       - uses: cachix/install-nix-action@v18
         with:
           install_url: https://releases.nixos.org/nix/nix-2.13.3/install
@@ -32,6 +44,8 @@ jobs:
           name: inferno
           authToken: "${{ secrets.CACHIX_TOKEN }}"
       - uses: DeterminateSystems/magic-nix-cache-action@main
+
+      # Build inferno and run all tests
       - run: |
           nix build -L .#
 

inferno-core/CHANGELOG.md

@@ -1,6 +1,9 @@
 # Revision History for inferno-core
 *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH)
 
+## 0.11.1.0 -- 2024-03-18
+* HLint everything
+
 ## 0.11.0.0 -- 2024-03-12
 * Add records to the Inferno language
 

inferno-core/inferno-core.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                inferno-core
-version:             0.11.0.0
+version:             0.11.1.0
 synopsis:            A statically-typed functional scripting language
 description:         Parser, type inference, and interpreter for a statically-typed functional scripting language
 category:            DSL,Scripting

inferno-core/src/Inferno/Core.hs

@@ -1,14 +1,13 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 
 module Inferno.Core where
 
 import Control.Monad (foldM)
 import Control.Monad.Catch (MonadCatch, MonadThrow)
 import Control.Monad.Except (MonadFix)
-import Data.Bifunctor (bimap)
+import Data.Bifunctor (bimap, first)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -130,7 +129,7 @@ mkInferno prelude customTypes = do
           foldM
             ( \env (hash, obj) -> case obj of
                 VCFunction expr _ -> do
-                  let expr' = bimap pinnedToMaybe id expr
+                  let expr' = first pinnedToMaybe expr
                   pure $ Map.insert hash (Left expr') env
                 _ -> pure env
             )

inferno-core/src/Inferno/Eval.hs

@@ -7,6 +7,7 @@ import Control.Monad.Catch (MonadCatch, MonadThrow (throwM), try)
 import Control.Monad.Except (forM)
 import Control.Monad.Reader (ask, local)
 import Data.Foldable (foldrM)
+import Data.Functor ((<&>))
 import Data.List.NonEmpty (NonEmpty (..), toList)
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
@@ -67,7 +68,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
       toText (VText t) = t
       toText e = renderStrict $ layoutPretty (LayoutOptions Unbounded) $ pretty e
   Array_ es ->
-    foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] es >>= return . VArray
+    foldrM (\(e, _) vs -> eval env e <&> (: vs)) [] es <&> VArray
   ArrayComp_ e srcs mCond -> do
     vals <- sequence' env srcs
     VArray <$> case mCond of
@@ -76,19 +77,21 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
           let nenv = foldr (uncurry Map.insert) localEnv vs in eval (nenv, pinnedEnv) e
       Just (_, cond) ->
         catMaybes
-          <$> ( forM vals $ \vs -> do
-                  let nenv = foldr (uncurry Map.insert) localEnv vs
-                  eval (nenv, pinnedEnv) cond >>= \case
-                    VEnum hash "true" ->
-                      if hash == enumBoolHash
-                        then Just <$> (eval (nenv, pinnedEnv) e)
-                        else throwM $ RuntimeError "failed to match with a bool"
-                    VEnum hash "false" ->
-                      if hash == enumBoolHash
-                        then return Nothing
-                        else throwM $ RuntimeError "failed to match with a bool"
-                    _ -> throwM $ RuntimeError "failed to match with a bool"
-              )
+          <$> forM
+            vals
+            ( \vs -> do
+                let nenv = foldr (uncurry Map.insert) localEnv vs
+                eval (nenv, pinnedEnv) cond >>= \case
+                  VEnum hash "true" ->
+                    if hash == enumBoolHash
+                      then Just <$> eval (nenv, pinnedEnv) e
+                      else throwM $ RuntimeError "failed to match with a bool"
+                  VEnum hash "false" ->
+                    if hash == enumBoolHash
+                      then return Nothing
+                      else throwM $ RuntimeError "failed to match with a bool"
+                  _ -> throwM $ RuntimeError "failed to match with a bool"
+            )
     where
       sequence' :: (MonadThrow m, Pretty c) => TermEnv VCObjectHash c (ImplEnvM m c) a -> NonEmpty (a, Ident, a, Expr (Maybe VCObjectHash) a, Maybe a) -> ImplEnvM m c [[(ExtIdent, Value c (ImplEnvM m c))]]
       sequence' env'@(localEnv', pinnedEnv') = \case
@@ -100,10 +103,12 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
           eval env' e_s >>= \case
             VArray vals ->
               concat
-                <$> ( forM vals $ \v -> do
-                        res <- sequence' (Map.insert (ExtIdent $ Right x) v localEnv', pinnedEnv') (r :| rs)
-                        return $ map ((ExtIdent $ Right x, v) :) res
-                    )
+                <$> forM
+                  vals
+                  ( \v -> do
+                      res <- sequence' (Map.insert (ExtIdent $ Right x) v localEnv', pinnedEnv') (r :| rs)
+                      return $ map ((ExtIdent $ Right x, v) :) res
+                  )
             _ -> throwM $ RuntimeError "failed to match with an array"
   Enum_ (Just hash) _ i -> return $ VEnum hash i
   Enum_ Nothing _ _ -> throwM $ RuntimeError "All enums must be pinned"
@@ -162,7 +167,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
         (_, Just x) : xs ->
           return $ VFun $ \arg -> go (Map.insert x arg nenv) xs
         (_, Nothing) : xs -> return $ VFun $ \_arg -> go nenv xs
-  App_ fun arg -> do
+  App_ fun arg ->
     eval env fun >>= \case
       VFun f -> do
         argv <- eval env arg
@@ -178,7 +183,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
     eval (nenv, pinnedEnv) body
   Let_ (Impl x) e body -> do
     e' <- eval env e
-    local (\impEnv -> Map.insert x e' impEnv) $ eval env body
+    local (Map.insert x e') $ eval env body
   If_ cond tr fl ->
     eval env cond >>= \case
       VEnum hash "true" ->
@@ -191,7 +196,7 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
           else throwM $ RuntimeError "failed to match with a bool"
       _ -> throwM $ RuntimeError "failed to match with a bool"
   Tuple_ es ->
-    foldrM (\(e, _) vs -> eval env e >>= return . (: vs)) [] (tListToList es) >>= return . VTuple
+    foldrM (\(e, _) vs -> eval env e <&> (: vs)) [] (tListToList es) <&> VTuple
   Record_ fs -> do
     valMap <- foldrM (\(f, e, _) vs -> eval env e >>= \v -> return ((f, v) : vs)) [] fs
     return $ VRecord $ Map.fromList valMap
@@ -203,8 +208,8 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
           Nothing -> throwM $ RuntimeError "record field not found"
       Just _ -> throwM $ RuntimeError "failed to match with a record"
       Nothing -> throwM $ RuntimeError $ show (ExtIdent $ Right r) <> " not found in the unpinned env"
-  One_ e -> eval env e >>= return . VOne
-  Empty_ -> return $ VEmpty
+  One_ e -> eval env e <&> VOne
+  Empty_ -> return VEmpty
   Assert_ cond e ->
     eval env cond >>= \case
       VEnum hash "false" ->
@@ -224,13 +229,13 @@ eval env@(localEnv, pinnedEnv) expr = case expr of
         Just nenv ->
           -- (<>) is left biased so this will correctly override any shadowed vars from nenv onto env
           eval (nenv <> env) body
-        Nothing -> throwM $ RuntimeError $ "non-exhaustive patterns in case detected in " <> (Text.unpack $ renderPretty v)
+        Nothing -> throwM $ RuntimeError $ "non-exhaustive patterns in case detected in " <> Text.unpack (renderPretty v)
       matchAny v ((_, p, _, body) :| (r : rs)) = case match v p of
         Just nenv -> eval (nenv <> env) body
         Nothing -> matchAny v (r :| rs)
 
       match v p = case (v, p) of
-        (_, PVar _ (Just (Ident x))) -> Just $ (Map.singleton (ExtIdent $ Right x) v, mempty)
+        (_, PVar _ (Just (Ident x))) -> Just (Map.singleton (ExtIdent $ Right x) v, mempty)
         (_, PVar _ Nothing) -> Just mempty
         (VEnum h1 i1, PEnum _ (Just h2) _ i2) ->
           if h1 == h2 && i1 == i2