1 module Common (module Common, module Debug.Trace, module Colors) where
4 import Debug.Trace(trace)
5 import qualified Data.IntMap as IntMap
6 import Data.Char(isSpace)
7 import GHC.Float(formatRealFloat, FFFormat(FFFixed))
10 import qualified Data.Map as Map
12 -- | return a list of all cartesian products for a list of lists
13 -- e.g. products [[1,2],[3,4]] = [[1,3],[1,4],[2,3],[2,4]]
14 products :: [[a]] -> [[a]]
16 products (xs:xss) = [ x:prod | x <- xs, prod <- products xss]
18 trees :: Show a => String -> a -> a
19 trees msg a = trace ("{" ++ msg ++ ":" ++ show a ++ "}") a
21 foreach :: Monad m => [a] -> (a -> m b) -> m [b]
24 foreach_ :: Monad m => [a] -> (a -> m b) -> m ()
25 foreach_ list fun = do
29 ifJust :: Monad m => Maybe a -> (a -> m b) -> m ()
33 Just a -> do { f a; return () }
35 internalError :: String -> String -> String -> a
37 internalError moduleName functionName errorString =
38 error (moduleName ++ "." ++ functionName ++ ": " ++ errorString)
40 parseDouble :: String -> Maybe Double
42 case reads (commasToDots . trim $ string) of
43 ((double, []):_) -> Just double
46 commasToDots = map (\c -> if c == ',' then '.' else c)
48 trim :: String -> String
49 trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
51 -- | A NumberMap maps integers to integers
52 type NumberMap = IntMap.IntMap Int
54 -- | A NumberMap can be inverted (keys become values and values become keys)
55 invertMap :: NumberMap -> NumberMap
57 let list = IntMap.toList theMap
58 invertedList = map (\(x, y) -> (y, x)) list
59 in IntMap.fromList invertedList
61 -- | commasAnd combines a list of strings to one string by placing
62 -- commas in between and the word "and" just before the last element
63 commasAnd :: [String] -> String
66 commasAnd [x, y] = x ++ " and " ++ y
67 commasAnd (x:xs) = x ++ ", " ++ commasAnd xs
70 -- TODO: is niceFloat 2 0.0001 = "0.0" correct? (as opposed to "0.00")
71 -- | niceFloat prints a floating-point value with maximum
73 niceFloat :: Int -> Double -> String
74 niceFloat nrOfDigits f =
75 let s = formatRealFloat FFFixed (Just nrOfDigits) f
76 s' = reverse s -- s -- dropWhile (== '0') (reverse s)
77 s'' = if head s' == '.' then '0':s' else s'
80 -- | niceFloatFix prints a floating-point value with fixed
82 niceFloatFix :: Int -> Double -> String
83 niceFloatFix nrOfDigits f =
84 let s = formatRealFloat FFFixed (Just nrOfDigits) f
85 in if head s == '.' then '0':s else s
87 -- Compute the average of a list of fractionals, with average [] equal to 0.
88 average :: Fractional a => [a] -> a
90 average xs = (sum xs) / fromIntegral (length xs)
92 -- | updateList changes the element at the given zero-based index in a list
93 -- Example: updateList 2 "yes" ["no","maybe","often","always"] ==>
94 -- ["no","maybe","yes","always"]
95 updateList :: Int -> a -> [a] -> [a]
96 updateList i x l = take i l ++ [x] ++ drop (i+1) l
98 -- | groups splits a list into groups of given length. The
99 -- last group might be shorter.
100 -- Example: groups 3 [1..10] ==> [[1,2,3],[4,5,6],[7,8,9],[10]]
101 groups :: Int -> [a] -> [[a]]
103 groups n xs = let (col, rest) = splitAt n xs
104 in col: groups n rest
106 swap :: (a, b) -> (b, a)
109 -- remove the extension from a file name (or path).
110 removeExtension :: String -> String
111 removeExtension filename =
112 case break (=='.') $ reverse filename of
113 (_ , _ {- dot -}:properName) -> reverse properName
116 tabDelimited :: [[String]] -> String
117 tabDelimited = unlines . map (concat . intersperse "\t")
119 singleton :: a -> [a]
122 -- | a version of Prelude.lookup that fails when the element is not present in the assoc-list
123 unsafeLookup :: (Show k, Eq k) => k -> [(k,v)] -> v
124 unsafeLookup x assocs =
125 case lookup x assocs of
127 Nothing -> internalError "Common" "unsafeLookup" ("element " ++ show x ++ " not in list.")
129 -- | a version of Prelude.elemIndex that fails when the element is not present in the list
130 unsafeElemIndex :: (Show a, Eq a) => a -> [a] -> Int
131 unsafeElemIndex x xs =
132 case elemIndex x xs of
134 Nothing -> internalError "Common" "unsafeElemIndex" ("element " ++ show x ++ " not in list")
136 -- Approximately equals
137 (~=) :: Double -> Double -> Bool
138 (~=) d1 d2 = abs (d1 - d2) < 0.000001
140 fst3 :: (a, b, c) -> a
143 snd3 :: (a, b, c) -> b
146 thd3 :: (a, b, c) -> c
149 safeIndex :: String -> [a] -> Int -> a
151 | i >= 0 && i < length xs = xs !! i
152 | otherwise = internalError "Common" "safeIndex" msg
154 -- reorderList [0,2,1] "hoi" ==> "hio"
155 reorderList :: Show a => [Int] -> [a] -> [a]
157 | sort order /= [0..length xs-1] =
158 internalError "Common" "reorderList" ("order = " ++ show order ++ ", list = " ++ show xs)
160 [ xs !! i | i <- order ]
165 (/\) :: ( a -> b ) -> ( a -> c ) -> a -> (b,c)
166 (/\) f1 f2 a = (f1 a, f2 a)
168 (><) :: ( a -> c ) -> ( b -> d ) -> (a,b) -> (c,d)
169 (><) f1 f2 (a, b) = (f1 a, f2 b)
174 int2name :: Int -> String
175 int2name n | n<=0 = error "Unexpected number; a positive number was expected."
176 | otherwise = aux (n-1)
177 where aux m = (if q == 0 then [] else int2name q) ++ [toEnum (r + fromEnum 'a')]
178 where (q, r) = m `divMod` 26
180 takeJust :: String -> Maybe a -> a
181 takeJust erro (Just res) = res
182 takeJust erro Nothing = error erro
184 removeQuotes :: String -> String
185 removeQuotes ('"':str) = init str
186 removeQuotes str = str
188 spaces2underscores :: String -> String
189 spaces2underscores = map f
193 indent :: Int -> String -> String
194 indent n = unlines' . map (replicate n '\t' ++) . lines
196 -- | Similar to 'unlines' but without an @'\n'@ in the end.
197 unlines' :: [String] -> String
198 unlines' = foldr1 (\str1 str2 -> str1 ++ '\n':str2)
202 (!+!) :: [a] -> [Int] -> [a]
203 (!+!) l li = map (l !!) li
205 -- | 'foldl' for compositions
206 foldlCont :: (a -> b -> a) -> [b] -> a -> a
207 foldlCont f l init = foldl f init l
209 -- | Filter repeated elements only, mentioning the number of repetitions.
210 repeateds :: Ord a => [a] -> [(a, Int)]
211 repeateds = Map.toList . Map.filter (>1) . Map.fromListWith (+) . map (\x -> (x,1))
213 -- | Test for repeated elements.
214 haveRepeateds :: Ord a => [a] -> Bool
215 haveRepeateds = any ( (/=1) . snd) . repeateds