let's use Maybe String for commands that may not be avilable
This commit is contained in:
parent
f5b2d650bb
commit
b889543507
3 changed files with 20 additions and 11 deletions
|
@ -27,7 +27,7 @@ import qualified SysConfig
|
||||||
import Key
|
import Key
|
||||||
|
|
||||||
type SHASize = Int
|
type SHASize = Int
|
||||||
|
|
||||||
backends :: [Backend Annex]
|
backends :: [Backend Annex]
|
||||||
-- order is slightly significant; want sha1 first ,and more general
|
-- order is slightly significant; want sha1 first ,and more general
|
||||||
-- sizes earlier
|
-- sizes earlier
|
||||||
|
@ -35,8 +35,8 @@ backends = catMaybes $ map genBackend [1, 256, 512, 224, 384]
|
||||||
|
|
||||||
genBackend :: SHASize -> Maybe (Backend Annex)
|
genBackend :: SHASize -> Maybe (Backend Annex)
|
||||||
genBackend size
|
genBackend size
|
||||||
| shaCommand size /= "" = Just b
|
| shaCommand size == Nothing = Nothing
|
||||||
| otherwise = Nothing
|
| otherwise = Just b
|
||||||
where
|
where
|
||||||
b = Backend.File.backend
|
b = Backend.File.backend
|
||||||
{ name = shaName size
|
{ name = shaName size
|
||||||
|
@ -44,13 +44,13 @@ genBackend size
|
||||||
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size
|
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size
|
||||||
}
|
}
|
||||||
|
|
||||||
shaCommand :: SHASize -> String
|
shaCommand :: SHASize -> Maybe String
|
||||||
shaCommand 1 = SysConfig.sha1
|
shaCommand 1 = SysConfig.sha1
|
||||||
shaCommand 256 = SysConfig.sha256
|
shaCommand 256 = SysConfig.sha256
|
||||||
shaCommand 224 = SysConfig.sha224
|
shaCommand 224 = SysConfig.sha224
|
||||||
shaCommand 384 = SysConfig.sha384
|
shaCommand 384 = SysConfig.sha384
|
||||||
shaCommand 512 = SysConfig.sha512
|
shaCommand 512 = SysConfig.sha512
|
||||||
shaCommand _ = ""
|
shaCommand _ = Nothing
|
||||||
|
|
||||||
shaName :: SHASize -> String
|
shaName :: SHASize -> String
|
||||||
shaName size = "SHA" ++ show size
|
shaName size = "SHA" ++ show size
|
||||||
|
@ -65,7 +65,7 @@ shaN size file = do
|
||||||
then error $ command ++ " parse error"
|
then error $ command ++ " parse error"
|
||||||
else return $ head bits
|
else return $ head bits
|
||||||
where
|
where
|
||||||
command = shaCommand size
|
command = fromJust $ shaCommand size
|
||||||
|
|
||||||
{- A key is a checksum of its contents. -}
|
{- A key is a checksum of its contents. -}
|
||||||
keyValue :: SHASize -> FilePath -> Annex (Maybe Key)
|
keyValue :: SHASize -> FilePath -> Annex (Maybe Key)
|
||||||
|
|
|
@ -7,7 +7,10 @@ import System.Cmd
|
||||||
import System.Exit
|
import System.Exit
|
||||||
|
|
||||||
type ConfigKey = String
|
type ConfigKey = String
|
||||||
data ConfigValue = BoolConfig Bool | StringConfig String
|
data ConfigValue =
|
||||||
|
BoolConfig Bool |
|
||||||
|
StringConfig String |
|
||||||
|
MaybeStringConfig (Maybe String)
|
||||||
data Config = Config ConfigKey ConfigValue
|
data Config = Config ConfigKey ConfigValue
|
||||||
|
|
||||||
type Test = IO Config
|
type Test = IO Config
|
||||||
|
@ -17,15 +20,17 @@ data TestCase = TestCase TestName Test
|
||||||
instance Show ConfigValue where
|
instance Show ConfigValue where
|
||||||
show (BoolConfig b) = show b
|
show (BoolConfig b) = show b
|
||||||
show (StringConfig s) = show s
|
show (StringConfig s) = show s
|
||||||
|
show (MaybeStringConfig s) = show s
|
||||||
|
|
||||||
instance Show Config where
|
instance Show Config where
|
||||||
show (Config key value) = unlines
|
show (Config key value) = unlines
|
||||||
[ key ++ " :: " ++ valuetype value
|
[ key ++ " :: " ++ valuetype value
|
||||||
, key ++ " = " ++ show value
|
, key ++ " = " ++ show value
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
valuetype (BoolConfig _) = "Bool"
|
valuetype (BoolConfig _) = "Bool"
|
||||||
valuetype (StringConfig _) = "String"
|
valuetype (StringConfig _) = "String"
|
||||||
|
valuetype (MaybeStringConfig _) = "Maybe String"
|
||||||
|
|
||||||
writeSysConfig :: [Config] -> IO ()
|
writeSysConfig :: [Config] -> IO ()
|
||||||
writeSysConfig config = writeFile "SysConfig.hs" body
|
writeSysConfig config = writeFile "SysConfig.hs" body
|
||||||
|
@ -83,12 +88,13 @@ whichCmd :: ConfigKey -> [String] -> Test
|
||||||
whichCmd k cmds = search cmds
|
whichCmd k cmds = search cmds
|
||||||
where
|
where
|
||||||
search [] = do
|
search [] = do
|
||||||
testEnd $ Config k (StringConfig "")
|
let r = Config k (MaybeStringConfig Nothing)
|
||||||
return $ Config k (StringConfig "")
|
testEnd r
|
||||||
|
return r
|
||||||
search (c:cs) = do
|
search (c:cs) = do
|
||||||
ret <- system $ quiet c
|
ret <- system $ quiet c
|
||||||
if (ret == ExitSuccess)
|
if (ret == ExitSuccess)
|
||||||
then return $ Config k (StringConfig $ head $ words c)
|
then return $ Config k (MaybeStringConfig $ Just $ head $ words c)
|
||||||
else search cs
|
else search cs
|
||||||
|
|
||||||
quiet :: String -> String
|
quiet :: String -> String
|
||||||
|
@ -103,3 +109,5 @@ testEnd :: Config -> IO ()
|
||||||
testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
|
testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
|
||||||
testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
|
testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
|
||||||
testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
|
testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
|
||||||
|
testEnd (Config _ (MaybeStringConfig (Just s))) = putStrLn $ " " ++ s
|
||||||
|
testEnd (Config _ (MaybeStringConfig Nothing)) = putStrLn $ " not available"
|
||||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -14,6 +14,7 @@ git-annex (0.20110402) UNRELEASED; urgency=low
|
||||||
* Add doc-base file. Closes: #621408
|
* Add doc-base file. Closes: #621408
|
||||||
* Periodically flush git command queue, to avoid boating memory usage
|
* Periodically flush git command queue, to avoid boating memory usage
|
||||||
too much.
|
too much.
|
||||||
|
* Support "sha1" and "sha512" commands on FreeBSD. Thanks, Fraser Tweedale
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Sat, 02 Apr 2011 13:45:54 -0400
|
-- Joey Hess <joeyh@debian.org> Sat, 02 Apr 2011 13:45:54 -0400
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue