where indenting
This commit is contained in:
parent
6a0756d2fb
commit
2172cc586e
42 changed files with 1193 additions and 1209 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue