Reduce usage of partial functions (#4123)

.hlint.yaml

@@ -64,8 +64,6 @@
  - Ide.Types
  - Test.Hls
  - Test.Hls.Command
- - Wingman.Debug
- - Wingman.Types
  - AutoTupleSpec
  - name: unsafeInterleaveIO
  within:
@@ -76,7 +74,6 @@
  - Ide.Plugin.Eval.Code
  - Development.IDE.Core.Compile
  - Development.IDE.Types.Shake
- - Wingman.Judgements.SYB
  - Ide.Plugin.Properties
 
  # Things that are a bit dangerous in the GHC API
@@ -105,17 +102,12 @@
  - Ide.Plugin.CallHierarchy.Internal
  - Ide.Plugin.Eval.Code
  - Ide.Plugin.Eval.Util
- - Ide.Plugin.Floskell
- - Ide.Plugin.ModuleName
  - Ide.Plugin.Class.ExactPrint
  - TExpectedActual
  - TRigidType
  - TRigidType2
  - RightToLeftFixities
  - Typeclass
- - Wingman.Judgements
- - Wingman.Machinery
- - Wingman.Tactics
  - CompletionTests #Previously part of GHCIDE Main tests
  - DiagnosticTests #Previously part of GHCIDE Main tests
  - FindDefinitionAndHoverTests #Previously part of GHCIDE Main tests
@@ -149,9 +141,8 @@
  - Main
  - Development.IDE.Spans.Common
  - Ide.PluginUtils
- - Wingman.Metaprogramming.Parser
  - Development.Benchmark.Rules
- - ErrorGivenPartialSignature
+ - TErrorGivenPartialSignature
  - IfaceTests #Previously part of GHCIDE Main tests
  - THTests #Previously part of GHCIDE Main tests
  - WatchedFileTests #Previously part of GHCIDE Main tests
@@ -171,8 +162,6 @@
  - Development.IDE.Plugin.Completions.Logic
  - Development.IDE.Spans.Documentation
  - TErrorGivenPartialSignature
- - Wingman.CaseSplit
- - Wingman.Simplify
  - InitializeResponseTests #Previously part of GHCIDE Main tests
  - PositionMappingTests #Previously part of GHCIDE Main tests
 
@@ -185,31 +174,23 @@
  within: []
 
  - name: Data.Foldable.foldr1
- within:
- - Wingman.Tactics
+ within: []
 
  - name: Data.Maybe.fromJust
  within:
  - Experiments
  - Main
- - MultipleImports
  - Progress
- - Utils
  - Development.IDE.Core.Compile
  - Development.IDE.Core.Rules
  - Development.IDE.Core.Shake
- - Development.IDE.Plugin.Completions
- - Development.IDE.Plugin.CodeAction.ExactPrint
- - Development.IDE.Plugin.CodeAction
  - Development.IDE.Test
  - Development.IDE.Graph.Internal.Profile
  - Development.IDE.Graph.Internal.Rules
- - Ide.Plugin.Class
  - CodeLensTests #Previously part of GHCIDE Main tests
 
  - name: "Data.Map.!"
- within:
- - Wingman.LanguageServer
+ within: []
 
  - name: "Data.IntMap.!"
  within: []
@@ -250,7 +231,6 @@
  - Development.IDE.Graph.Internal.Database
  - Development.IDE.GHC.Util
  - Development.IDE.Plugin.CodeAction.Util
- - Wingman.Debug
 
 # We really do not want novel usages of restricted functions, and mere
 # Warning is not enough to prevent those consistently; you need a build failure.

ghcide/test/exe/FindDefinitionAndHoverTests.hs

@@ -1,6 +1,4 @@
 
-{-# LANGUAGE MultiWayIf #-}
-
 module FindDefinitionAndHoverTests (tests) where
 
 import Control.Monad

ghcide/test/exe/WatchedFileTests.hs

@@ -17,7 +17,6 @@ import Language.LSP.Protocol.Types hiding
 import Language.LSP.Test
 import System.Directory
 import System.FilePath
--- import Test.QuickCheck.Instances ()
 import Test.Tasty
 import Test.Tasty.HUnit
 import TestUtils

hls-test-utils/src/Test/Hls.hs

@@ -65,7 +65,7 @@ import Control.Concurrent.Async (async, cancel, wait)
 import Control.Concurrent.Extra
 import Control.Exception.Safe
 import Control.Lens.Extras (is)
-import Control.Monad (guard, unless, void, when)
+import Control.Monad (guard, unless, void)
 import Control.Monad.Extra (forM)
 import Control.Monad.IO.Class
 import Data.Aeson (Result (Success),

plugins/hls-change-type-signature-plugin/test/testdata/TErrorGivenPartialSignature.hs

@@ -1,4 +1,4 @@
-module ErrorGivenPartialSignature where
+module TErrorGivenPartialSignature where
 
 partial :: Int -> Int
 partial x = init x

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs

@@ -85,7 +85,7 @@ asStmts (Property t _ _) =
 myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String))
 myExecStmt stmt opts = do
  (temp, purge) <- liftIO newTempFile
- evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile "<> show temp <> " (P.show x)")
+ evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile " <> show temp <> " (P.show x)")
  modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint}
  result <- execStmt stmt opts >>= \case
  ExecComplete (Left err) _ -> pure $ Left $ show err

plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs

@@ -122,7 +122,7 @@ commentsToSections isLHS Comments {..} =
  in case parseMaybe lineGroupP $ NE.toList lcs of
  Nothing -> mempty
  Just (mls, rs) ->
- ( maybe mempty (uncurry Map.singleton) ((theRan,) <$> mls)
+ ( maybe mempty (Map.singleton theRan) mls
  , -- orders setup sections in ascending order
  if null rs
  then mempty

plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs

@@ -8,6 +8,7 @@ module Ide.Plugin.Floskell
 
 import Control.Monad.Except (throwError)
 import Control.Monad.IO.Class
+import Data.List (find)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import Development.IDE hiding (pluginHandlers)
@@ -53,7 +54,8 @@ findConfigOrDefault file = do
  case mbConf of
  Just confFile -> readAppConfig confFile
  Nothing ->
- let gibiansky = head (filter (\s -> styleName s == "gibiansky") styles)
- in pure $ defaultAppConfig { appStyle = gibiansky }
+ pure $ case find (\s -> styleName s == "gibiansky") styles of
+ Just gibiansky -> defaultAppConfig { appStyle = gibiansky }
+ Nothing -> defaultAppConfig
 
 -- ---------------------------------------------------------------------

plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs

@@ -25,7 +25,7 @@ import Control.Monad.Trans.Maybe
 import Data.Aeson (toJSON)
 import Data.Char (isLower, isUpper)
 import Data.List (intercalate, minimumBy,
- stripPrefix, uncons)
+ stripPrefix)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import Data.Maybe (mapMaybe)
@@ -138,7 +138,7 @@ action recorder state uri = do
 -- directories are nested inside each other.
 pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text]
 pathModuleNames recorder state normFilePath filePath
- | isLower . head $ takeFileName filePath = return ["Main"]
+ | firstLetter isLower $ takeFileName filePath = return ["Main"]
  | otherwise = do
  (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath
  srcPaths <- liftIO $ evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags
@@ -156,12 +156,16 @@ pathModuleNames recorder state normFilePath filePath
  let suffixes = mapMaybe (`stripPrefix` mdlPath) paths
  pure (map moduleNameFrom suffixes)
  where
+ firstLetter :: (Char -> Bool) -> FilePath -> Bool
+ firstLetter _ [] = False
+ firstLetter pred (c:_) = pred c
+
  moduleNameFrom =
  T.pack
  . intercalate "."
  -- Do not suggest names whose components start from a lower-case char,
  -- they are guaranteed to be malformed.
- . filter (maybe False (isUpper . fst) . uncons)
+ . filter (firstLetter isUpper)
  . splitDirectories
  . dropExtension
 

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs

@@ -75,7 +75,6 @@ import GHC (AddEpAnn (Ad
  EpAnn (..),
  EpaLocation (..),
  LEpaComment)
-import GHC.Exts (fromList)
 import qualified GHC.LanguageExtensions as Lang
 import Ide.Logger hiding
  (group)
@@ -189,18 +188,18 @@ extendImportHandler :: CommandFunction IdeState ExtendImport
 extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do
  res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit
  whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do
- let (_, head -> TextEdit {_range}) = fromJust $ _changes >>= listToMaybe . M.toList
-   srcSpan = rangeToSrcSpan nfp _range
- LSP.sendNotification SMethod_WindowShowMessage $
- ShowMessageParams MessageType_Info $
- "Import "
- <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent
- <> "’ from "
- <> importName
- <> " (at "
- <> printOutputable srcSpan
- <> ")"
- void $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
+ whenJust (listToMaybe =<< listToMaybe . M.elems =<< _changes) $ \TextEdit {_range} -> do
+ let srcSpan = rangeToSrcSpan nfp _range
+  LSP.sendNotification SMethod_WindowShowMessage $
+  ShowMessageParams MessageType_Info $
+  "Import "
+  <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent
+  <> "’ from "
+  <> importName
+  <> " (at "
+  <> printOutputable srcSpan
+  <> ")"
+  void $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
  return $ Right $ InR Null
 
 extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit)
@@ -223,8 +222,7 @@ extendImportHandler' ideState ExtendImport {..}
  case existingImport of
  Just imp -> do
  fmap (nfp,) $ liftEither $
- rewriteToWEdit df doc
- $
+ rewriteToWEdit df doc $
  extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp)
 
  Nothing -> do
