where indenting

This commit is contained in:
Joey Hess 2012-11-11 00:51:07 -04:00
parent 6a0756d2fb
commit 2172cc586e
42 changed files with 1193 additions and 1209 deletions

View file

@ -45,19 +45,18 @@ tests =
- known-good hashes. -}
shaTestCases :: [(Int, String)] -> [TestCase]
shaTestCases l = map make l
where
make (n, knowngood) =
TestCase key $ maybeSelectCmd key $
zip (shacmds n) (repeat check)
where
key = "sha" ++ show n
check = "</dev/null | grep -q '" ++ knowngood ++ "'"
shacmds n = concatMap (\x -> [x, 'g':x, osxpath </> x]) $
map (\x -> "sha" ++ show n ++ x) ["sum", ""]
{- Max OSX sometimes puts GNU tools outside PATH, so look in
- the location it uses, and remember where to run them
- from. -}
osxpath = "/opt/local/libexec/gnubin"
where
make (n, knowngood) = TestCase key $ maybeSelectCmd key $
zip (shacmds n) (repeat check)
where
key = "sha" ++ show n
check = "</dev/null | grep -q '" ++ knowngood ++ "'"
shacmds n = concatMap (\x -> [x, 'g':x, osxpath </> x]) $
map (\x -> "sha" ++ show n ++ x) ["sum", ""]
{- Max OSX sometimes puts GNU tools outside PATH, so look in
- the location it uses, and remember where to run them
- from. -}
osxpath = "/opt/local/libexec/gnubin"
tmpDir :: String
tmpDir = "tmp"
@ -67,9 +66,9 @@ testFile = tmpDir ++ "/testfile"
testCp :: ConfigKey -> String -> TestCase
testCp k option = TestCase cmd $ testCmd k cmdline
where
cmd = "cp " ++ option
cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
where
cmd = "cp " ++ option
cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
{- Pulls package version out of the changelog. -}
getVersion :: Test
@ -82,8 +81,8 @@ getVersionString = do
changelog <- readFile "CHANGELOG"
let verline = head $ lines changelog
return $ middle (words verline !! 1)
where
middle = drop 1 . init
where
middle = drop 1 . init
getGitVersion :: Test
getGitVersion = do
@ -104,14 +103,14 @@ cabalSetup = do
map (setfield "Version" version) $
lines cabal
renameFile tmpcabalfile cabalfile
where
cabalfile = "git-annex.cabal"
tmpcabalfile = cabalfile++".tmp"
setfield field value s
| fullfield `isPrefixOf` s = fullfield ++ value
| otherwise = s
where
fullfield = field ++ ": "
where
cabalfile = "git-annex.cabal"
tmpcabalfile = cabalfile++".tmp"
setfield field value s
| fullfield `isPrefixOf` s = fullfield ++ value
| otherwise = s
where
fullfield = field ++ ": "
setup :: IO ()
setup = do

View file

@ -46,11 +46,11 @@ autostart command = genDesktopEntry
systemwideInstall :: IO Bool
systemwideInstall = isroot <||> destdirset
where
isroot = do
uid <- fromIntegral <$> getRealUserID
return $ uid == (0 :: Int)
destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
where
isroot = do
uid <- fromIntegral <$> getRealUserID
return $ uid == (0 :: Int)
destdirset = isJust <$> catchMaybeIO (getEnv "DESTDIR")
inDestDir :: FilePath -> IO FilePath
inDestDir f = do
@ -91,6 +91,6 @@ install command = do
main :: IO ()
main = getArgs >>= go
where
go [] = error "specify git-annex command"
go (command:_) = install command
where
go [] = error "specify git-annex command"
go (command:_) = install command

View file

@ -29,22 +29,22 @@ instance Show Config where
[ key ++ " :: " ++ valuetype value
, key ++ " = " ++ show value
]
where
valuetype (BoolConfig _) = "Bool"
valuetype (StringConfig _) = "String"
valuetype (MaybeStringConfig _) = "Maybe String"
valuetype (MaybeBoolConfig _) = "Maybe Bool"
where
valuetype (BoolConfig _) = "Bool"
valuetype (StringConfig _) = "String"
valuetype (MaybeStringConfig _) = "Maybe String"
valuetype (MaybeBoolConfig _) = "Maybe Bool"
writeSysConfig :: [Config] -> IO ()
writeSysConfig config = writeFile "Build/SysConfig.hs" body
where
body = unlines $ header ++ map show config ++ footer
header = [
"{- Automatically generated. -}"
, "module Build.SysConfig where"
, ""
]
footer = []
where
body = unlines $ header ++ map show config ++ footer
header = [
"{- Automatically generated. -}"
, "module Build.SysConfig where"
, ""
]
footer = []
runTests :: [TestCase] -> IO [Config]
runTests [] = return []
@ -60,12 +60,12 @@ requireCmd :: ConfigKey -> String -> Test
requireCmd k cmdline = do
ret <- testCmd k cmdline
handle ret
where
handle r@(Config _ (BoolConfig True)) = return r
handle r = do
testEnd r
error $ "** the " ++ c ++ " command is required"
c = head $ words cmdline
where
handle r@(Config _ (BoolConfig True)) = return r
handle r = do
testEnd r
error $ "** the " ++ c ++ " command is required"
c = head $ words cmdline
{- Checks if a command is available by running a command line. -}
testCmd :: ConfigKey -> String -> Test
@ -90,13 +90,13 @@ maybeSelectCmd k = searchCmd
searchCmd :: (String -> Test) -> ([String] -> Test) -> [(String, String)] -> Test
searchCmd success failure cmdsparams = search cmdsparams
where
search [] = failure $ fst $ unzip cmdsparams
search ((c, params):cs) = do
ret <- system $ quiet $ c ++ " " ++ params
if ret == ExitSuccess
then success c
else search cs
where
search [] = failure $ fst $ unzip cmdsparams
search ((c, params):cs) = do
ret <- system $ quiet $ c ++ " " ++ params
if ret == ExitSuccess
then success c
else search cs
quiet :: String -> String
quiet s = s ++ " >/dev/null 2>&1"