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
|
||||
|
||||
type SHASize = Int
|
||||
|
||||
|
||||
backends :: [Backend Annex]
|
||||
-- order is slightly significant; want sha1 first ,and more general
|
||||
-- sizes earlier
|
||||
|
@ -35,8 +35,8 @@ backends = catMaybes $ map genBackend [1, 256, 512, 224, 384]
|
|||
|
||||
genBackend :: SHASize -> Maybe (Backend Annex)
|
||||
genBackend size
|
||||
| shaCommand size /= "" = Just b
|
||||
| otherwise = Nothing
|
||||
| shaCommand size == Nothing = Nothing
|
||||
| otherwise = Just b
|
||||
where
|
||||
b = Backend.File.backend
|
||||
{ name = shaName size
|
||||
|
@ -44,13 +44,13 @@ genBackend size
|
|||
, fsckKey = Backend.File.checkKey $ checkKeyChecksum size
|
||||
}
|
||||
|
||||
shaCommand :: SHASize -> String
|
||||
shaCommand :: SHASize -> Maybe String
|
||||
shaCommand 1 = SysConfig.sha1
|
||||
shaCommand 256 = SysConfig.sha256
|
||||
shaCommand 224 = SysConfig.sha224
|
||||
shaCommand 384 = SysConfig.sha384
|
||||
shaCommand 512 = SysConfig.sha512
|
||||
shaCommand _ = ""
|
||||
shaCommand _ = Nothing
|
||||
|
||||
shaName :: SHASize -> String
|
||||
shaName size = "SHA" ++ show size
|
||||
|
@ -65,7 +65,7 @@ shaN size file = do
|
|||
then error $ command ++ " parse error"
|
||||
else return $ head bits
|
||||
where
|
||||
command = shaCommand size
|
||||
command = fromJust $ shaCommand size
|
||||
|
||||
{- A key is a checksum of its contents. -}
|
||||
keyValue :: SHASize -> FilePath -> Annex (Maybe Key)
|
||||
|
|
|
@ -7,7 +7,10 @@ import System.Cmd
|
|||
import System.Exit
|
||||
|
||||
type ConfigKey = String
|
||||
data ConfigValue = BoolConfig Bool | StringConfig String
|
||||
data ConfigValue =
|
||||
BoolConfig Bool |
|
||||
StringConfig String |
|
||||
MaybeStringConfig (Maybe String)
|
||||
data Config = Config ConfigKey ConfigValue
|
||||
|
||||
type Test = IO Config
|
||||
|
@ -17,15 +20,17 @@ data TestCase = TestCase TestName Test
|
|||
instance Show ConfigValue where
|
||||
show (BoolConfig b) = show b
|
||||
show (StringConfig s) = show s
|
||||
show (MaybeStringConfig s) = show s
|
||||
|
||||
instance Show Config where
|
||||
show (Config key value) = unlines
|
||||
show (Config key value) = unlines
|
||||
[ key ++ " :: " ++ valuetype value
|
||||
, key ++ " = " ++ show value
|
||||
]
|
||||
where
|
||||
valuetype (BoolConfig _) = "Bool"
|
||||
valuetype (StringConfig _) = "String"
|
||||
valuetype (MaybeStringConfig _) = "Maybe String"
|
||||
|
||||
writeSysConfig :: [Config] -> IO ()
|
||||
writeSysConfig config = writeFile "SysConfig.hs" body
|
||||
|
@ -83,12 +88,13 @@ whichCmd :: ConfigKey -> [String] -> Test
|
|||
whichCmd k cmds = search cmds
|
||||
where
|
||||
search [] = do
|
||||
testEnd $ Config k (StringConfig "")
|
||||
return $ Config k (StringConfig "")
|
||||
let r = Config k (MaybeStringConfig Nothing)
|
||||
testEnd r
|
||||
return r
|
||||
search (c:cs) = do
|
||||
ret <- system $ quiet c
|
||||
if (ret == ExitSuccess)
|
||||
then return $ Config k (StringConfig $ head $ words c)
|
||||
then return $ Config k (MaybeStringConfig $ Just $ head $ words c)
|
||||
else search cs
|
||||
|
||||
quiet :: String -> String
|
||||
|
@ -103,3 +109,5 @@ testEnd :: Config -> IO ()
|
|||
testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
|
||||
testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
|
||||
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
|
||||
* Periodically flush git command queue, to avoid boating memory usage
|
||||
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
|
||||
|
||||
|
|
Loading…
Reference in a new issue