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