disable x-partial

src/CmdLine.hs

@@ -1,3 +1,5 @@
+{-# HLint ignore "Avoid restricted flags" #-}
+{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-unrecognised-pragmas -Wno-x-partial #-}
 {-# LANGUAGE ImportQualifiedPost, CPP #-}
 {-# LANGUAGE PatternGuards, DeriveDataTypeable, TupleSections #-}
 {-# OPTIONS_GHC -Wno-missing-fields -fno-cse -O0 #-}

src/Config/Yaml.hs

@@ -29,6 +29,7 @@ import GHC.Types.Error hiding (Severity)
 import Config.Type
 import Data.Either.Extra
 import Data.Maybe
+import Data.List.NonEmpty qualified as NE
 import Data.List.Extra
 import Data.Tuple.Extra
 import Control.Monad.Extra
@@ -235,7 +236,7 @@ parseGHC parser v = do
     case parser defaultParseFlags{enabledExtensions=configExtensions, disabledExtensions=[]} x of
         POk _ x -> pure x
         PFailed ps ->
-          let errMsg = head . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps)
+          let errMsg = NE.head . NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps)
               msg = showSDoc baseDynFlags $ pprLocMsgEnvelopeDefault errMsg
           in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n " ++ x
 

src/GHC/All.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -14,6 +15,7 @@ import Control.Monad.Trans.Except
 import Control.Monad.IO.Class
 import Util
 import Data.Char
+import Data.List.NonEmpty qualified
 import Data.List.Extra
 import Timing
 import Language.Preprocessor.Cpphs
@@ -192,12 +194,12 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do
     POk s a -> do
       let errs = bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s)
       if not $ null errs then
-        except $ parseFailureErr dynFlags str file str errs
+        except $ parseFailureErr dynFlags str file str $ Data.List.NonEmpty.fromList errs
       else do
         let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags
         pure $ ModuleEx (applyFixities fixes a)
     PFailed s ->
-      except $ parseFailureErr dynFlags str file str $ bagToList . getMessages  $ GhcPsMessage <$> snd (getPsMessages s)
+      except $ parseFailureErr dynFlags str file str $ Data.List.NonEmpty.fromList . bagToList . getMessages  $ GhcPsMessage <$> snd (getPsMessages s)
   where
     -- If parsing pragmas fails, synthesize a parse error from the
     -- error message.
@@ -206,7 +208,7 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do
       in ParseError (mkSrcSpan loc loc) msg src
 
     parseFailureErr dynFlags ppstr file str errs =
-      let errMsg = head errs
+      let errMsg = Data.List.NonEmpty.head errs
           loc = errMsgSpan errMsg
           doc = pprLocMsgEnvelopeDefault errMsg
       in ghcFailOpParseModuleEx ppstr file str (loc, doc)

src/Hint/List.hs

@@ -44,6 +44,7 @@ module Hint.List(listHint) where
 
 import Control.Applicative
 import Data.Generics.Uniplate.DataOnly
+import Data.List.NonEmpty qualified as NE
 import Data.List.Extra
 import Data.Maybe
 import Prelude
@@ -103,9 +104,9 @@ listComp _ = []
 
 listCompCheckGuards :: LHsExpr GhcPs -> HsDoFlavour -> [ExprLStmt GhcPs] -> [Idea]
 listCompCheckGuards o ctx stmts =
-  let revs = reverse stmts
-      e@(L _ LastStmt{}) = head revs -- In a ListComp, this is always last.
-      xs = reverse (tail revs) in
+  let revs = NE.reverse $ NE.fromList stmts
+      e@(L _ LastStmt{}) = NE.head revs -- In a ListComp, this is always last.
+      xs = reverse (NE.tail revs) in
   list_comp_aux e xs
   where
     list_comp_aux e xs
@@ -128,10 +129,10 @@ listCompCheckMap ::
 listCompCheckMap o mp f ctx stmts  | varToStr mp == "map" =
     [suggest "Move map inside list comprehension" (reLoc o) (reLoc o2) (suggestExpr o o2)]
     where
-      revs = reverse stmts
-      L _ (LastStmt _ body b s) = head revs -- In a ListComp, this is always last.
+      revs = NE.reverse $ NE.fromList stmts
+      L _ (LastStmt _ body b s) = NE.head revs -- In a ListComp, this is always last.
       last = noLocA $ LastStmt noExtField (noLocA $ HsApp EpAnnNotUsed (paren f) (paren body)) b s
-      o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (tail revs) ++ [last])
+      o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (NE.tail revs) ++ [last])
 listCompCheckMap _ _ _ _ _ = []
 
 suggestExpr :: LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring R.SrcSpan]
@@ -162,15 +163,15 @@ listExp :: Bool -> Bool -> LHsExpr GhcPs -> [Idea]
 listExp overloadedListsOn b (fromParen -> x) =
   if null res
     then concatMap (listExp overloadedListsOn $ isAppend x) $ children x
-    else [head res]
+    else [NE.head $ NE.fromList res]
   where
     res = [suggest name (reLoc x) (reLoc x2) [r]
           | (name, f) <- checks overloadedListsOn
           , Just (x2, subts, temp) <- [f b x]
           , let r = Replace Expr (toSSA x) subts temp ]
 
 listPat :: LPat GhcPs -> [Idea]
-listPat x = if null res then concatMap listPat $ children x else [head res]
+listPat x = if null res then concatMap listPat $ children x else [NE.head $ NE.fromList res]
     where res = [suggest name (reLoc x) (reLoc x2) [r]
                   | (name, f) <- pchecks
                   , Just (x2, subts, temp) <- [f x]

src/Refact.hs

@@ -10,6 +10,7 @@ module Refact
 
 import Control.Exception.Extra
 import Control.Monad
+import Data.List.NonEmpty qualified as NE
 import Data.Maybe
 import Data.Version.Extra
 import GHC.LanguageExtensions.Type
@@ -58,7 +59,7 @@ refactorPath rpath = do
     mexc <- findExecutable excPath
     case mexc of
         Just exc -> do
-            ver <- readVersion . tail <$> readProcess exc ["--version"] ""
+            ver <- readVersion . NE.tail . NE.fromList <$> readProcess exc ["--version"] ""
             pure $ if ver >= minRefactorVersion
                        then Right exc
                        else Left $ "Your version of refactor is too old, please install apply-refact "

src/Summary.hs

@@ -9,6 +9,7 @@ module Summary (generateMdSummary, generateJsonSummary, generateExhaustiveConfig
 import Data.Map qualified as Map
 import Control.Monad.Extra
 import System.FilePath
+import Data.List.NonEmpty qualified as NE
 import Data.List.Extra
 import System.Directory
 
@@ -121,7 +122,7 @@ genExhaustiveConfig severity Summary{..} = unlines $
     ++ ["", "# All LHS/RHS hints"]
     ++ (mkLine <$> sortDedup (hintRuleName <$> sLhsRhsRules))
   where
-    sortDedup = fmap head . group . sort
+    sortDedup = fmap (NE.head . NE.fromList) . group . sort
     mkLine name = "- " <> show severity <> ": {name: " <> jsonToString name <> "}"
 
 genSummaryMd :: Summary -> String
@@ -161,7 +162,7 @@ showBuiltin BuiltinHint{..} = row1
   where
     row1 = row $
       [ "<td>" ++ hName ++ "</td>", "<td>"]
-      ++ showExample (head hExamples)
+      ++ showExample (NE.head $ NE.fromList hExamples)
       ++ ["Does not support refactoring." | not hRefactoring]
       ++ ["</td>"] ++
       [ "<td>" ++ show hSeverity ++ "</td>"