Enable HLint in CI (#371)

- uncomment HLint configuration in Haskell-CI config
- remove unused pragmas
- remove some unnecessary parens

.github/workflows/haskell-ci.yml

@@ -136,6 +136,11 @@ jobs:
       - name: update cabal index
         run: |
           $CABAL v2-update -v
+      - name: cache (tools)
+        uses: actions/cache@v2
+        with:
+          key: ${{ runner.os }}-${{ matrix.compiler }}-tools-2a842658
+          path: ~/.haskell-ci-tools
       - name: install cabal-plan
         run: |
           mkdir -p $HOME/.cabal/bin
@@ -154,6 +159,12 @@ jobs:
           rm -f cabal-docspec.xz
           chmod a+x $HOME/.cabal/bin/cabal-docspec
           cabal-docspec --version
+      - name: install hlint
+        run: |
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint  --constraint='hlint >=3.3 && <3.4' |  perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then hlint --version ; fi
       - name: checkout
         uses: actions/checkout@v2
         with:
@@ -210,6 +221,10 @@ jobs:
         run: |
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all
           cabal-docspec $ARG_COMPILER
+      - name: hlint
+        run: |
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XStrictData src) ; fi
+          if [ $((HCNUMVER >= 90000)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 app) ; fi
       - name: cabal check
         run: |
           cd ${PKGDIR_swarm} || false

cabal.haskell-ci

@@ -17,10 +17,8 @@ haddock: True
 -- Swarm has benchmarks so at least build them :)
 benchmarks: True
 
--- TODO: enable HLint
-
 -- Run HLint
--- hlint: True
--- hlint-job: 9.0.2
--- hlint-yaml: .hlint.yaml
--- hlint-download-binary: True
+hlint: True
+hlint-job: 9.0.2
+hlint-yaml: .hlint.yaml
+hlint-download-binary: True

src/Swarm/App.hs

@@ -30,7 +30,7 @@ app =
     { appDraw = drawUI
     , appChooseCursor = chooseCursor
     , appHandleEvent = handleEvent
-    , appStartEvent = \s -> s <$ enablePasteMode
+    , appStartEvent = (<$ enablePasteMode)
     , appAttrMap = const swarmAttrMap
     }
 

src/Swarm/Game/CESK.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TypeOperators #-}
 
 -- |
 -- Module      :  Swarm.Game.CESK

src/Swarm/Game/Entity.hs

@@ -4,8 +4,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -327,9 +325,8 @@ buildEntityMap es =
 instance FromJSON Entity where
   parseJSON = withObject "Entity" $ \v ->
     rehashEntity
-      <$> ( Entity
-              <$> pure 0
-              <*> v .: "display"
+      <$> ( Entity 0
+              <$> v .: "display"
               <*> v .: "name"
               <*> v .:? "plural"
               <*> (map reflow <$> (v .: "description"))
@@ -599,4 +596,4 @@ union (Inventory cs1 byN1 h1) (Inventory cs2 byN2 h2) =
   -- of the way each entity with count k contributes (k+1) times its
   -- hash.  So if the two inventories share an entity e, just adding their
   -- hashes would mean e now contributes (k+2) times its hash.
-  common = IS.foldl' (+) 0 $ (IM.keysSet cs1) `IS.intersection` (IM.keysSet cs2)
+  common = IS.foldl' (+) 0 $ IM.keysSet cs1 `IS.intersection` IM.keysSet cs2

src/Swarm/Game/Recipe.hs

@@ -1,6 +1,5 @@
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}

src/Swarm/Game/Robot.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 

src/Swarm/Game/Step.hs

@@ -703,7 +703,7 @@ execConst c vs s k = do
       let yieldName = e ^. entityYields
       e' <- case yieldName of
         Nothing -> return e
-        Just n -> (?e) <$> uses entityMap (lookupEntityName n)
+        Just n -> fromMaybe e <$> uses entityMap (lookupEntityName n)
 
       robotInventory %= insert e'
 
@@ -1444,7 +1444,7 @@ evalCmp c v1 v2 = decideCmp c $ compareValues v1 v2
 -- | Compare two values, returning an 'Ordering' if they can be
 --   compared, or @Nothing@ if they cannot.
 compareValues :: Has (Throw Exn) sig m => Value -> Value -> m Ordering
-compareValues = \v1 -> case v1 of
+compareValues v1 = case v1 of
   VUnit -> \case VUnit -> return EQ; v2 -> incompatCmp VUnit v2
   VInt n1 -> \case VInt n2 -> return (compare n1 n2); v2 -> incompatCmp v1 v2
   VString t1 -> \case VString t2 -> return (compare t1 t2); v2 -> incompatCmp v1 v2

src/Swarm/Game/Terrain.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeApplications #-}
 

src/Swarm/Game/World.hs

@@ -2,10 +2,8 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 

src/Swarm/Language/Context.hs

@@ -1,8 +1,6 @@
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 

src/Swarm/Language/Elaborate.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
 -- |
 -- Module      :  Swarm.Language.Elaborate
 -- Copyright   :  Brent Yorgey

src/Swarm/Language/LSP.hs

@@ -115,5 +115,5 @@ handlers =
         case mdoc of
           Just vf@(VirtualFile _ version _rope) -> do
             validateSwarmCode doc (Just version) (virtualFileText vf)
-          _ -> debug $ "No virtual file found for: " <> (from (show msg))
+          _ -> debug $ "No virtual file found for: " <> from (show msg)
     ]

