avoid head

While in some sense this is better, the use of NE.fromList is still
partial.

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index 0af16a10d6aa2a72b517a908033097b37d493e43..2d96f7b1f772f8353727393e7e0e747990045369 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -42,6 +42,7 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import Data.Either
 import Control.Concurrent.STM hiding (check)
+import qualified Data.List.NonEmpty as NE
 
 cmd :: Command
 cmd = command "testremote" SectionTesting
@@ -83,8 +84,10 @@ start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemo
                        then giveup "This remote is readonly, so you need to use the --test-readonly option."
                        else do
                                showAction "generating test keys"
-                               mapM randKey (keySizes basesz fast)
-               fs -> mapM (getReadonlyKey r . toRawFilePath) fs
+                               NE.fromList
+                                       <$> mapM randKey (keySizes basesz fast)
+               fs -> NE.fromList
+                       <$> mapM (getReadonlyKey r . toRawFilePath) fs
        let r' = if null (testReadonlyFile o)
                then r
                else r { Remote.readonly = True }
@@ -100,7 +103,7 @@ start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemo
        basesz = fromInteger $ sizeOption o
        si = SeekInput [testRemote o]
 
-perform :: [Described (Annex (Maybe Remote))] -> Maybe Remote -> Annex (Maybe Remote) -> [Key] -> CommandPerform
+perform :: [Described (Annex (Maybe Remote))] -> Maybe Remote -> Annex (Maybe Remote) -> NE.NonEmpty Key -> CommandPerform
 perform drs unavailr exportr ks = do
        st <- liftIO . newTVarIO =<< (,)
                <$> Annex.getState id
@@ -110,12 +113,12 @@ perform drs unavailr exportr ks = do
                drs
                (pure unavailr)
                exportr
-               (map (\k -> Described (desck k) (pure k)) ks)
+               (NE.map (\k -> Described (desck k) (pure k)) ks)
        ok <- case tryIngredients [consoleTestReporter] mempty tests of
                Nothing -> error "No tests found!?"
                Just act -> liftIO act
        rs <- catMaybes <$> mapM getVal drs
-       next $ cleanup rs ks ok
+       next $ cleanup rs (NE.toList ks) ok
   where
        desck k = unwords [ "key size", show (fromKey keySize k) ]
 
@@ -216,12 +219,12 @@ mkTestTrees
        -> [Described (Annex (Maybe Remote))]
        -> Annex (Maybe Remote)
        -> Annex (Maybe Remote)
-       -> [Described (Annex Key)]
+       -> (NE.NonEmpty (Described (Annex Key)))
        -> [TestTree]
 mkTestTrees runannex mkrs mkunavailr mkexportr mkks = concat $
-       [ [ testGroup "unavailable remote" (testUnavailable runannex mkunavailr (getVal (Prelude.head mkks))) ]
-       , [ testGroup (desc mkr mkk) (test runannex (getVal mkr) (getVal mkk)) | mkk <- mkks, mkr <- mkrs ]
-       , [ testGroup (descexport mkk1 mkk2) (testExportTree runannex mkexportr (getVal mkk1) (getVal mkk2)) | mkk1 <- take 2 mkks, mkk2 <- take 2 (reverse mkks) ]
+       [ [ testGroup "unavailable remote" (testUnavailable runannex mkunavailr (getVal (NE.head mkks))) ]
+       , [ testGroup (desc mkr mkk) (test runannex (getVal mkr) (getVal mkk)) | mkk <- NE.toList mkks, mkr <- mkrs ]
+       , [ testGroup (descexport mkk1 mkk2) (testExportTree runannex mkexportr (getVal mkk1) (getVal mkk2)) | mkk1 <- take 2 (NE.toList mkks), mkk2 <- take 2 (reverse (NE.toList mkks)) ]
        ]
    where
        desc r k = intercalate "; " $ map unwords

diff --git a/Test.hs b/Test.hs
index d454a3a1b1d8cb015b4f1d4d3a6f9b100acd7d67..851ec29b1bb6035e24d2020cdf3105669fed17fb 100644 (file)
--- a/Test.hs
+++ b/Test.hs
@@ -23,11 +23,12 @@ import Options.Applicative (switch, long, short, help, internal, maybeReader, op
 import qualified Data.Map as M
 import qualified Data.ByteString.Lazy.UTF8 as BU8
 import Control.Concurrent.STM hiding (check)
+import qualified Utility.RawFilePath as R
+import qualified Data.List.NonEmpty as NE
+import Data.String
 
 import Common
 import CmdLine.GitAnnex.Options
-import qualified Utility.RawFilePath as R
-import Data.String
 
 import qualified Utility.ShellEscape
 import qualified Annex
@@ -251,7 +252,7 @@ testRemote testvariants remotetype setupremote =
                        cv <- annexeval cache
                        liftIO $ atomically $ putTMVar v
                                (r, (unavailr, (exportr, (ks, cv))))
-       go getv = Command.TestRemote.mkTestTrees runannex mkrs mkunavailr mkexportr mkks
+       go getv = Command.TestRemote.mkTestTrees runannex mkrs mkunavailr mkexportr (NE.fromList mkks)
          where
                runannex = inmainrepo . annexeval
                mkrs = if testvariants