remove read of the heads
and one tail Removed head from Utility.PartialPrelude in order to avoid the build warning with recent ghc versions as well.
This commit is contained in:
parent
10216b44d2
commit
4ca3d1d584
12 changed files with 32 additions and 42 deletions
|
@ -31,7 +31,8 @@ migrateFromURLToVURL oldkey newbackend _af inannex
|
|||
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 _
|
||||
|
|
|
@ -29,7 +29,7 @@ regularBackendList = Backend.Hash.backends
|
|||
|
||||
{- 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
|
||||
|
|
|
@ -14,6 +14,7 @@ module CmdLine (
|
|||
|
||||
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
|
||||
|
@ -91,7 +92,7 @@ dispatch' subcommandname args fuzzy cmds allargs allcmds fields getgitrepo progn
|
|||
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)
|
||||
|
|
|
@ -15,6 +15,7 @@ import qualified Git.Config
|
|||
|
||||
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
|
||||
|
@ -44,7 +45,7 @@ fuzzymatches input showchoice choices = fst $ unzip $
|
|||
{- 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
|
||||
|
@ -57,7 +58,7 @@ prepare input showmatch matches r =
|
|||
[ "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 '" ++
|
||||
|
@ -67,7 +68,7 @@ prepare input showmatch matches r =
|
|||
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
|
||||
|
|
14
Git/Sha.hs
14
Git/Sha.hs
|
@ -13,6 +13,7 @@ import Common
|
|||
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
|
||||
|
@ -44,16 +45,15 @@ extractSha s
|
|||
]
|
||||
|
||||
{- 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')
|
||||
|
||||
|
@ -63,7 +63,7 @@ nullShas = map (\n -> Ref (S.replicate n zero)) shaSizes
|
|||
- 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.
|
||||
-
|
||||
|
|
|
@ -107,9 +107,9 @@ mergeFile info file hashhandle h = case S8.words info of
|
|||
- 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
|
||||
|
|
|
@ -40,7 +40,7 @@ regionMap :: Service -> M.Map Text Region
|
|||
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
|
||||
|
||||
|
|
|
@ -167,7 +167,7 @@ readKey1' v
|
|||
}
|
||||
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
|
||||
|
|
|
@ -180,16 +180,16 @@ compareSizes units abbrev old new
|
|||
|
||||
{- 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 [] _ = []
|
||||
|
|
|
@ -52,9 +52,8 @@ readFileStrict = readFile >=> \s -> length s `seq` return s
|
|||
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
|
||||
|
|
|
@ -9,8 +9,6 @@
|
|||
|
||||
module Utility.PartialPrelude (
|
||||
Utility.PartialPrelude.read,
|
||||
Utility.PartialPrelude.head,
|
||||
Utility.PartialPrelude.tail,
|
||||
Utility.PartialPrelude.init,
|
||||
Utility.PartialPrelude.last,
|
||||
Utility.PartialPrelude.readish,
|
||||
|
@ -27,16 +25,6 @@ import qualified Data.Maybe
|
|||
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]
|
||||
|
|
|
@ -80,7 +80,7 @@ addHiddenService appname uid ident = do
|
|||
((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 $
|
||||
|
|
Loading…
Reference in a new issue