src/Swarm/Language/Parse.hs

@@ -1,10 +1,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 -- |
 -- Module      :  Swarm.Language.Parse

src/Swarm/Language/Parse/QQ.hs

@@ -1,7 +1,3 @@
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-{-# LANGUAGE TemplateHaskell #-}
-
 -- |
 -- Module      :  Swarm.Language.Parse.QQ
 -- Copyright   :  Brent Yorgey

src/Swarm/Language/Pipeline.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators #-}
 
 -- |
 -- Module      :  Swarm.Language.Pipeline

src/Swarm/Language/Pipeline/QQ.hs

@@ -1,7 +1,3 @@
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-{-# LANGUAGE TemplateHaskell #-}
-
 -- |
 -- Module      :  Swarm.Language.Pipeline.QQ
 -- Copyright   :  Brent Yorgey

src/Swarm/Language/Pretty.hs

@@ -1,8 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 

src/Swarm/Language/Syntax.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -131,7 +130,7 @@ dirInfo d = case d of
   -- e.g. DLeft becomes "left"
   directionSyntax = toLower . T.tail . from . show $ d
   cardinal v2 = DirInfo directionSyntax (Just v2) (const v2)
-  relative vf = DirInfo directionSyntax Nothing vf
+  relative = DirInfo directionSyntax Nothing
 
 -- | The cardinal direction north = @V2 0 1@.
 north :: V2 Int64

src/Swarm/Language/Typecheck.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- For 'Ord IntVar' instance

src/Swarm/Language/Types.hs

@@ -1,7 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -11,7 +9,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- for the Data IntVar instance

src/Swarm/TUI/Border.hs

@@ -33,6 +33,7 @@ module Swarm.TUI.Border (
 import Brick
 import Brick.Widgets.Border
 import Control.Lens (makeLenses, to, (^.))
+import Data.Function ((&))
 import qualified Graphics.Vty as V
 
 -- | Labels for a horizontal border, with optional left, middle, and
@@ -114,10 +115,10 @@ borderWithLabels labels wrapped =
     c <- getContext
 
     middleResult <-
-      render $
-        hLimit (c ^. availWidthL - 2) $
-          vLimit (c ^. availHeightL - 2) $
-            wrapped
+      wrapped
+        & vLimit (c ^. availHeightL - 2)
+        & hLimit (c ^. availWidthL - 2)
+        & render
 
     let tl = joinableBorder (Edges False True False True)
         tr = joinableBorder (Edges False True True False)
@@ -128,7 +129,7 @@ borderWithLabels labels wrapped =
         middle = vBorder <+> Widget Fixed Fixed (return middleResult) <+> vBorder
         total = top <=> middle <=> bottom
 
-    render $
-      hLimit (middleResult ^. imageL . to V.imageWidth + 2) $
-        vLimit (middleResult ^. imageL . to V.imageHeight + 2) $
-          total
+    total
+      & vLimit (middleResult ^. imageL . to V.imageHeight + 2)
+      & hLimit (middleResult ^. imageL . to V.imageWidth + 2)
+      & render

src/Swarm/TUI/Controller.hs

@@ -3,8 +3,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Module      :  Swarm.TUI.Controller

src/Swarm/TUI/List.hs

@@ -29,10 +29,10 @@ handleListEventWithSeparators ::
   EventM n (BL.GenericList n t e)
 handleListEventWithSeparators e isSep theList =
   case e of
-    V.EvKey V.KUp [] -> return $ backward
-    V.EvKey (V.KChar 'k') [] -> return $ backward
-    V.EvKey V.KDown [] -> return $ forward
-    V.EvKey (V.KChar 'j') [] -> return $ forward
+    V.EvKey V.KUp [] -> return backward
+    V.EvKey (V.KChar 'k') [] -> return backward
+    V.EvKey V.KDown [] -> return forward
+    V.EvKey (V.KChar 'j') [] -> return forward
     V.EvKey V.KHome [] ->
       return $
         listFindByStrategy fwdInclusive isItem $

src/Swarm/TUI/View.hs

@@ -129,7 +129,7 @@ drawNewGameMenuUI (l :| ls) =
               . BL.renderList (const drawScenarioItem) True
               $ l
           ]
-      , padLeft (Pad 5) (maybe (txt "") drawDescription $ snd <$> BL.listSelectedElement l)
+      , padLeft (Pad 5) (maybe (txt "") (drawDescription . snd) (BL.listSelectedElement l))
       ]
  where
   drawScenarioItem (SISingle s) = padRight Max . txt $ s ^. scenarioName

src/Swarm/Util/Yaml.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}

test/Unit.hs

@@ -218,7 +218,7 @@ prettyConst =
     , testCase
         "pairs #225 - nested pairs are printed right-associative"
         ( equalPretty "(1, 2, 3)" $
-            (TPair (TInt 1) (TPair (TInt 2) (TInt 3)))
+            TPair (TInt 1) (TPair (TInt 2) (TInt 3))
         )
     ]
  where