diff options
author | 2014-10-22 17:14:38 -0400 | |
---|---|---|
committer | 2014-10-22 17:14:38 -0400 | |
commit | 33e7dd2e0b756270cb51d1ed574cbe4b8173c7cd (patch) | |
tree | 0e9ff04c04c33cd1ba45171983d1b9f4d92cac60 /Utility | |
parent | 2d7b57270e628994483495159d2be715c8f9531b (diff) | |
parent | 49475bb89542e92c6f466425f29cd0640a8e80f4 (diff) |
Merge branch 'master' into s3-aws
Conflicts:
Remote/S3.hs
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Batch.hs | 2 | ||||
-rw-r--r-- | Utility/CoProcess.hs | 4 | ||||
-rw-r--r-- | Utility/CopyFile.hs | 4 | ||||
-rw-r--r-- | Utility/Daemon.hs | 2 | ||||
-rw-r--r-- | Utility/DataUnits.hs | 2 | ||||
-rw-r--r-- | Utility/Directory.hs | 4 | ||||
-rw-r--r-- | Utility/Env.hs | 29 | ||||
-rw-r--r-- | Utility/ExternalSHA.hs | 2 | ||||
-rw-r--r-- | Utility/FileSystemEncoding.hs | 2 | ||||
-rw-r--r-- | Utility/Format.hs | 2 | ||||
-rw-r--r-- | Utility/Gpg.hs | 8 | ||||
-rw-r--r-- | Utility/HumanTime.hs | 6 | ||||
-rw-r--r-- | Utility/InodeCache.hs | 2 | ||||
-rw-r--r-- | Utility/Lsof.hs | 2 | ||||
-rw-r--r-- | Utility/Matcher.hs | 4 | ||||
-rw-r--r-- | Utility/Path.hs | 8 | ||||
-rw-r--r-- | Utility/Quvi.hs | 2 | ||||
-rw-r--r-- | Utility/Rsync.hs | 2 | ||||
-rw-r--r-- | Utility/SRV.hs | 2 | ||||
-rw-r--r-- | Utility/Scheduled.hs | 26 | ||||
-rw-r--r-- | Utility/SshConfig.hs | 6 | ||||
-rw-r--r-- | Utility/TList.hs | 2 | ||||
-rw-r--r-- | Utility/WebApp.hs | 2 | ||||
-rw-r--r-- | Utility/Yesod.hs | 4 |
24 files changed, 67 insertions, 62 deletions
diff --git a/Utility/Batch.hs b/Utility/Batch.hs index d6dadae67..ff81318fb 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -32,7 +32,7 @@ batch :: IO a -> IO a #if defined(linux_HOST_OS) || defined(__ANDROID__) batch a = wait =<< batchthread where - batchthread = asyncBound $ do + batchthread = asyncBound $ do setProcessPriority 0 maxNice a #else diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs index 332c09d49..97826ec1e 100644 --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -65,7 +65,7 @@ query ch send receive = do restartable s (receive $ coProcessFrom s) return where - restartable s a cont + restartable s a cont | coProcessNumRestarts (coProcessSpec s) > 0 = maybe restart cont =<< catchMaybeIO a | otherwise = cont =<< a @@ -87,7 +87,7 @@ rawMode ch = do raw $ coProcessTo s return ch where - raw h = do + raw h = do fileEncoding h #ifdef mingw32_HOST_OS hSetNewlineMode h noNewlineTranslation diff --git a/Utility/CopyFile.hs b/Utility/CopyFile.hs index 6601d0a80..503ab842a 100644 --- a/Utility/CopyFile.hs +++ b/Utility/CopyFile.hs @@ -47,10 +47,10 @@ createLinkOrCopy :: FilePath -> FilePath -> IO Bool #ifndef mingw32_HOST_OS createLinkOrCopy src dest = go `catchIO` const fallback where - go = do + go = do createLink src dest return True - fallback = copyFileExternal CopyAllMetaData src dest + fallback = copyFileExternal CopyAllMetaData src dest #else createLinkOrCopy = copyFileExternal CopyAllMetaData #endif diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs index 2f0f84179..0615149e5 100644 --- a/Utility/Daemon.hs +++ b/Utility/Daemon.hs @@ -175,7 +175,7 @@ winLockFile pid pidfile = do cleanstale return $ prefix ++ show pid ++ suffix where - prefix = pidfile ++ "." + prefix = pidfile ++ "." suffix = ".lck" cleanstale = mapM_ (void . tryIO . removeFile) =<< (filter iswinlockfile <$> dirContents (parentDir pidfile)) diff --git a/Utility/DataUnits.hs b/Utility/DataUnits.hs index 7575af21f..e035b2f86 100644 --- a/Utility/DataUnits.hs +++ b/Utility/DataUnits.hs @@ -120,7 +120,7 @@ roughSize units short i showUnit x (Unit size abbrev name) = s ++ " " ++ unit where - v = (fromInteger x :: Double) / fromInteger size + v = (fromInteger x :: Double) / fromInteger size s = showImprecise 2 v unit | short = abbrev diff --git a/Utility/Directory.hs b/Utility/Directory.hs index a4429d5b9..e4e4b80a7 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -56,7 +56,7 @@ dirContentsRecursive = dirContentsRecursiveSkipping (const False) True dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath] dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir] where - go [] = return [] + go [] = return [] go (dir:dirs) | skipdir (takeFileName dir) = go dirs | otherwise = unsafeInterleaveIO $ do @@ -87,7 +87,7 @@ dirContentsRecursiveSkipping skipdir followsubdirsymlinks topdir = go [topdir] dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath] dirTreeRecursiveSkipping skipdir topdir = go [] [topdir] where - go c [] = return c + go c [] = return c go c (dir:dirs) | skipdir (takeFileName dir) = go c dirs | otherwise = unsafeInterleaveIO $ do diff --git a/Utility/Env.hs b/Utility/Env.hs index 6763c24e1..ff6644fbf 100644 --- a/Utility/Env.hs +++ b/Utility/Env.hs @@ -14,6 +14,7 @@ import Utility.Exception import Control.Applicative import Data.Maybe import qualified System.Environment as E +import qualified System.SetEnv #else import qualified System.Posix.Env as PE #endif @@ -39,27 +40,27 @@ getEnvironment = PE.getEnvironment getEnvironment = E.getEnvironment #endif -{- Returns True if it could successfully set the environment variable. +{- Sets an environment variable. To overwrite an existing variable, + - overwrite must be True. - - - There is, apparently, no way to do this in Windows. Instead, - - environment varuables must be provided when running a new process. -} -setEnv :: String -> String -> Bool -> IO Bool + - On Windows, setting a variable to "" unsets it. -} +setEnv :: String -> String -> Bool -> IO () #ifndef mingw32_HOST_OS -setEnv var val overwrite = do - PE.setEnv var val overwrite - return True +setEnv var val overwrite = PE.setEnv var val overwrite #else -setEnv _ _ _ = return False +setEnv var val True = System.SetEnv.setEnv var val +setEnv var val False = do + r <- getEnv var + case r of + Nothing -> setEnv var val True + Just _ -> return () #endif -{- Returns True if it could successfully unset the environment variable. -} -unsetEnv :: String -> IO Bool +unsetEnv :: String -> IO () #ifndef mingw32_HOST_OS -unsetEnv var = do - PE.unsetEnv var - return True +unsetEnv = PE.unsetEnv #else -unsetEnv _ = return False +unsetEnv = System.SetEnv.unsetEnv #endif {- Adds the environment variable to the input environment. If already diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs index 595acd8cf..858d04e6a 100644 --- a/Utility/ExternalSHA.hs +++ b/Utility/ExternalSHA.hs @@ -57,7 +57,7 @@ externalSHA command shasize file = do Left $ "Unexpected character in output of " ++ command ++ "\"" ++ sha ++ "\"" | otherwise = Right sha' where - sha' = map toLower sha + sha' = map toLower sha expectedSHALength :: Int -> Int expectedSHALength 1 = 40 diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index b81fdc532..fa4b39aa3 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -111,7 +111,7 @@ truncateFilePath :: Int -> FilePath -> FilePath #ifndef mingw32_HOST_OS truncateFilePath n = go . reverse where - go f = + go f = let bytes = decodeW8 f in if length bytes <= n then reverse f diff --git a/Utility/Format.hs b/Utility/Format.hs index 2a5ae5c34..78620f9b9 100644 --- a/Utility/Format.hs +++ b/Utility/Format.hs @@ -117,7 +117,7 @@ decode_c s = unescape ("", s) handle (x:'x':n1:n2:rest) | isescape x && allhex = (fromhex, rest) where - allhex = isHexDigit n1 && isHexDigit n2 + allhex = isHexDigit n1 && isHexDigit n2 fromhex = [chr $ readhex [n1, n2]] readhex h = Prelude.read $ "0x" ++ h :: Int handle (x:n1:n2:n3:rest) diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index f9b60f276..50f78a1de 100644 --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -166,7 +166,7 @@ secretKeys :: IO (M.Map KeyId UserId) secretKeys = catchDefaultIO M.empty makemap where makemap = M.fromList . parse . lines <$> readStrict params - params = [Params "--with-colons --list-secret-keys --fixed-list-mode"] + params = [Params "--with-colons --list-secret-keys --fixed-list-mode"] parse = extract [] Nothing . map (split ":") extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) = extract ((keyid, decode_c userid):c) Nothing rest @@ -196,7 +196,7 @@ genSecretKey keytype passphrase userid keysize = withHandle StdinHandle createProcessSuccess (proc gpgcmd params) feeder where params = ["--batch", "--gen-key"] - feeder h = do + feeder h = do hPutStr h $ unlines $ catMaybes [ Just $ "Key-Type: " ++ case keytype of @@ -232,7 +232,7 @@ genRandom highQuality size = checksize <$> readStrict randomquality :: Int randomquality = if highQuality then 2 else 1 - {- The size is the number of bytes of entropy desired; the data is + {- The size is the number of bytes of entropy desired; the data is - base64 encoded, so needs 8 bits to represent every 6 bytes of - entropy. -} expectedlength = size * 8 `div` 6 @@ -334,7 +334,7 @@ testHarness a = do setup = do base <- getTemporaryDirectory dir <- mktmpdir $ base </> "gpgtmpXXXXXX" - void $ setEnv var dir True + setEnv var dir True -- For some reason, recent gpg needs a trustdb to be set up. _ <- pipeStrict [Params "--trust-model auto --update-trustdb"] [] _ <- pipeStrict [Params "--import -q"] $ unlines diff --git a/Utility/HumanTime.hs b/Utility/HumanTime.hs index 2aef1b09c..3c23f31f7 100644 --- a/Utility/HumanTime.hs +++ b/Utility/HumanTime.hs @@ -27,7 +27,7 @@ import Control.Applicative import qualified Data.Map as M newtype Duration = Duration { durationSeconds :: Integer } - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show) durationSince :: UTCTime -> IO Duration durationSince pasttime = do @@ -47,8 +47,8 @@ daysToDuration i = Duration $ i * dsecs parseDuration :: String -> Maybe Duration parseDuration = Duration <$$> go 0 where - go n [] = return n - go n s = do + go n [] = return n + go n s = do num <- readish s :: Maybe Integer case dropWhile isDigit s of (c:rest) -> do diff --git a/Utility/InodeCache.hs b/Utility/InodeCache.hs index 91359457a..328b77595 100644 --- a/Utility/InodeCache.hs +++ b/Utility/InodeCache.hs @@ -182,7 +182,7 @@ checkSentinalFile s = do SentinalStatus (not unchanged) tsdelta where #ifdef mingw32_HOST_OS - unchanged = oldinode == newinode && oldsize == newsize + unchanged = oldinode == newinode && oldsize == newsize tsdelta = TSDelta $ do -- Run when generating an InodeCache, -- to get the current delta. diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index ee4036b16..e44d13197 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -32,7 +32,7 @@ setup = do when (isAbsolute cmd) $ do path <- getSearchPath let path' = takeDirectory cmd : path - void $ setEnv "PATH" (intercalate [searchPathSeparator] path') True + setEnv "PATH" (intercalate [searchPathSeparator] path') True {- Checks each of the files in a directory to find open files. - Note that this will find hard links to files elsewhere that are open. -} diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs index 76f8903f5..3356bdd07 100644 --- a/Utility/Matcher.hs +++ b/Utility/Matcher.hs @@ -90,7 +90,7 @@ tokenGroups :: [Token op] -> [TokenGroup op] tokenGroups [] = [] tokenGroups (t:ts) = go t where - go Open = + go Open = let (gr, rest) = findClose ts in gr : tokenGroups rest go Close = tokenGroups ts -- not picky about missing Close @@ -101,7 +101,7 @@ findClose l = let (g, rest) = go [] l in (Group (reverse g), rest) where - go c [] = (c, []) -- not picky about extra Close + go c [] = (c, []) -- not picky about extra Close go c (t:ts) = dispatch t where dispatch Close = (c, ts) diff --git a/Utility/Path.hs b/Utility/Path.hs index 99c9438bf..9035cbc49 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -235,11 +235,11 @@ toCygPath p | null drive = recombine parts | otherwise = recombine $ "/cygdrive" : driveletter drive : parts where - (drive, p') = splitDrive p + (drive, p') = splitDrive p parts = splitDirectories p' - driveletter = map toLower . takeWhile (/= ':') + driveletter = map toLower . takeWhile (/= ':') recombine = fixtrailing . Posix.joinPath - fixtrailing s + fixtrailing s | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s | otherwise = s #endif @@ -272,7 +272,7 @@ fileNameLengthLimit dir = do sanitizeFilePath :: String -> FilePath sanitizeFilePath = map sanitize where - sanitize c + sanitize c | c == '.' = c | isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_' | otherwise = c diff --git a/Utility/Quvi.hs b/Utility/Quvi.hs index 228ff7809..cf3a23cfd 100644 --- a/Utility/Quvi.hs +++ b/Utility/Quvi.hs @@ -113,7 +113,7 @@ supported Quvi04 url = boolSystem "quvi" supported Quvi09 url = (firstlevel <&&> secondlevel) `catchNonAsync` (\_ -> return False) where - firstlevel = case uriAuthority =<< parseURIRelaxed url of + firstlevel = case uriAuthority =<< parseURIRelaxed url of Nothing -> return False Just auth -> do let domain = map toLower $ uriRegName auth diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index d0a89b2b0..8dee6093c 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -57,7 +57,7 @@ rsync = boolSystem "rsync" . rsyncParamsFixup rsyncParamsFixup :: [CommandParam] -> [CommandParam] rsyncParamsFixup = map fixup where - fixup (File f) = File (toCygPath f) + fixup (File f) = File (toCygPath f) fixup p = p {- Runs rsync, but intercepts its progress output and updates a meter. diff --git a/Utility/SRV.hs b/Utility/SRV.hs index f1671758e..1b86aeb76 100644 --- a/Utility/SRV.hs +++ b/Utility/SRV.hs @@ -74,7 +74,7 @@ lookupSRV (SRV srv) = do maybe [] use r #endif where - use = orderHosts . map tohosts + use = orderHosts . map tohosts tohosts (priority, weight, port, hostname) = ( (priority, weight) , (B8.toString hostname, PortNumber $ fromIntegral port) diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs index 305410c54..4fa3a29f1 100644 --- a/Utility/Scheduled.hs +++ b/Utility/Scheduled.hs @@ -44,7 +44,7 @@ import Data.Char {- Some sort of scheduled event. -} data Schedule = Schedule Recurrance ScheduledTime - deriving (Eq, Read, Show, Ord) + deriving (Eq, Read, Show, Ord) data Recurrance = Daily @@ -54,7 +54,7 @@ data Recurrance | Divisible Int Recurrance -- ^ Days, Weeks, or Months of the year evenly divisible by a number. -- (Divisible Year is years evenly divisible by a number.) - deriving (Eq, Read, Show, Ord) + deriving (Eq, Read, Show, Ord) type WeekDay = Int type MonthDay = Int @@ -63,7 +63,7 @@ type YearDay = Int data ScheduledTime = AnyTime | SpecificTime Hour Minute - deriving (Eq, Read, Show, Ord) + deriving (Eq, Read, Show, Ord) type Hour = Int type Minute = Int @@ -73,7 +73,7 @@ type Minute = Int data NextTime = NextTimeExactly LocalTime | NextTimeWindow LocalTime LocalTime - deriving (Eq, Read, Show) + deriving (Eq, Read, Show) startTime :: NextTime -> LocalTime startTime (NextTimeExactly t) = t @@ -96,9 +96,9 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime NextTimeExactly t -> window (localDay t) (localDay t) | otherwise = NextTimeExactly . startTime <$> findfromtoday False where - findfromtoday anytime = findfrom recurrance afterday today + findfromtoday anytime = findfrom recurrance afterday today where - today = localDay currenttime + today = localDay currenttime afterday = sameaslastrun || toolatetoday toolatetoday = not anytime && localTimeOfDay currenttime >= nexttime sameaslastrun = lastrun == Just today @@ -163,8 +163,8 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime Divisible n r'@(Yearly _) -> handlediv n r' ynum Nothing Divisible _ r'@(Divisible _ _) -> findfrom r' afterday candidate where - skip n = findfrom r False (addDays n candidate) - handlediv n r' getval mmax + skip n = findfrom r False (addDays n candidate) + handlediv n r' getval mmax | n > 0 && maybe True (n <=) mmax = findfromwhere r' (divisible n . getval) afterday candidate | otherwise = Nothing @@ -267,7 +267,7 @@ toRecurrance s = case words s of constructor u | "s" `isSuffixOf` u = constructor $ reverse $ drop 1 $ reverse u | otherwise = Nothing - withday sd u = do + withday sd u = do c <- constructor u d <- readish sd Just $ c (Just d) @@ -285,7 +285,7 @@ fromScheduledTime AnyTime = "any time" fromScheduledTime (SpecificTime h m) = show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm where - pad n s = take (n - length s) (repeat '0') ++ s + pad n s = take (n - length s) (repeat '0') ++ s (h', ampm) | h == 0 = (12, "AM") | h < 12 = (h, "AM") @@ -304,10 +304,10 @@ toScheduledTime v = case words v of (s:[]) -> go s id _ -> Nothing where - h0 h + h0 h | h == 12 = 0 | otherwise = h - go :: String -> (Int -> Int) -> Maybe ScheduledTime + go :: String -> (Int -> Int) -> Maybe ScheduledTime go s adjust = let (h, m) = separate (== ':') s in SpecificTime @@ -363,7 +363,7 @@ instance Arbitrary Recurrance where ] ] where - arbday = oneof + arbday = oneof [ Just <$> nonNegative arbitrary , pure Nothing ] diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs index 529e5c990..e45d09acd 100644 --- a/Utility/SshConfig.hs +++ b/Utility/SshConfig.hs @@ -56,7 +56,7 @@ parseSshConfig = go [] . lines | iscomment l = hoststanza host c ((Left $ mkcomment l):hc) ls | otherwise = case splitline l of (indent, k, v) - | isHost k -> hoststanza v + | isHost k -> hoststanza v (HostConfig host (reverse hc):c) [] ls | otherwise -> hoststanza host c ((Right $ SshSetting indent k v):hc) ls @@ -87,7 +87,7 @@ genSshConfig = unlines . concatMap gen findHostConfigKey :: SshConfig -> Key -> Maybe Value findHostConfigKey (HostConfig _ cs) wantk = go (rights cs) (map toLower wantk) where - go [] _ = Nothing + go [] _ = Nothing go ((SshSetting _ k v):rest) wantk' | map toLower k == wantk' = Just v | otherwise = go rest wantk' @@ -98,7 +98,7 @@ addToHostConfig :: SshConfig -> Key -> Value -> SshConfig addToHostConfig (HostConfig host cs) k v = HostConfig host $ Right (SshSetting indent k v) : cs where - {- The indent is taken from any existing SshSetting + {- The indent is taken from any existing SshSetting - in the HostConfig (largest indent wins). -} indent = fromMaybe "\t" $ headMaybe $ reverse $ sortBy (comparing length) $ map getindent cs diff --git a/Utility/TList.hs b/Utility/TList.hs index 4b91b767f..5532cdce5 100644 --- a/Utility/TList.hs +++ b/Utility/TList.hs @@ -57,7 +57,7 @@ modifyTList tlist a = do unless (emptyDList dl') $ putTMVar tlist dl' where - emptyDList = D.list True (\_ _ -> False) + emptyDList = D.list True (\_ _ -> False) consTList :: TList a -> a -> STM () consTList tlist v = modifyTList tlist $ \dl -> D.cons v dl diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs index 6bcfce919..6c42e103b 100644 --- a/Utility/WebApp.hs +++ b/Utility/WebApp.hs @@ -117,7 +117,7 @@ getSocket h = do when (isJust h) $ error "getSocket with HostName not supported on this OS" addr <- inet_addr "127.0.0.1" - sock <- socket AF_INET Stream defaultProtocol + sock <- socket AF_INET Stream defaultProtocol preparesocket sock bindSocket sock (SockAddrInet aNY_PORT addr) use sock diff --git a/Utility/Yesod.hs b/Utility/Yesod.hs index 6d38ba4ed..afe10a111 100644 --- a/Utility/Yesod.hs +++ b/Utility/Yesod.hs @@ -28,7 +28,11 @@ import Yesod as Y #else import Yesod as Y hiding (Html) #endif +#if MIN_VERSION_yesod_form(1,3,8) +import Yesod.Form.Bootstrap3 as Y hiding (bfs) +#else import Assistant.WebApp.Bootstrap3 as Y hiding (bfs) +#endif #ifndef __NO_TH__ import Yesod.Default.Util import Language.Haskell.TH.Syntax (Q, Exp) |