Utils.hs revision 4072adb8c5d2c86123e8e1c1918263968f187829
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiModule : $Header$
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiDescription : utility functions that can't be found in the libraries
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiCopyright : (c) Klaus Luettich, Uni Bremen 2002-2006
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiLicense : GPLv2 or higher, see LICENSE.txt
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiMaintainer : Christian.Maeder@dfki.de
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiStability : provisional
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiPortability : portable
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiUtility functions that can't be found in the libraries
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski but should be shared across Hets.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskimodule Common.Utils
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski ( isSingleton
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , replace
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , hasMany
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , number
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , combine
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , trim
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , trimLeft
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , trimRight
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , nubOrd
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , nubOrdOn
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , atMaybe
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , readMaybe
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , mapAccumLM
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , mapAccumLCM
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , composeMap
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , keepMins
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , splitOn
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , splitBy
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , splitByList
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , numberSuffix
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , basename
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , dirname
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , fileparse
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , stripDir
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , stripSuffix
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , makeRelativeDesc
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , getEnvSave
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , getEnvDef
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , filterMapWithList
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , timeoutSecs
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , timeoutCommand
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , withinDirectory
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , writeTempFile
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , getTempFile
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , verbMsg
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , verbMsgLn
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , verbMsgIO
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski , verbMsgIOLn
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski ) where
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport Data.Char
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport Data.List
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport Data.Maybe
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport qualified Data.Map as Map
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport qualified Data.Set as Set
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.Directory
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.Environment
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.Exit
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.FilePath (joinPath, makeRelative, equalFilePath, takeDirectory)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.IO
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.Process
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport System.Timeout
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiimport Control.Monad
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | Writes the message to the given handle unless the verbosity is less than
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskithe message level. -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsg :: Handle -- ^ Output handle
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> Int -- ^ global verbosity
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> Int -- ^ message level
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> String -- ^ message level
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO ()
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsg hdl v lvl = when (lvl <= v) . hPutStr hdl
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | Same as 'verbMsg' but with a newline at the end
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgLn :: Handle -> Int -> Int -> String -> IO ()
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgLn hdl v lvl = when (lvl <= v) . hPutStrLn hdl
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | 'verbMsg' with stdout as handle
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgIO :: Int -> Int -> String -> IO ()
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgIO = verbMsg stdout
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | 'verbMsgLn' with stdout as handle
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgIOLn :: Int -> Int -> String -> IO ()
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiverbMsgIOLn = verbMsgLn stdout
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | replace first (non-empty) sublist with second one in third argument list
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskireplace :: Eq a => [a] -> [a] -> [a] -> [a]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskireplace sl r = case sl of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> error "Common.Utils.replace: empty list"
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski _ -> concat . unfoldr (\ l -> case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> Nothing
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski hd : tl -> Just $ case stripPrefix sl l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Nothing -> ([hd], tl)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just rt -> (r, rt))
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | add indices to a list starting from one
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskinumber :: [a] -> [(a, Int)]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskinumber = flip zip [1 ..]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | /O(1)/ test if the set's size is one
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiisSingleton :: Set.Set a -> Bool
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiisSingleton s = Set.size s == 1
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | /O(1)/ test if the set's size is greater one
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskihasMany :: Set.Set a -> Bool
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskihasMany s = Set.size s > 1
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | Transform a list @[l1, l2, ... ln]@ to (in sloppy notation)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski @[[x1, x2, ... xn] | x1 <- l1, x2 <- l2, ... xn <- ln]@
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (this is just the 'sequence' function!) -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskicombine :: [[a]] -> [[a]]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskicombine = sequence
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- see http://www.haskell.org/pipermail/haskell-cafe/2009-November/069490.html
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | trims a string both on left and right hand side
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskitrim :: String -> String
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskitrim = trimRight . trimLeft
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | trims a string only on the left side
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitrimLeft :: String -> String
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitrimLeft = dropWhile isSpace
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | trims a string only on the right side
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitrimRight :: String -> String
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitrimRight = reverse . trimLeft . reverse
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | The 'nubWith' function accepts as an argument a \"stop list\" update
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskifunction and an initial stop list. The stop list is a set of list elements
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskithat 'nubWith' uses as a filter to remove duplicate elements. The stop list
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskiis normally initially empty. The stop list update function is given a list
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskielement a and the current stop list b, and returns 'Nothing' if the element is
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskialready in the stop list, else 'Just' b', where b' is a new stop list updated
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskito contain a. -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubWith :: (a -> b -> Maybe b) -> b -> [a] -> [a]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubWith f s es = case es of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> []
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski e : rs -> case f e s of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just s' -> e : nubWith f s' rs
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Nothing -> nubWith f s rs
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubOrd :: Ord a => [a] -> [a]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubOrd = nubOrdOn id
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubOrdOn :: Ord b => (a -> b) -> [a] -> [a]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinubOrdOn g = let f a s = let e = g a in
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski if Set.member e s then Nothing else Just (Set.insert e s)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in nubWith f Set.empty
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | safe variant of !!
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiatMaybe :: [a] -> Int -> Maybe a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiatMaybe l i = if i < 0 then Nothing else case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> Nothing
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski x : r -> if i == 0 then Just x else atMaybe r (i - 1)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskireadMaybe :: Read a => String -> Maybe a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskireadMaybe s = case filter (all isSpace . snd) $ reads s of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [(a, _)] -> Just a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski _ -> Nothing
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | generalization of mapAccumL to monads
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimapAccumLM :: Monad m
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski => (acc -> x -> m (acc, y))
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski {- ^ Function taking accumulator and list element,
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski returning new accumulator and modified list element -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> acc -- ^ Initial accumulator
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> [x] -- ^ Input list
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> m (acc, [y]) -- ^ Final accumulator and result list
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimapAccumLM f s l = case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> return (s, [])
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski x : xs -> do
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (s', y) <- f s x
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (s'', ys) <- mapAccumLM f s' xs
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski return (s'', y : ys)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | generalization of mapAccumL to monads with combine function
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimapAccumLCM :: (Monad m) => (a -> b -> c) -> (acc -> a -> m (acc, b))
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> acc -> [a] -> m (acc, [c])
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimapAccumLCM g f s l = case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> return (s, [])
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski x : xs -> do
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (s', y) <- f s x
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (s'', ys) <- mapAccumLCM g f s' xs
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski return (s'', g x y : ys)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | composition of arbitrary maps
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskicomposeMap :: Ord a => Map.Map a b -> Map.Map a a -> Map.Map a a -> Map.Map a a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskicomposeMap s m1 m2 = if Map.null m2 then m1 else Map.intersection
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (Map.foldWithKey ( \ i j ->
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski let k = Map.findWithDefault j j m2 in
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski if i == k then Map.delete i else Map.insert i k) m2 m1) s
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | keep only minimal elements
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskikeepMins :: (a -> a -> Bool) -> [a] -> [a]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskikeepMins lt l = case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> []
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski x : r -> let s = filter (not . lt x) r
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski m = keepMins lt s
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in if any (`lt` x) s then m
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski else x : m
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski A function inspired by the perl function split. A list is splitted
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski on a separator element in smaller non-empty lists.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski The separator element is dropped from the resulting list.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitOn :: Eq a => a -- ^ separator
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> [a] -- ^ list to split
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> [[a]]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitOn x = filter (not . null) . splitBy x
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Same as splitOn but empty lists are kept. Even the empty list is split into
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski a singleton list containing the empty list.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitBy :: Eq a => a -- ^ separator
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> [a] -- ^ list to split
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> [[a]]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitBy c l = let (p, q) = break (c ==) l in p : case q of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> []
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski _ : r -> splitBy c r
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | Same as splitBy but the separator is a sublist not only one element.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiNote that the separator must be non-empty. -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitByList :: Eq a => [a] -> [a] -> [[a]]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskisplitByList sep l = case l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski [] -> [[]]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski h : t -> case stripPrefix sep l of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just suf -> [] : splitByList sep suf
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Nothing -> let f : r = splitByList sep t in (h : f) : r
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | If the given string is terminated by a decimal number
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskithis number and the nonnumber prefix is returned. -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinumberSuffix :: String -> Maybe (String, Int)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskinumberSuffix s =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski let f a r@(x, y, b) =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski let b' = isDigit a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski y' = y + x * digitToInt a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski out | not b = r
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski | b && b' = (x * 10, y', b')
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski | otherwise = (x, y, False)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in out
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in case foldr f (1, 0, True) s of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (1, _, _) ->
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Nothing
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (p, n, _) ->
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just (take (1 + length s - length (show p)) s, n)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski A function inspired by a perl function from the standard perl-module
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski File::Basename. It removes the directory part of a filepath.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskibasename :: FilePath -> FilePath
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskibasename = snd . stripDir
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski A function inspired by a perl function from the standard perl-module
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski File::Basename. It gives the directory part of a filepath.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskidirname :: FilePath -> FilePath
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskidirname = fst . stripDir
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski A function inspired by a perl function from the standard perl-module
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski File::Basename. It splits a filepath into the basename, the
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski directory and gives the suffix that matched from the list of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski suffixes. If a suffix matched it is removed from the basename.
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskifileparse :: [String] -- ^ list of suffixes
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> FilePath
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> (FilePath, FilePath, Maybe String)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -- ^ (basename,directory,matched suffix)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowskifileparse sufs fp = let (path, base) = stripDir fp
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (base', suf) = stripSuffix sufs base
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in (base', path, suf)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskistripDir :: FilePath -> (FilePath, FilePath)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskistripDir =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (\ (x, y) -> (if null y then "./" else reverse y, reverse x))
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski . break (== '/') . reverse
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskistripSuffix :: [String] -> FilePath -> (FilePath, Maybe String)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskistripSuffix suf fp = case filter isJust $ map (stripSuf fp) suf of
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just (x, s) : _ -> (x, Just s)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski _ -> (fp, Nothing)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski where stripSuf f s | s `isSuffixOf` f =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski Just (take (length f - length s) f, s)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski | otherwise = Nothing
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- |
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski This function generalizes makeRelative in that it computes also a relative
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski path with descents such as ../../test.txt
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimakeRelativeDesc :: FilePath -- ^ path to a directory
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> FilePath -- ^ to be computed relatively to given directory
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> FilePath -- ^ resulting relative path
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskimakeRelativeDesc dp fp = f dp fp []
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski where f "" y l = joinPath $ l ++ [y]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski f x y l = let y' = makeRelative x y
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in if equalFilePath y y'
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski then f (takeDirectory x) y $ ".." : l
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski else joinPath $ l ++ [y']
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | filter a map according to a given list of keys (it dosen't hurt
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski if a key is not present in the map) -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskifilterMapWithList :: Ord k => [k] -> Map.Map k e -> Map.Map k e
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskifilterMapWithList = filterMapWithSet . Set.fromList
a8df6f5d096a0301b9fe350df957449cd1646cb3Till Mossakowski
a8df6f5d096a0301b9fe350df957449cd1646cb3Till Mossakowski{- | filter a map according to a given set of keys (it dosen't hurt if
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski a key is not present in the map) -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskifilterMapWithSet :: Ord k => Set.Set k -> Map.Map k e -> Map.Map k e
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskifilterMapWithSet s = Map.filterWithKey (\ k _ -> Set.member k s)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | get, parse and check an environment variable; provide the default
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski value, only if the envionment variable is not set or the
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski parse-check-function returns a Left value -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetEnvSave :: a -- ^ default value
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> String -- ^ name of environment variable
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> (String -> Maybe a)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski {- ^ parse and check value of variable;
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski for every b the default value is returned -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetEnvSave defValue envVar readFun =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski liftM (maybe defValue (fromMaybe defValue . readFun)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski . lookup envVar) getEnvironment
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | get environment variable
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetEnvDef :: String -- ^ environment variable
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> String -- ^ default value
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO String
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetEnvDef envVar defValue = getEnvSave defValue envVar Just
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | the timeout function taking seconds instead of microseconds
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitimeoutSecs :: Int -> IO a -> IO (Maybe a)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitimeoutSecs time = timeout $ let
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski m = 1000000
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski u = div maxBound m
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski in if time > u then maxBound else
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski if time < 1 then 100000 -- 1/10 of a second
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski else m * time
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | runs a command with timeout
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitimeoutCommand :: Int -> FilePath -> [String]
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO (Maybe (ExitCode, String, String))
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskitimeoutCommand time cmd args =
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski timeoutSecs time $
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski readProcessWithExitCode cmd args "" -- no input from stdin
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski{- | runs an action in a different directory without changing the current
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski directory globally. -}
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiwithinDirectory :: FilePath -> IO a -> IO a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiwithinDirectory p a = do
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski d <- getCurrentDirectory
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski setCurrentDirectory p
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski r <- a
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski setCurrentDirectory d
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski return r
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | calls openTempFile but directly writes content and closes the file
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiwriteTempFile :: String -- ^ Content
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> FilePath -- ^ Directory in which to create the file
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> String -- ^ File name template
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO FilePath -- ^ create file
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskiwriteTempFile str tmpDir file = do
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski (tmpFile, hdl) <- openTempFile tmpDir file
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski hPutStr hdl str
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski hFlush hdl
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski hClose hdl
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski return tmpFile
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski-- | create file in temporary directory (the first argument is the content)
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetTempFile :: String -- ^ Content
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> String -- ^ File name template
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski -> IO FilePath -- ^ create file
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till MossakowskigetTempFile str file = do
91dd24480df03b2cca7c1645bb2866d7000dfdb1Till Mossakowski tmpDir <- getTemporaryDirectory
writeTempFile str tmpDir file