This commit is contained in:
Joey Hess 2014-04-26 19:25:05 -04:00
parent f5b1c3841e
commit 72ec0ab736
12 changed files with 18 additions and 17 deletions

View file

@ -62,7 +62,7 @@ query ch send receive = do
s <- readMVar ch s <- readMVar ch
restartable s (send $ coProcessTo s) $ const $ restartable s (send $ coProcessTo s) $ const $
restartable s (hFlush $ coProcessTo s) $ const $ restartable s (hFlush $ coProcessTo s) $ const $
restartable s (receive $ coProcessFrom s) $ restartable s (receive $ coProcessFrom s)
return return
where where
restartable s a cont restartable s a cont

View file

@ -9,6 +9,7 @@
module Utility.DBus where module Utility.DBus where
import Utility.PartialPrelude
import Utility.Exception import Utility.Exception
import DBus.Client import DBus.Client
@ -22,7 +23,7 @@ type ServiceName = String
listServiceNames :: Client -> IO [ServiceName] listServiceNames :: Client -> IO [ServiceName]
listServiceNames client = do listServiceNames client = do
reply <- callDBus client "ListNames" [] reply <- callDBus client "ListNames" []
return $ fromMaybe [] $ fromVariant (methodReturnBody reply !! 0) return $ fromMaybe [] $ fromVariant =<< headMaybe (methodReturnBody reply)
callDBus :: Client -> MemberName -> [Variant] -> IO MethodReturn callDBus :: Client -> MemberName -> [Variant] -> IO MethodReturn
callDBus client name params = call_ client $ callDBus client name params = call_ client $

View file

@ -36,7 +36,7 @@ daemonize logfd pidfile changedirectory a = do
_ <- forkProcess child1 _ <- forkProcess child1
out out
where where
checkalreadyrunning f = maybe noop (const $ alreadyRunning) checkalreadyrunning f = maybe noop (const alreadyRunning)
=<< checkDaemon f =<< checkDaemon f
child1 = do child1 = do
_ <- createSession _ <- createSession

View file

@ -111,7 +111,7 @@ roughSize units short i
| i < 0 = '-' : findUnit units' (negate i) | i < 0 = '-' : findUnit units' (negate i)
| otherwise = findUnit units' i | otherwise = findUnit units' i
where where
units' = reverse $ sort units -- largest first units' = sortBy (flip compare) units -- largest first
findUnit (u@(Unit s _ _):us) i' findUnit (u@(Unit s _ _):us) i'
| i' >= s = showUnit i' u | i' >= s = showUnit i' u

View file

@ -43,7 +43,7 @@ dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
- When the directory does not exist, no exception is thrown, - When the directory does not exist, no exception is thrown,
- instead, [] is returned. -} - instead, [] is returned. -}
dirContentsRecursive :: FilePath -> IO [FilePath] dirContentsRecursive :: FilePath -> IO [FilePath]
dirContentsRecursive topdir = dirContentsRecursiveSkipping (const False) True topdir dirContentsRecursive = dirContentsRecursiveSkipping (const False) True
{- Skips directories whose basenames match the skipdir. -} {- Skips directories whose basenames match the skipdir. -}
dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath] dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]

View file

@ -18,7 +18,7 @@ import Utility.Data
{- Catches IO errors and returns a Bool -} {- Catches IO errors and returns a Bool -}
catchBoolIO :: IO Bool -> IO Bool catchBoolIO :: IO Bool -> IO Bool
catchBoolIO a = catchDefaultIO False a catchBoolIO = catchDefaultIO False
{- Catches IO errors and returns a Maybe -} {- Catches IO errors and returns a Maybe -}
catchMaybeIO :: IO a -> IO (Maybe a) catchMaybeIO :: IO a -> IO (Maybe a)

View file

@ -145,7 +145,7 @@ findPubKeys :: String -> IO KeyIds
findPubKeys for = KeyIds . parse . lines <$> readStrict params findPubKeys for = KeyIds . parse . lines <$> readStrict params
where where
params = [Params "--with-colons --list-public-keys", Param for] params = [Params "--with-colons --list-public-keys", Param for]
parse = catMaybes . map (keyIdField . split ":") parse = mapMaybe (keyIdField . split ":")
keyIdField ("pub":_:_:_:f:_) = Just f keyIdField ("pub":_:_:_:f:_) = Just f
keyIdField _ = Nothing keyIdField _ = Nothing
@ -195,7 +195,7 @@ genSecretKey keytype passphrase userid keysize =
Algo n -> show n Algo n -> show n
, Just $ "Key-Length: " ++ show keysize , Just $ "Key-Length: " ++ show keysize
, Just $ "Name-Real: " ++ userid , Just $ "Name-Real: " ++ userid
, Just $ "Expire-Date: 0" , Just "Expire-Date: 0"
, if null passphrase , if null passphrase
then Nothing then Nothing
else Just $ "Passphrase: " ++ passphrase else Just $ "Passphrase: " ++ passphrase

View file

@ -17,5 +17,5 @@ showImprecise precision n
int :: Integer int :: Integer
(int, frac) = properFraction n (int, frac) = properFraction n
remainder = round (frac * 10 ^ precision) :: Integer remainder = round (frac * 10 ^ precision) :: Integer
pad0s s = (take (precision - length s) (repeat '0')) ++ s pad0s s = replicate (precision - length s) '0' ++ s
striptrailing0s = reverse . dropWhile (== '0') . reverse striptrailing0s = reverse . dropWhile (== '0') . reverse

View file

@ -59,7 +59,7 @@ parseDuration = Duration <$$> go 0
fromDuration :: Duration -> String fromDuration :: Duration -> String
fromDuration Duration { durationSeconds = d } fromDuration Duration { durationSeconds = d }
| d == 0 = "0s" | d == 0 = "0s"
| otherwise = concat $ map showunit $ go [] units d | otherwise = concatMap showunit $ go [] units d
where where
showunit (u, n) showunit (u, n)
| n > 0 = show n ++ [u] | n > 0 = show n ++ [u]

View file

@ -49,7 +49,7 @@ inTop top f = top ++ f
- link to. Note that some of the libraries may not exist - link to. Note that some of the libraries may not exist
- (eg, linux-vdso.so) -} - (eg, linux-vdso.so) -}
parseLdd :: String -> [FilePath] parseLdd :: String -> [FilePath]
parseLdd = catMaybes . map (getlib . dropWhile isSpace) . lines parseLdd = mapMaybe (getlib . dropWhile isSpace) . lines
where where
getlib l = headMaybe . words =<< lastMaybe (split " => " l) getlib l = headMaybe . words =<< lastMaybe (split " => " l)

View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE BangPatterns, CPP #-} {-# LANGUAGE CPP #-}
module Utility.Lsof where module Utility.Lsof where
@ -110,7 +110,7 @@ parseFormatted s = bundle $ go [] $ lines s
{- Parses lsof's default output format. -} {- Parses lsof's default output format. -}
parseDefault :: LsofParser parseDefault :: LsofParser
parseDefault = catMaybes . map parseline . drop 1 . lines parseDefault = mapMaybe parseline . drop 1 . lines
where where
parseline l = case words l of parseline l = case words l of
(command : spid : _user : _fd : _type : _device : _size : _node : rest) -> (command : spid : _user : _fd : _type : _device : _size : _node : rest) ->

View file

@ -64,10 +64,10 @@ generate = simplify . process MAny . tokenGroups
process m [] = m process m [] = m
process m ts = uncurry process $ consume m ts process m ts = uncurry process $ consume m ts
consume m ((One And):rest) = term (m `MAnd`) rest consume m (One And:rest) = term (m `MAnd`) rest
consume m ((One Or):rest) = term (m `MOr`) rest consume m (One Or:rest) = term (m `MOr`) rest
consume m ((One Not):rest) = term (\p -> m `MAnd` (MNot p)) rest consume m (One Not:rest) = term (\p -> m `MAnd` (MNot p)) rest
consume m ((One (Operation o)):rest) = (m `MAnd` MOp o, rest) consume m (One (Operation o):rest) = (m `MAnd` MOp o, rest)
consume m (Group g:rest) = (process m g, rest) consume m (Group g:rest) = (process m g, rest)
consume m (_:rest) = consume m rest consume m (_:rest) = consume m rest
consume m [] = (m, []) consume m [] = (m, [])