where
-- Relies on the first hash being cryptographically secure, and the
-- default hash used by git-annex.
- hashbackend = Prelude.head Backend.Hash.backends
+ hashbackend = fromMaybe (error "internal") $
+ headMaybe Backend.Hash.backends
migrateFromVURLToURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)
migrateFromVURLToURL oldkey newbackend _af _
{- The default hashing backend. -}
defaultHashBackend :: Backend
-defaultHashBackend = Prelude.head regularBackendList
+defaultHashBackend = fromMaybe (error "internal") $ headMaybe regularBackendList
makeVarietyMap :: [Backend] -> M.Map KeyVariety Backend
makeVarietyMap l = M.fromList $ zip (map backendVariety l) l
import qualified Options.Applicative as O
import qualified Options.Applicative.Help as H
+import qualified Data.List.NonEmpty as NE
import Control.Exception (throw)
import Control.Monad.IO.Class (MonadIO)
import System.Exit
handleresult (parseCmd progname progdesc correctedargs allcmds getparser)
res -> handleresult res
where
- autocorrect = Git.AutoCorrect.prepare (fromJust subcommandname) cmdname cmds
+ autocorrect = Git.AutoCorrect.prepare (fromJust subcommandname) cmdname (NE.fromList cmds)
name
| fuzzy = case cmds of
(c:_) -> Just (cmdname c)
import Text.EditDistance
import Control.Concurrent
+import qualified Data.List.NonEmpty as NE
{- These are the same cost values as used in git. -}
gitEditCosts :: EditCosts
{- Takes action based on git's autocorrect configuration, in preparation for
- an autocorrected command being run.
-}
-prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO ()
+prepare :: String -> (c -> String) -> NE.NonEmpty c -> Maybe Repo -> IO ()
prepare input showmatch matches r =
case readish . fromConfigValue . Git.Config.get "help.autocorrect" "0" =<< r of
Just n
[ "Unknown command '" ++ input ++ "'"
, ""
, "Did you mean one of these?"
- ] ++ map (\m -> "\t" ++ showmatch m) matches
+ ] ++ map (\m -> "\t" ++ showmatch m) (NE.toList matches)
warn :: Maybe Float -> IO ()
warn mdelaysec = hPutStr stderr $ unlines
[ "WARNING: You called a git-annex command named '" ++
Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match
]
where
- match = "'" ++ showmatch (Prelude.head matches) ++ "'."
+ match = "'" ++ showmatch (NE.head matches) ++ "'."
sleep n = do
warn (Just (fromIntegral n / 10 :: Float))
threadDelay (n * 100000) -- deciseconds to microseconds
import Git.Types
import qualified Data.ByteString as S
+import qualified Data.List.NonEmpty as NE
import Data.Char
{- Runs an action that causes a git subcommand to emit a Sha, and strips
]
{- Sizes of git shas. -}
-shaSizes :: [Int]
+shaSizes :: NE.NonEmpty Int
shaSizes =
- [ 40 -- sha1 (must come first)
- , 64 -- sha256
- ]
+ 40 -- sha1 (must come first)
+ NE.:| [64] -- sha256
{- Git plumbing often uses a all 0 sha to represent things like a
- deleted file. -}
-nullShas :: [Sha]
-nullShas = map (\n -> Ref (S.replicate n zero)) shaSizes
+nullShas :: NE.NonEmpty Sha
+nullShas = NE.map (\n -> Ref (S.replicate n zero)) shaSizes
where
zero = fromIntegral (ord '0')
- sha1 to the sha256, or probably just treat all null sha1 specially
- the same as all null sha256. -}
deleteSha :: Sha
-deleteSha = Prelude.head nullShas
+deleteSha = NE.head nullShas
{- Git's magic empty tree.
-
- generating new content.
-}
calcMerge :: [(Ref, [L8.ByteString])] -> Either Ref [L8.ByteString]
-calcMerge shacontents
- | null reusable = Right new
- | otherwise = Left $ fst $ Prelude.head reusable
+calcMerge shacontents = case reusable of
+ [] -> Right new
+ (r:_) -> Left $ fst r
where
reusable = filter (\c -> sorteduniq (snd c) == new) shacontents
new = sorteduniq $ concat $ map snd shacontents
regionMap = M.fromList . regionInfo
defaultRegion :: Service -> Region
-defaultRegion = snd . Prelude.head . regionInfo
+defaultRegion = snd . fromMaybe (error "internal") . headMaybe . regionInfo
data ServiceRegion = BothRegion Region | S3Region Region | GlacierRegion Region
}
where
bits = splitc ':' v
- b = Prelude.head bits
+ b = fromMaybe (error "unable to parse v0 key") (headMaybe bits)
n = intercalate ":" $ drop (if wormy then 3 else 1) bits
t = if wormy
then readMaybe (bits !! 1) :: Maybe EpochTime
{- Parses strings like "10 kilobytes" or "0.5tb". -}
readSize :: [Unit] -> String -> Maybe ByteSize
-readSize units input
- | null parsednum || null parsedunit = Nothing
- | otherwise = Just $ round $ number * fromIntegral multiplier
+readSize units input = case parsednum of
+ [] -> Nothing
+ ((number, rest):_) ->
+ let unitname = takeWhile isAlpha $ dropWhile isSpace rest
+ in case lookupUnit units unitname of
+ [] -> Nothing
+ (multiplier:_) ->
+ Just $ round $ number * fromIntegral multiplier
where
- (number, rest) = head parsednum
- multiplier = head parsedunit
- unitname = takeWhile isAlpha $ dropWhile isSpace rest
-
parsednum = reads input :: [(Double, String)]
- parsedunit = lookupUnit units unitname
lookupUnit _ [] = [1] -- no unit given, assume bytes
lookupUnit [] _ = []
separate :: (a -> Bool) -> [a] -> ([a], [a])
separate c l = unbreak $ break c l
where
- unbreak r@(a, b)
- | null b = r
- | otherwise = (a, tail b)
+ unbreak (a, (_:b)) = (a, b)
+ unbreak r = r
separate' :: (Word8 -> Bool) -> S.ByteString -> (S.ByteString, S.ByteString)
separate' c l = unbreak $ S.break c l
module Utility.PartialPrelude (
Utility.PartialPrelude.read,
- Utility.PartialPrelude.head,
- Utility.PartialPrelude.tail,
Utility.PartialPrelude.init,
Utility.PartialPrelude.last,
Utility.PartialPrelude.readish,
read :: Read a => String -> a
read = Prelude.read
-{- head is a partial function; head [] is an error
- - Instead, use: take 1 or headMaybe -}
-head :: [a] -> a
-head = Prelude.head
-
-{- tail is also partial
- - Instead, use: drop 1 -}
-tail :: [a] -> [a]
-tail = Prelude.tail
-
{- init too
- Instead, use: beginning -}
init :: [a] -> [a]
((p, _s):_) -> waithiddenservice 1 p
_ -> do
highports <- R.getStdRandom mkhighports
- let newport = Prelude.head $
+ let newport = fromMaybe (error "internal") $ headMaybe $
filter (`notElem` map fst portssocks) highports
torrc <- findTorrc
writeFile torrc $ unlines $
projects / git-annex.git / commitdiff