Refactor: simplify

Author: mpilgrem

src/Stack/Build/FileTargets.hs

@@ -42,8 +42,7 @@ import           Stack.Package
 import           Stack.PackageFile ( getPackageFile )
 import           Stack.Prelude
 import           Stack.Types.BuildOpts ( BuildOpts (..) )
-import           Stack.Types.BuildOptsCLI
-                   ( ApplyCLIFlag (..), BuildOptsCLI (..) )
+import           Stack.Types.BuildOptsCLI ( ApplyCLIFlag (..) )
 import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.EnvConfig
                    ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL )
@@ -74,7 +73,11 @@ findFileTargets ::
      -- ^ All project packages
   -> [Path Abs File]
      -- ^ File targets to find
-  -> RIO env (Map PackageName Target, Map PackageName [Path Abs File], [Path Abs File])
+  -> RIO
+       env
+       ( Map PackageName Target
+       , Maybe (Map PackageName [Path Abs File], [Path Abs File])
+       )
 findFileTargets locals fileTargets = do
   filePackages <- forM locals $ \lp -> do
     PackageComponentFile _ compFiles _ _ <- getPackageFile lp.package lp.cabalFP
@@ -126,7 +129,7 @@ findFileTargets locals fileTargets = do
           foldl' (M.unionWith (<>)) M.empty $
           map (\(fp, (name, _)) -> M.singleton name [fp])
               associatedFiles
-  pure (targetMap, infoMap, extraFiles)
+  pure (targetMap, Just (infoMap, extraFiles))
 
 -- | Yields all of the targets that are local, those that are directly wanted
 -- and those that are extra dependencies to load.
@@ -175,23 +178,25 @@ getAllNonLocalTargets targets = do
 -- v'GhciPkgDesc'.
 loadGhciPkgDescs ::
      HasEnvConfig env
-  => BuildOptsCLI
+  => Map ApplyCLIFlag (Map FlagName Bool)
+     -- ^ Flags specified on the command line.
   -> [(PackageName, (Path Abs File, Target))]
      -- ^ Local targets.
   -> RIO env [GhciPkgDesc]
-loadGhciPkgDescs buildOptsCLI localTargets =
+loadGhciPkgDescs cliFlags localTargets =
   forM localTargets $ \(name, (cabalFP, target)) ->
-    loadGhciPkgDesc buildOptsCLI name cabalFP target
+    loadGhciPkgDesc cliFlags name cabalFP target
 
 -- | Load package description information for a ghci target.
 loadGhciPkgDesc ::
      HasEnvConfig env
-  => BuildOptsCLI
+  => Map ApplyCLIFlag (Map FlagName Bool)
+     -- ^ Flags specified on the command line.
   -> PackageName
   -> Path Abs File
   -> Target
   -> RIO env GhciPkgDesc
-loadGhciPkgDesc buildOptsCLI name cabalFP target = do
+loadGhciPkgDesc cliFlags name cabalFP target = do
   econfig <- view envConfigL
   compilerVersion <- view actualCompilerVersionL
   let sm = econfig.sourceMap
@@ -242,7 +247,6 @@ loadGhciPkgDesc buildOptsCLI name cabalFP target = do
     , target
     }
  where
-  cliFlags = buildOptsCLI.flags
   -- | All CLI Cabal flags for a package.
   getCliFlags :: Map FlagName Bool
   getCliFlags = Map.unions

src/Stack/Ghci.hs

@@ -200,8 +200,7 @@ ghci opts = do
     Left rawFileTargets -> do
       whenJust mainIsTargets $ \_ -> prettyThrowM Can'tSpecifyFilesAndMainIs
       -- Figure out targets based on filepath targets
-      (targetMap, fileInfo, extraFiles) <- findFileTargets locals rawFileTargets
-      pure (targetMap, Just (fileInfo, extraFiles))
+      findFileTargets locals rawFileTargets
   -- Get a list of all the local target packages.
   localTargets <- getAllLocalTargets' opts inputTargets mainIsTargets localMap
   -- Get a list of all the non-local target packages.
@@ -214,7 +213,7 @@ ghci opts = do
   -- Check if additional package arguments are sensible.
   addPkgs <- checkAdditionalPackages opts.additionalPackages
   -- Load package descriptions.
-  pkgDescs <- loadGhciPkgDescs buildOptsCLI localTargets
+  pkgDescs <- loadGhciPkgDescs buildOptsCLI.flags localTargets
   -- If necessary, ask user about which main module to load.
   bopts <- view buildOptsL
   mainFile <- if opts.noLoadModules

src/Stack/IDE.hs

@@ -151,16 +151,12 @@ ideGhcOptions rawTarget = do
   installMap <- toInstallMap sourceMap
   locals <- projectLocalPackages
   depLocals <- localDependencies
-  let localMap =
-        M.fromList [(lp.package.name, lp) | lp <- locals ++ depLocals]
+  let localMap = M.fromList [(lp.package.name, lp) | lp <- locals ++ depLocals]
   -- Parse to either file targets or build targets
-  mTarget <- preprocessTarget rawTarget
-  (inputTargets, mfileTargets) <- case mTarget of
-    Nothing -> pure (mempty, Nothing)
-    Just rawFileTarget -> do
-      -- Figure out targets based on filepath targets
-      (targetMap, fileInfo, extraFiles) <- findFileTargets locals [rawFileTarget]
-      pure (targetMap, Just (fileInfo, extraFiles))
+  (inputTargets, mfileTargets) <- processRawTarget rawTarget >>= maybe
+    (pure (mempty, Nothing))
+    -- Figure out targets based on file target
+    (findFileTargets locals . pure)
   -- Get a list of all the local target packages.
   (directlyWanted, extraLoadDeps) <-
     getAllLocalTargets True inputTargets Nothing localMap
@@ -173,7 +169,7 @@ ideGhcOptions rawTarget = do
         M.intersectionWith getInternalDependencies inputTargets localMap
       relevantDependencies = M.filter (any isCSubLib) internalDependencies
   -- Load package descriptions.
-  pkgDescs <- loadGhciPkgDescs defaultBuildOptsCLI localTargets
+  pkgDescs <- loadGhciPkgDescs mempty localTargets
   pkgs <- getGhciPkgInfos installMap [] (fmap fst mfileTargets) pkgDescs
   (omittedOpts, pkgopts, macros) <-
     optsAndMacros
@@ -191,18 +187,13 @@ ideGhcOptions rawTarget = do
   mapM_ (liftIO . putStrLn) omittedOpts
   outputDivider
 
-preprocessTarget ::
-     HasEnvConfig env
-  => Text
-  -> RIO env (Maybe (Path Abs File))
-preprocessTarget rawTarget =
+processRawTarget :: HasEnvConfig env => Text -> RIO env (Maybe (Path Abs File))
+processRawTarget rawTarget =
   if ".hs" `T.isSuffixOf` rawTarget || ".lhs" `T.isSuffixOf` rawTarget
-    then do
-      fileTarget <- do
-        let fp = T.unpack rawTarget
-        mpath <- forgivingResolveFile' fp
-        case mpath of
-          Nothing -> prettyThrowM (FileTargetIsInvalidAbsFile fp)
-          Just path -> pure path
-      pure (Just fileTarget)
+    then
+      forgivingResolveFile' rawTarget' >>= maybe
+          (prettyThrowM $ FileTargetIsInvalidAbsFile rawTarget')
+          (pure . Just)
     else pure Nothing
+ where
+  rawTarget' = T.unpack rawTarget