@@ -235,7 +233,7 @@ extendImportHandler' ideState ExtendImport {..}
  Nothing -> newThing
  Just p -> p <> "(" <> newThing <> ")"
  t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents)
- return (nfp, WorkspaceEdit {_changes=Just (GHC.Exts.fromList [(doc, [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing})
+ return (nfp, WorkspaceEdit {_changes=Just (M.singleton doc [t]), _documentChanges=Nothing, _changeAnnotations=Nothing})
  | otherwise =
  mzero
 
@@ -609,7 +607,7 @@ suggestDeleteUnusedBinding
  let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames
  in case maybeIdx of
  Nothing -> Nothing
- Just _ | length lnames == 1 -> Just (getLoc $ reLoc $ head lnames, True)
+ Just _ | [lname] <- lnames -> Just (getLoc $ reLoc lname, True)
  Just idx ->
  let targetLname = getLoc $ reLoc $ lnames !! idx
  startLoc = srcSpanStart targetLname
@@ -1052,7 +1050,7 @@ suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..}
  parensed =
  "(" `T.isPrefixOf` T.strip (textInRange _range txt)
  -- > removeAllDuplicates [1, 1, 2, 3, 2] = [3]
- removeAllDuplicates = map head . filter ((==1) <$> length) . group . sort
+ removeAllDuplicates = map NE.head . filter ((==1) . length) . NE.group . sort
  hasDuplicate xs = length xs /= length (S.fromList xs)
  suggestions symbol mods local
  | hasDuplicate mods = case mapM toModuleTarget (removeAllDuplicates mods) of
@@ -1290,7 +1288,7 @@ suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _rang
  | otherwise = []
 
 findTypeSignatureName :: T.Text -> Maybe T.Text
-findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " <&> head
+findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " >>= listToMaybe
 
 -- | Suggests a constraint for a type signature with any number of existing constraints.
 suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)]
@@ -1378,7 +1376,8 @@ removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagno
  & take 2
  & mapMaybe ((`matchRegexUnifySpaces` "Redundant constraints?: (.+)") . T.strip)
  & listToMaybe
- <&> (head >>> parseConstraints)
+ >>= listToMaybe
+ <&> parseConstraints
 
  formatConstraints :: [T.Text] -> T.Text
  formatConstraints [] = ""
@@ -1658,7 +1657,7 @@ findPositionAfterModuleName ps hsmodName' = do
 #endif
  EpAnn _ annsModule _ -> do
  -- Find the first 'where'
- whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule
+ whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule
  epaLocationToLine whereLocation
  EpAnnNotUsed -> Nothing
  filterWhere (AddEpAnn AnnWhere loc) = Just loc

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs

@@ -37,7 +37,7 @@ import Development.IDE.Plugin.CodeAction.Util
 import Control.Lens (_head, _last, over)
 import Data.Bifunctor (first)
 import Data.Default (Default (..))
-import Data.Maybe (fromJust, fromMaybe,
+import Data.Maybe (fromMaybe,
  mapMaybe)
 import GHC (AddEpAnn (..),
  AnnContext (..),
@@ -82,15 +82,13 @@ rewriteToEdit :: HasCallStack =>
  Either String [TextEdit]
 rewriteToEdit dflags
  (Rewrite dst f) = do
- (ast, _ , _) <- runTransformT
- $ do
+ (ast, _ , _) <- runTransformT $ do
  ast <- f dflags
  pure $ traceAst "REWRITE_result" $ resetEntryDP ast
- let editMap =
- [ TextEdit (fromJust $ srcSpanToRange dst) $
- T.pack $ exactPrint ast
- ]
- pure editMap
+ let edits = case srcSpanToRange dst of
+ Just range -> [ TextEdit range $ T.pack $ exactPrint ast ]
+ Nothing -> []
+ pure edits
 
 -- | Convert a 'Rewrite' into a 'WorkspaceEdit'
 rewriteToWEdit :: DynFlags