use NonEmpty for dirHashes

This avoids 4 uses of head.

diff --git a/Annex/DirHashes.hs b/Annex/DirHashes.hs
index 7311acf3e6024dfcdff9c32277daf0ca866e9040..0c6e9327111c7845cd46054c8f1f2548a65e6c2d 100644 (file)
--- a/Annex/DirHashes.hs
+++ b/Annex/DirHashes.hs
@@ -1,4 +1,4 @@
-{- git-annex file locations
+{- git-annex object file locations
  -
  - Copyright 2010-2019 Joey Hess <id@joeyh.name>
  -
@@ -19,6 +19,7 @@ module Annex.DirHashes (
 
 import Data.Default
 import Data.Bits
+import qualified Data.List.NonEmpty as NE
 import qualified Data.ByteArray as BA
 import qualified Data.ByteArray.Encoding as BA
 import qualified Data.ByteString as S
@@ -60,8 +61,8 @@ branchHashDir = hashDirLower . branchHashLevels
  - To support that, some git-annex repositories use the lower case-hash.
  - All special remotes use the lower-case hash for new data, but old data
  - may still use the mixed case hash. -}
-dirHashes :: [HashLevels -> Hasher]
-dirHashes = [hashDirLower, hashDirMixed]
+dirHashes :: NE.NonEmpty (HashLevels -> Hasher)
+dirHashes = hashDirLower NE.:| [hashDirMixed]
 
 hashDirs :: HashLevels -> Int -> S.ByteString -> RawFilePath
 hashDirs (HashLevels 1) sz s = P.addTrailingPathSeparator $ S.take sz s

diff --git a/Annex/Locations.hs b/Annex/Locations.hs
index e28fb7c5ad121d01f8c4af55e9639c99e4ef317b..5d7e75f58c1f0f826e53db3815b3b009ce34a372 100644 (file)
--- a/Annex/Locations.hs
+++ b/Annex/Locations.hs
@@ -118,6 +118,7 @@ module Annex.Locations (
 
 import Data.Char
 import Data.Default
+import qualified Data.List.NonEmpty as NE
 import qualified Data.ByteString.Char8 as S8
 import qualified System.FilePath.ByteString as P
 
@@ -775,5 +776,5 @@ keyPath key hasher = hasher key P.</> f P.</> f
  - This is compatible with the annexLocationsNonBare and annexLocationsBare,
  - for interoperability between special remotes and git-annex repos.
  -}
-keyPaths :: Key -> [RawFilePath]
-keyPaths key = map (\h -> keyPath key (h def)) dirHashes
+keyPaths :: Key -> NE.NonEmpty RawFilePath
+keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes

diff --git a/Assistant/Gpg.hs b/Assistant/Gpg.hs
index 01226e0640d73a80de33f6703422a2347bab6d6c..e6391d179d3c86f9ae407fbe91d00f07cdfc11c4 100644 (file)
--- a/Assistant/Gpg.hs
+++ b/Assistant/Gpg.hs
@@ -9,10 +9,12 @@ module Assistant.Gpg where
 
 import Utility.Gpg
 import Utility.UserInfo
+import Utility.PartialPrelude
 import Types.Remote (RemoteConfigField)
 import Annex.SpecialRemote.Config
 import Types.ProposedAccepted
 
+import Data.Maybe
 import qualified Data.Map as M
 import Control.Applicative
 import Prelude
@@ -23,10 +25,11 @@ newUserId cmd = do
        oldkeys <- secretKeys cmd
        username <- either (const "unknown") id <$> myUserName
        let basekeyname = username ++ "'s git-annex encryption key"
-       return $ Prelude.head $ filter (\n -> M.null $ M.filter (== n) oldkeys)
-               ( basekeyname
-               : map (\n -> basekeyname ++ show n) ([2..] :: [Int])
-               )
+       return $ fromMaybe (error "internal") $ headMaybe $
+               filter (\n -> M.null $ M.filter (== n) oldkeys)
+                       ( basekeyname
+                       : map (\n -> basekeyname ++ show n) ([2..] :: [Int])
+                       )
 
 data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption
        deriving (Eq)

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index b490c79ad5a2bb09cdbacd65da9115ee7710320f..1cd2dcb16526d9e3f827ff130b5158040e13de98 100644 (file)
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -307,7 +307,7 @@ bup2GitRemote r
        | otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
   where
        bits = splitc ':' r
-       host = Prelude.head bits
+       host = fromMaybe "" $ headMaybe bits
        dir = intercalate ":" $ drop 1 bits
        -- "host:~user/dir" is not supported specially by bup;
        -- "host:dir" is relative to the home directory;

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index a70ce15a519e613aeb2e6074f9928160a83a2468..cebd5e61fe979fe658615d11c7c4f3e02b556a0f 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -17,6 +17,7 @@ module Remote.Directory (
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
+import qualified Data.List.NonEmpty as NE
 import qualified System.FilePath.ByteString as P
 import Data.Default
 import System.PosixCompat.Files (isRegularFile, deviceID)
@@ -166,8 +167,11 @@ directorySetup _ mu _ c gc = do
 {- Locations to try to access a given Key in the directory.
  - We try more than one since we used to write to different hash
  - directories. -}
-locations :: RawFilePath -> Key -> [RawFilePath]
-locations d k = map (d P.</>) (keyPaths k)
+locations :: RawFilePath -> Key -> NE.NonEmpty RawFilePath
+locations d k = NE.map (d P.</>) (keyPaths k)
+
+locations' :: RawFilePath -> Key -> [RawFilePath]
+locations' d k = NE.toList (locations d k)
 
 {- Returns the location off a Key in the directory. If the key is
  - present, returns the location that is actually used, otherwise
@@ -175,8 +179,9 @@ locations d k = map (d P.</>) (keyPaths k)
 getLocation :: RawFilePath -> Key -> IO RawFilePath
 getLocation d k = do
        let locs = locations d k
-       fromMaybe (Prelude.head locs)
-               <$> firstM (doesFileExist . fromRawFilePath) locs
+       fromMaybe (NE.head locs)
+               <$> firstM (doesFileExist . fromRawFilePath)
+                       (NE.toList locs)
 
 {- Directory where the file(s) for a key are stored. -}
 storeDir :: RawFilePath -> Key -> RawFilePath
@@ -246,7 +251,7 @@ finalizeStoreGeneric d tmp dest = do
        dest' = fromRawFilePath dest
 
 retrieveKeyFileM :: RawFilePath -> ChunkConfig -> CopyCoWTried -> Retriever
-retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations d
+retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations' d
 retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do
        src <- liftIO $ fromRawFilePath <$> getLocation d k
        void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv
@@ -311,8 +316,8 @@ removeDirGeneric removeemptyparents topdir dir = do
                goparents (upFrom subdir) =<< tryIO (removeDirectory d)
 
 checkPresentM :: RawFilePath -> ChunkConfig -> CheckPresent
-checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k
-checkPresentM d _ k = checkPresentGeneric d (locations d k)
+checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations' k
+checkPresentM d _ k = checkPresentGeneric d (locations' d k)
 
 checkPresentGeneric :: RawFilePath -> [RawFilePath] -> Annex Bool
 checkPresentGeneric d ps = checkPresentGeneric' d $

diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 719489aae67afaa2937e1812ac58011452ce44d6..3479e7bb12ae8b0da87d54dbc0fee4cb6432efa1 100644 (file)
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -51,6 +51,7 @@ import Annex.Verify
 import qualified Utility.RawFilePath as R
 
 import qualified Data.Map as M
+import qualified Data.List.NonEmpty as NE
 
 remote :: RemoteType
 remote = specialRemoteType $ RemoteType
@@ -222,7 +223,7 @@ rsyncSetup _ mu _ c gc = do
 store :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex ()
 store o k src meterupdate = storeGeneric o meterupdate basedest populatedest
   where
-       basedest = fromRawFilePath $ Prelude.head (keyPaths k)
+       basedest = fromRawFilePath $ NE.head (keyPaths k)
        populatedest dest = liftIO $ if canrename
                then do
                        R.rename (toRawFilePath src) (toRawFilePath dest)

diff --git a/Remote/Rsync/RsyncUrl.hs b/Remote/Rsync/RsyncUrl.hs
index d0e1714557fc46326df088d30ed0f57911d522b9..8b3c2eba146ba832e9f0d790c1b3184c92b83158 100644 (file)
--- a/Remote/Rsync/RsyncUrl.hs
+++ b/Remote/Rsync/RsyncUrl.hs
@@ -22,6 +22,7 @@ import Utility.Split
 
 import Data.Default
 import System.FilePath.Posix
+import qualified Data.List.NonEmpty as NE
 
 type RsyncUrl = String
 
@@ -42,7 +43,7 @@ mkRsyncUrl :: RsyncOpts -> FilePath -> RsyncUrl
 mkRsyncUrl o f = rsyncUrl o </> rsyncEscape o f
 
 rsyncUrls :: RsyncOpts -> Key -> [RsyncUrl]
-rsyncUrls o k = map use dirHashes
+rsyncUrls o k = map use (NE.toList dirHashes)
   where
        use h = rsyncUrl o </> hash h </> rsyncEscape o (f </> f)
        f = fromRawFilePath (keyFile k)

diff --git a/Test.hs b/Test.hs
index 851ec29b1bb6035e24d2020cdf3105669fed17fb..eecd7f6590e47c6ecab1f6d7a81f2e77adca839f 100644 (file)
--- a/Test.hs
+++ b/Test.hs
@@ -1940,9 +1940,9 @@ test_gpg_crypto = do
                checkFile mvariant filename =
                        Utility.Gpg.checkEncryptionFile gpgcmd (Just environ) filename $
                                if mvariant == Just Types.Crypto.PubKey then ks else Nothing
-               serializeKeys cipher = map fromRawFilePath . 
-                       Annex.Locations.keyPaths .
-                       Crypto.encryptKey Types.Crypto.HmacSha1 cipher
+               serializeKeys cipher = map fromRawFilePath . NE.toList 
+                       . Annex.Locations.keyPaths
+                       . Crypto.encryptKey Types.Crypto.HmacSha1 cipher
 #else
 test_gpg_crypto = putStrLn "gpg testing not implemented on Windows"
 #endif