Represent non-empty lists using NonEmpty

commercialhaskell · Feb 5, 2019 · 0ef0ca8 · 0ef0ca8
1 parent 289466a
commit 0ef0ca8
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 8 deletions.
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
@@ -41,6 +41,8 @@ import           Data.Conduit.Process.Typed
                      runProcess_, getStdout, getStderr, createSource)
 import qualified Data.Conduit.Text as CT
 import           Data.List hiding (any)
+import           Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty (toList)
 import           Data.List.Split (chunksOf)
 import qualified Data.Map.Strict as M
 import qualified Data.Map.Strict as Map
@@ -581,9 +583,9 @@ executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do
     when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports
     cv <- view actualCompilerVersionL
     let wc = view whichCompilerL cv
-    case Map.toList $ planUnregisterLocal plan of
-        [] -> return ()
-        ids -> do
+    case nonEmpty . Map.toList $ planUnregisterLocal plan of
+        Nothing -> return ()
+        Just ids -> do
             localDB <- packageDatabaseLocal
             unregisterPackages cv localDB ids
 
@@ -659,7 +661,7 @@ unregisterPackages ::
        (HasProcessContext env, HasLogFunc env, HasPlatform env)
     => ActualCompiler
     -> Path Abs Dir
-    -> [(GhcPkgId, (PackageIdentifier, Text))]
+    -> NonEmpty (GhcPkgId, (PackageIdentifier, Text))
     -> RIO env ()
 unregisterPackages cv localDB ids = do
     let wc = view whichCompilerL cv
@@ -671,7 +673,7 @@ unregisterPackages cv localDB ids = do
                 else " (" <> RIO.display reason <> ")"
     let unregisterSinglePkg select (gid, (ident, reason)) = do
             logReason ident reason
-            unregisterGhcPkgIds wc localDB [select ident gid]
+            unregisterGhcPkgIds wc localDB $ select ident gid :| []
 
     case cv of
         -- GHC versions >= 8.0.1 support batch unregistering of packages. See
@@ -687,9 +689,10 @@ unregisterPackages cv localDB ids = do
                 let batchSize = case platform of
                       Platform _ Windows -> 100
                       _ -> 500
-                for_ (chunksOf batchSize ids) $ \batch -> do
+                let chunksOfNE size = catMaybes . map nonEmpty . chunksOf size . NonEmpty.toList
+                for_ (chunksOfNE batchSize ids) $ \batch -> do
                     for_ batch $ \(_, (ident, reason)) -> logReason ident reason
-                    unregisterGhcPkgIds wc localDB $ map (Right . fst) batch
+                    unregisterGhcPkgIds wc localDB $ fmap (Right . fst) batch
 
         -- GHC versions >= 7.9 support unregistering of packages via their
         -- GhcPkgId.

diff --git a/src/Stack/GhcPkg.hs b/src/Stack/GhcPkg.hs
@@ -21,6 +21,7 @@ import           Stack.Prelude
 import qualified Data.ByteString.Char8 as S8
 import qualified Data.ByteString.Lazy as BL
 import           Data.List
+import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Path (parent, (</>))
@@ -151,7 +152,7 @@ findGhcPkgVersion wc pkgDbs name = do
 unregisterGhcPkgIds :: (HasProcessContext env, HasLogFunc env)
                     => WhichCompiler
                     -> Path Abs Dir -- ^ package database
-                    -> [Either PackageIdentifier GhcPkgId]
+                    -> NonEmpty (Either PackageIdentifier GhcPkgId)
                     -> RIO env ()
 unregisterGhcPkgIds wc pkgDb epgids = do
     eres <- ghcPkg wc [pkgDb] args