let's use Maybe String for commands that may not be avilable

This commit is contained in:
Joey Hess 2011-04-07 21:47:56 -04:00
parent f5b2d650bb
commit b889543507
3 changed files with 20 additions and 11 deletions

View file

@ -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)

View file

@ -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
View file

@ -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