aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-28 22:09:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-28 22:09:09 -0400
commit9dd50063b98020add52672864922308ebb479280 (patch)
tree2d6af9da19692c7a416f8ff897e2a3d73e406a73
parent6ea085e7fe12d6c9743b1634cb5f7c4e622ebc3f (diff)
more indentation. must stop.
-rw-r--r--Assistant.hs80
-rw-r--r--Backend.hs70
-rw-r--r--Limit.hs104
-rw-r--r--Messages.hs66
-rw-r--r--Usage.hs48
5 files changed, 183 insertions, 185 deletions
diff --git a/Assistant.hs b/Assistant.hs
index cf92a8625..ade4621e5 100644
--- a/Assistant.hs
+++ b/Assistant.hs
@@ -173,58 +173,58 @@ startDaemon assistant foreground webappwaiter
logfd <- liftIO . openLog =<< fromRepo gitAnnexLogFile
pidfile <- fromRepo gitAnnexPidFile
go $ Utility.Daemon.daemonize logfd (Just pidfile) False
- where
- go d = startAssistant assistant d webappwaiter
+ where
+ go d = startAssistant assistant d webappwaiter
startAssistant :: Bool -> (IO () -> IO ()) -> Maybe (String -> FilePath -> IO ()) -> Annex ()
startAssistant assistant daemonize webappwaiter = withThreadState $ \st -> do
checkCanWatch
dstatus <- startDaemonStatus
liftIO $ daemonize $ run dstatus st
- where
- run dstatus st = do
- changechan <- newChangeChan
- commitchan <- newCommitChan
- pushmap <- newFailedPushMap
- transferqueue <- newTransferQueue
- transferslots <- newTransferSlots
- scanremotes <- newScanRemoteMap
- branchhandle <- newBranchChangeHandle
- pushnotifier <- newPushNotifier
+ where
+ run dstatus st = do
+ changechan <- newChangeChan
+ commitchan <- newCommitChan
+ pushmap <- newFailedPushMap
+ transferqueue <- newTransferQueue
+ transferslots <- newTransferSlots
+ scanremotes <- newScanRemoteMap
+ branchhandle <- newBranchChangeHandle
+ pushnotifier <- newPushNotifier
#ifdef WITH_WEBAPP
- urlrenderer <- newUrlRenderer
+ urlrenderer <- newUrlRenderer
#endif
- mapM_ (startthread dstatus)
- [ watch $ commitThread st changechan commitchan transferqueue dstatus
+ mapM_ (startthread dstatus)
+ [ watch $ commitThread st changechan commitchan transferqueue dstatus
#ifdef WITH_WEBAPP
- , assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots pushnotifier commitchan urlrenderer Nothing webappwaiter
+ , assist $ webAppThread (Just st) dstatus scanremotes transferqueue transferslots pushnotifier commitchan urlrenderer Nothing webappwaiter
#ifdef WITH_PAIRING
- , assist $ pairListenerThread st dstatus scanremotes urlrenderer
+ , assist $ pairListenerThread st dstatus scanremotes urlrenderer
#endif
#endif
- , assist $ pushThread st dstatus commitchan pushmap pushnotifier
- , assist $ pushRetryThread st dstatus pushmap pushnotifier
- , assist $ mergeThread st dstatus transferqueue branchhandle
- , assist $ transferWatcherThread st dstatus transferqueue
- , assist $ transferPollerThread st dstatus
- , assist $ transfererThread st dstatus transferqueue transferslots commitchan
- , assist $ daemonStatusThread st dstatus
- , assist $ sanityCheckerThread st dstatus transferqueue changechan
- , assist $ mountWatcherThread st dstatus scanremotes pushnotifier
- , assist $ netWatcherThread st dstatus scanremotes pushnotifier
- , assist $ netWatcherFallbackThread st dstatus scanremotes pushnotifier
- , assist $ transferScannerThread st dstatus scanremotes transferqueue
- , assist $ configMonitorThread st dstatus branchhandle commitchan
+ , assist $ pushThread st dstatus commitchan pushmap pushnotifier
+ , assist $ pushRetryThread st dstatus pushmap pushnotifier
+ , assist $ mergeThread st dstatus transferqueue branchhandle
+ , assist $ transferWatcherThread st dstatus transferqueue
+ , assist $ transferPollerThread st dstatus
+ , assist $ transfererThread st dstatus transferqueue transferslots commitchan
+ , assist $ daemonStatusThread st dstatus
+ , assist $ sanityCheckerThread st dstatus transferqueue changechan
+ , assist $ mountWatcherThread st dstatus scanremotes pushnotifier
+ , assist $ netWatcherThread st dstatus scanremotes pushnotifier
+ , assist $ netWatcherFallbackThread st dstatus scanremotes pushnotifier
+ , assist $ transferScannerThread st dstatus scanremotes transferqueue
+ , assist $ configMonitorThread st dstatus branchhandle commitchan
#ifdef WITH_XMPP
- , assist $ pushNotifierThread st dstatus pushnotifier
+ , assist $ pushNotifierThread st dstatus pushnotifier
#endif
- , watch $ watchThread st dstatus transferqueue changechan
- ]
- waitForTermination
+ , watch $ watchThread st dstatus transferqueue changechan
+ ]
+ waitForTermination
- watch a = (True, a)
- assist a = (False, a)
- startthread dstatus (watcher, t)
- | watcher || assistant = void $ forkIO $
- runNamedThread dstatus t
- | otherwise = noop
+ watch a = (True, a)
+ assist a = (False, a)
+ startthread dstatus (watcher, t)
+ | watcher || assistant = void $ forkIO $
+ runNamedThread dstatus t
+ | otherwise = noop
diff --git a/Backend.hs b/Backend.hs
index d1dfdef3c..b66e6130e 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -40,16 +40,16 @@ orderedList = do
if not $ null l
then return l
else handle =<< Annex.getState Annex.forcebackend
- where
- handle Nothing = standard
- handle (Just "") = standard
- handle (Just name) = do
- l' <- (lookupBackendName name :) <$> standard
- Annex.changeState $ \s -> s { Annex.backends = l' }
- return l'
- standard = parseBackendList <$> getConfig (annexConfig "backends") ""
- parseBackendList [] = list
- parseBackendList s = map lookupBackendName $ words s
+ where
+ handle Nothing = standard
+ handle (Just "") = standard
+ handle (Just name) = do
+ l' <- (lookupBackendName name :) <$> standard
+ Annex.changeState $ \s -> s { Annex.backends = l' }
+ return l'
+ standard = parseBackendList <$> getConfig (annexConfig "backends") ""
+ parseBackendList [] = list
+ parseBackendList s = map lookupBackendName $ words s
{- Generates a key for a file, trying each backend in turn until one
- accepts it.
@@ -66,12 +66,12 @@ genKey' (b:bs) source = do
case r of
Nothing -> genKey' bs source
Just k -> return $ Just (makesane k, b)
- where
- -- keyNames should not contain newline characters.
- makesane k = k { keyName = map fixbadchar (keyName k) }
- fixbadchar c
- | c == '\n' = '_'
- | otherwise = c
+ where
+ -- keyNames should not contain newline characters.
+ makesane k = k { keyName = map fixbadchar (keyName k) }
+ fixbadchar c
+ | c == '\n' = '_'
+ | otherwise = c
{- Looks up the key and backend corresponding to an annexed file,
- by examining what the file symlinks to. -}
@@ -81,35 +81,33 @@ lookupFile file = do
case tl of
Left _ -> return Nothing
Right l -> makekey l
- where
- makekey l = maybe (return Nothing) (makeret l) (fileKey $ takeFileName l)
- makeret l k = let bname = keyBackendName k in
- case maybeLookupBackendName bname of
- Just backend -> do
- return $ Just (k, backend)
- Nothing -> do
- when (isLinkToAnnex l) $ warning $
- "skipping " ++ file ++
- " (unknown backend " ++
- bname ++ ")"
- return Nothing
+ where
+ makekey l = maybe (return Nothing) (makeret l) (fileKey $ takeFileName l)
+ makeret l k = let bname = keyBackendName k in
+ case maybeLookupBackendName bname of
+ Just backend -> do
+ return $ Just (k, backend)
+ Nothing -> do
+ when (isLinkToAnnex l) $ warning $
+ "skipping " ++ file ++
+ " (unknown backend " ++ bname ++ ")"
+ return Nothing
{- Looks up the backend that should be used for a file.
- That can be configured on a per-file basis in the gitattributes file.
-}
chooseBackend :: FilePath -> Annex (Maybe Backend)
chooseBackend f = Annex.getState Annex.forcebackend >>= go
- where
- go Nothing = maybeLookupBackendName <$>
- checkAttr "annex.backend" f
- go (Just _) = Just . Prelude.head <$> orderedList
+ where
+ go Nothing = maybeLookupBackendName <$> checkAttr "annex.backend" f
+ go (Just _) = Just . Prelude.head <$> orderedList
{- Looks up a backend by name. May fail if unknown. -}
lookupBackendName :: String -> Backend
lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
- where
- unknown = error $ "unknown backend " ++ s
+ where
+ unknown = error $ "unknown backend " ++ s
maybeLookupBackendName :: String -> Maybe Backend
maybeLookupBackendName s = headMaybe matches
- where
- matches = filter (\b -> s == B.name b) list
+ where
+ matches = filter (\b -> s == B.name b) list
diff --git a/Limit.hs b/Limit.hs
index 1980a2df5..e9c99019c 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -54,9 +54,9 @@ getMatcher' = do
{- Adds something to the limit list, which is built up reversed. -}
add :: Utility.Matcher.Token (Annex.FileInfo -> Annex Bool) -> Annex ()
add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
- where
- prepend (Left ls) = Left $ l:ls
- prepend _ = error "internal"
+ where
+ prepend (Left ls) = Left $ l:ls
+ prepend _ = error "internal"
{- Adds a new token. -}
addToken :: String -> Annex ()
@@ -83,9 +83,9 @@ limitExclude glob = Right $ const $ return . not . matchglob glob
matchglob :: String -> Annex.FileInfo -> Bool
matchglob glob (Annex.FileInfo { Annex.matchFile = f }) =
isJust $ match cregex f []
- where
- cregex = compile regex []
- regex = '^':wildToRegex glob
+ where
+ cregex = compile regex []
+ regex = '^':wildToRegex glob
{- Adds a limit to skip files not believed to be present
- in a specfied repository. -}
@@ -97,21 +97,21 @@ limitIn name = Right $ \notpresent -> check $
if name == "."
then inhere notpresent
else inremote notpresent
- where
- check a = lookupFile >=> handle a
- handle _ Nothing = return False
- handle a (Just (key, _)) = a key
- inremote notpresent key = do
- u <- Remote.nameToUUID name
- us <- Remote.keyLocations key
- return $ u `elem` us && u `S.notMember` notpresent
- inhere notpresent key
- | S.null notpresent = inAnnex key
- | otherwise = do
- u <- getUUID
- if u `S.member` notpresent
- then return False
- else inAnnex key
+ where
+ check a = lookupFile >=> handle a
+ handle _ Nothing = return False
+ handle a (Just (key, _)) = a key
+ inremote notpresent key = do
+ u <- Remote.nameToUUID name
+ us <- Remote.keyLocations key
+ return $ u `elem` us && u `S.notMember` notpresent
+ inhere notpresent key
+ | S.null notpresent = inAnnex key
+ | otherwise = do
+ u <- getUUID
+ if u `S.member` notpresent
+ then return False
+ else inAnnex key
{- Limit to content that is currently present on a uuid. -}
limitPresent :: Maybe UUID -> MkLimit
@@ -122,10 +122,10 @@ limitPresent u _ = Right $ const $ check $ \key -> do
else do
us <- Remote.keyLocations key
return $ maybe False (`elem` us) u
- where
- check a = lookupFile >=> handle a
- handle _ Nothing = return False
- handle a (Just (key, _)) = a key
+ where
+ check a = lookupFile >=> handle a
+ handle _ Nothing = return False
+ handle a (Just (key, _)) = a key
{- Adds a limit to skip files not believed to have the specified number
- of copies. -}
@@ -139,18 +139,18 @@ limitCopies want = case split ":" want of
Nothing -> go n $ checkgroup v
[n] -> go n $ const $ return True
_ -> Left "bad value for copies"
- where
- go num good = case readish num of
- Nothing -> Left "bad number for copies"
- Just n -> Right $ \notpresent f ->
- lookupFile f >>= handle n good notpresent
- handle _ _ _ Nothing = return False
- handle n good notpresent (Just (key, _)) = do
- us <- filter (`S.notMember` notpresent)
- <$> (filterM good =<< Remote.keyLocations key)
- return $ length us >= n
- checktrust t u = (== t) <$> lookupTrust u
- checkgroup g u = S.member g <$> lookupGroups u
+ where
+ go num good = case readish num of
+ Nothing -> Left "bad number for copies"
+ Just n -> Right $ \notpresent f ->
+ lookupFile f >>= handle n good notpresent
+ handle _ _ _ Nothing = return False
+ handle n good notpresent (Just (key, _)) = do
+ us <- filter (`S.notMember` notpresent)
+ <$> (filterM good =<< Remote.keyLocations key)
+ return $ length us >= n
+ checktrust t u = (== t) <$> lookupTrust u
+ checkgroup g u = S.member g <$> lookupGroups u
{- Adds a limit to skip files not believed to be present in all
- repositories in the specified group. -}
@@ -163,15 +163,15 @@ limitInAllGroup :: GroupMap -> MkLimit
limitInAllGroup m groupname
| S.null want = Right $ const $ const $ return True
| otherwise = Right $ \notpresent -> lookupFile >=> check notpresent
- where
- want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
- check _ Nothing = return False
- check notpresent (Just (key, _))
- -- optimisation: Check if a wanted uuid is notpresent.
- | not (S.null (S.intersection want notpresent)) = return False
- | otherwise = do
- present <- S.fromList <$> Remote.keyLocations key
- return $ S.null $ want `S.difference` present
+ where
+ want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
+ check _ Nothing = return False
+ check notpresent (Just (key, _))
+ -- optimisation: Check if a wanted uuid is notpresent.
+ | not (S.null (S.intersection want notpresent)) = return False
+ | otherwise = do
+ present <- S.fromList <$> Remote.keyLocations key
+ return $ S.null $ want `S.difference` present
{- Adds a limit to skip files not using a specified key-value backend. -}
addInBackend :: String -> Annex ()
@@ -179,9 +179,9 @@ addInBackend = addLimit . limitInBackend
limitInBackend :: MkLimit
limitInBackend name = Right $ const $ lookupFile >=> check
- where
- wanted = Backend.lookupBackendName name
- check = return . maybe False ((==) wanted . snd)
+ where
+ wanted = Backend.lookupBackendName name
+ check = return . maybe False ((==) wanted . snd)
{- Adds a limit to skip files that are too large or too small -}
addLargerThan :: String -> Annex ()
@@ -194,9 +194,9 @@ limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit
limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ const $ lookupFile >=> check sz
- where
- check _ Nothing = return False
- check sz (Just (key, _)) = return $ keySize key `vs` Just sz
+ where
+ check _ Nothing = return False
+ check sz (Just (key, _)) = return $ keySize key `vs` Just sz
addTimeLimit :: String -> Annex ()
addTimeLimit s = do
diff --git a/Messages.hs b/Messages.hs
index 08a17b25c..f3cd9fc0e 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -65,29 +65,29 @@ showProgress = handle q $
- The action is passed a callback to use to update the meter. -}
metered :: (Maybe MeterUpdate) -> Key -> (MeterUpdate -> Annex a) -> Annex a
metered combinemeterupdate key a = withOutputType $ go (keySize key)
- where
- go (Just size) NormalOutput = do
- progress <- liftIO $ newProgress "" size
- meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
- showOutput
- liftIO $ displayMeter stdout meter
- r <- a $ \n -> liftIO $ do
- incrP progress n
- displayMeter stdout meter
- maybe noop (\m -> m n) combinemeterupdate
- liftIO $ clearMeter stdout meter
- return r
- go _ _ = a (const noop)
+ where
+ go (Just size) NormalOutput = do
+ progress <- liftIO $ newProgress "" size
+ meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
+ showOutput
+ liftIO $ displayMeter stdout meter
+ r <- a $ \n -> liftIO $ do
+ incrP progress n
+ displayMeter stdout meter
+ maybe noop (\m -> m n) combinemeterupdate
+ liftIO $ clearMeter stdout meter
+ return r
+ go _ _ = a (const noop)
showSideAction :: String -> Annex ()
showSideAction m = Annex.getState Annex.output >>= go
- where
- go (MessageState v StartBlock) = do
- p
- Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock }
- go (MessageState _ InBlock) = return ()
- go _ = p
- p = handle q $ putStrLn $ "(" ++ m ++ "...)"
+ where
+ go (MessageState v StartBlock) = do
+ p
+ Annex.changeState $ \s -> s { Annex.output = MessageState v InBlock }
+ go (MessageState _ InBlock) = return ()
+ go _ = p
+ p = handle q $ putStrLn $ "(" ++ m ++ "...)"
showStoringStateAction :: Annex ()
showStoringStateAction = showSideAction "Recording state in git"
@@ -106,8 +106,8 @@ doSideAction' b a = do
o <- Annex.getState Annex.output
set $ o { sideActionBlock = b }
set o `after` a
- where
- set o = Annex.changeState $ \s -> s { Annex.output = o }
+ where
+ set o = Annex.changeState $ \s -> s { Annex.output = o }
showOutput :: Annex ()
showOutput = handle q $
@@ -125,10 +125,10 @@ showEndFail = showEndResult False
showEndResult :: Bool -> Annex ()
showEndResult ok = handle (JSON.end ok) $ putStrLn msg
- where
- msg
- | ok = "ok"
- | otherwise = "failed"
+ where
+ msg
+ | ok = "ok"
+ | otherwise = "failed"
showErr :: (Show a) => a -> Annex ()
showErr e = warning' $ "git-annex: " ++ show e
@@ -153,9 +153,9 @@ maybeShowJSON v = handle (JSON.add v) q
{- Shows a complete JSON value, only when in json mode. -}
showFullJSON :: JSON a => [(String, a)] -> Annex Bool
showFullJSON v = withOutputType $ liftIO . go
- where
- go JSONOutput = JSON.complete v >> return True
- go _ = return False
+ where
+ go JSONOutput = JSON.complete v >> return True
+ go _ = return False
{- Performs an action that outputs nonstandard/customized output, and
- in JSON mode wraps its output in JSON.start and JSON.end, so it's
@@ -184,10 +184,10 @@ setupConsole = do
handle :: IO () -> IO () -> Annex ()
handle json normal = withOutputType go
- where
- go NormalOutput = liftIO normal
- go QuietOutput = q
- go JSONOutput = liftIO $ flushed json
+ where
+ go NormalOutput = liftIO normal
+ go QuietOutput = q
+ go JSONOutput = liftIO $ flushed json
q :: Monad m => m ()
q = noop
diff --git a/Usage.hs b/Usage.hs
index 66fb55690..fc62bf5d2 100644
--- a/Usage.hs
+++ b/Usage.hs
@@ -23,30 +23,30 @@ usage header cmds commonoptions = unlines $
, "Commands:"
, ""
] ++ cmdlines
- where
- -- To get consistent indentation of options, generate the
- -- usage for all options at once. A command's options will
- -- be displayed after the command.
- alloptlines = filter (not . null) $
- lines $ usageInfo "" $
- concatMap cmdoptions scmds ++ commonoptions
- (cmdlines, optlines) = go scmds alloptlines []
- go [] os ls = (ls, os)
- go (c:cs) os ls = go cs os' (ls++(l:o))
- where
- (o, os') = splitAt (length $ cmdoptions c) os
- l = concat
- [ cmdname c
- , namepad (cmdname c)
- , cmdparamdesc c
- , descpad (cmdparamdesc c)
- , cmddesc c
- ]
- pad n s = replicate (n - length s) ' '
- namepad = pad $ longest cmdname + 1
- descpad = pad $ longest cmdparamdesc + 2
- longest f = foldl max 0 $ map (length . f) cmds
- scmds = sort cmds
+ where
+ -- To get consistent indentation of options, generate the
+ -- usage for all options at once. A command's options will
+ -- be displayed after the command.
+ alloptlines = filter (not . null) $
+ lines $ usageInfo "" $
+ concatMap cmdoptions scmds ++ commonoptions
+ (cmdlines, optlines) = go scmds alloptlines []
+ go [] os ls = (ls, os)
+ go (c:cs) os ls = go cs os' (ls++(l:o))
+ where
+ (o, os') = splitAt (length $ cmdoptions c) os
+ l = concat
+ [ cmdname c
+ , namepad (cmdname c)
+ , cmdparamdesc c
+ , descpad (cmdparamdesc c)
+ , cmddesc c
+ ]
+ pad n s = replicate (n - length s) ' '
+ namepad = pad $ longest cmdname + 1
+ descpad = pad $ longest cmdparamdesc + 2
+ longest f = foldl max 0 $ map (length . f) cmds
+ scmds = sort cmds
{- Descriptions of params used in usage messages. -}
paramPaths :: String