{-
-Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
, exitUnless
, rStripSpace
, newUUID
+ , getCurrentTime
+ , getCurrentTimeUSec
+ , clockTimeToString
+ , chompPrefix
+ , wrap
+ , trim
+ , defaultHead
+ , exitIfEmpty
+ , splitEithers
+ , recombineEithers
) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
import Data.Function (on)
import Data.List
+import Control.Monad (foldM)
import Debug.Trace
import qualified Ganeti.Constants as C
import System.IO
import System.Exit
+import System.Time
-- * Debug functions
-}
niceSort :: [String] -> [String]
-niceSort = map snd . sort . map (\s -> (fst $ extractKey [] s, s))
+niceSort = niceSortKey id
-- | Key-version of 'niceSort'. We use 'sortBy' and @compare `on` fst@
-- since we don't want to add an ordering constraint on the /a/ type,
newUUID = do
contents <- readFile C.randomUuidFile
return $! rStripSpace $ take 128 contents
+
+-- | Returns the current time as an 'Integer' representing the number
+-- of seconds from the Unix epoch.
+getCurrentTime :: IO Integer
+getCurrentTime = do
+ TOD ctime _ <- getClockTime
+ return ctime
+
+-- | Returns the current time as an 'Integer' representing the number
+-- of microseconds from the Unix epoch (hence the need for 'Integer').
+getCurrentTimeUSec :: IO Integer
+getCurrentTimeUSec = do
+ TOD ctime pico <- getClockTime
+ -- pico: 10^-12, micro: 10^-6, so we have to shift seconds left and
+ -- picoseconds right
+ return $ ctime * 1000000 + pico `div` 1000000
+
+-- | Convert a ClockTime into a (seconds-only) timestamp.
+clockTimeToString :: ClockTime -> String
+clockTimeToString (TOD t _) = show t
+
+{-| Strip a prefix from a string, allowing the last character of the prefix
+(which is assumed to be a separator) to be absent from the string if the string
+terminates there.
+
+\>>> chompPrefix \"foo:bar:\" \"a:b:c\"
+Nothing
+
+\>>> chompPrefix \"foo:bar:\" \"foo:bar:baz\"
+Just \"baz\"
+
+\>>> chompPrefix \"foo:bar:\" \"foo:bar:\"
+Just \"\"
+
+\>>> chompPrefix \"foo:bar:\" \"foo:bar\"
+Just \"\"
+
+\>>> chompPrefix \"foo:bar:\" \"foo:barbaz\"
+Nothing
+-}
+chompPrefix :: String -> String -> Maybe String
+chompPrefix pfx str =
+ if pfx `isPrefixOf` str || str == init pfx
+ then Just $ drop (length pfx) str
+ else Nothing
+
+-- | Breaks a string in lines with length \<= maxWidth.
+--
+-- NOTE: The split is OK if:
+--
+-- * It doesn't break a word, i.e. the next line begins with space
+-- (@isSpace . head $ rest@) or the current line ends with space
+-- (@null revExtra@);
+--
+-- * It breaks a very big word that doesn't fit anyway (@null revLine@).
+wrap :: Int -- ^ maxWidth
+ -> String -- ^ string that needs wrapping
+ -> [String] -- ^ string \"broken\" in lines
+wrap maxWidth = filter (not . null) . map trim . wrap0
+ where wrap0 :: String -> [String]
+ wrap0 text
+ | length text <= maxWidth = [text]
+ | isSplitOK = line : wrap0 rest
+ | otherwise = line' : wrap0 rest'
+ where (line, rest) = splitAt maxWidth text
+ (revExtra, revLine) = break isSpace . reverse $ line
+ (line', rest') = (reverse revLine, reverse revExtra ++ rest)
+ isSplitOK =
+ null revLine || null revExtra || startsWithSpace rest
+ startsWithSpace (x:_) = isSpace x
+ startsWithSpace _ = False
+
+-- | Removes surrounding whitespace. Should only be used in small
+-- strings.
+trim :: String -> String
+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+-- | A safer head version, with a default value.
+defaultHead :: a -> [a] -> a
+defaultHead def [] = def
+defaultHead _ (x:_) = x
+
+-- | A 'head' version in the I/O monad, for validating parameters
+-- without which we cannot continue.
+exitIfEmpty :: String -> [a] -> IO a
+exitIfEmpty _ (x:_) = return x
+exitIfEmpty s [] = exitErr s
+
+-- | Split an 'Either' list into two separate lists (containing the
+-- 'Left' and 'Right' elements, plus a \"trail\" list that allows
+-- recombination later.
+--
+-- This is splitter; for recombination, look at 'recombineEithers'.
+-- The sum of \"left\" and \"right\" lists should be equal to the
+-- original list length, and the trail list should be the same length
+-- as well. The entries in the resulting lists are reversed in
+-- comparison with the original list.
+splitEithers :: [Either a b] -> ([a], [b], [Bool])
+splitEithers = foldl' splitter ([], [], [])
+ where splitter (l, r, t) e =
+ case e of
+ Left v -> (v:l, r, False:t)
+ Right v -> (l, v:r, True:t)
+
+-- | Recombines two \"left\" and \"right\" lists using a \"trail\"
+-- list into a single 'Either' list.
+--
+-- This is the counterpart to 'splitEithers'. It does the opposite
+-- transformation, and the output list will be the reverse of the
+-- input lists. Since 'splitEithers' also reverses the lists, calling
+-- these together will result in the original list.
+--
+-- Mismatches in the structure of the lists (e.g. inconsistent
+-- lengths) are represented via 'Bad'; normally this function should
+-- not fail, if lists are passed as generated by 'splitEithers'.
+recombineEithers :: (Show a, Show b) =>
+ [a] -> [b] -> [Bool] -> Result [Either a b]
+recombineEithers lefts rights trail =
+ foldM recombiner ([], lefts, rights) trail >>= checker
+ where checker (eithers, [], []) = Ok eithers
+ checker (_, lefts', rights') =
+ Bad $ "Inconsistent results after recombination, l'=" ++
+ show lefts' ++ ", r'=" ++ show rights'
+ recombiner (es, l:ls, rs) False = Ok (Left l:es, ls, rs)
+ recombiner (es, ls, r:rs) True = Ok (Right r:es, ls, rs)
+ recombiner (_, ls, rs) t = Bad $ "Inconsistent trail log: l=" ++
+ show ls ++ ", r=" ++ show rs ++ ",t=" ++
+ show t
projects / ganeti-local / blobdiff