INblobs-0.1.1: src/Common.hs

module Common (module Common, module Debug.Trace, module Colors) where

import Colors
import Debug.Trace(trace)
import qualified Data.IntMap as IntMap
import Data.Char(isSpace)
import GHC.Float(formatRealFloat, FFFormat(FFFixed))
import Data.List

import qualified Data.Map as Map

-- | return a list of all cartesian products for a list of lists
--   e.g. products [[1,2],[3,4]] = [[1,3],[1,4],[2,3],[2,4]]
products :: [[a]] -> [[a]]
products [] = [[]]
products (xs:xss) = [ x:prod | x <- xs, prod <- products xss]

trees :: Show a => String -> a -> a
trees msg a = trace ("{" ++ msg ++ ":" ++ show a ++ "}") a

foreach :: Monad m => [a] -> (a -> m b) -> m [b]
foreach = flip mapM

foreach_ :: Monad m => [a] -> (a -> m b) -> m ()
foreach_ list fun = do
    mapM fun list
    return ()

ifJust :: Monad m => Maybe a -> (a -> m b) -> m ()
ifJust ma f =
    case ma of
        Nothing -> return ()
        Just a  -> do { f a; return () }

internalError :: String -> String -> String -> a

internalError moduleName functionName errorString =
    error (moduleName ++ "." ++ functionName ++ ": " ++ errorString)

parseDouble :: String -> Maybe Double
parseDouble string =
    case reads (commasToDots . trim $ string) of
        ((double, []):_) -> Just double
        _                -> Nothing
  where
    commasToDots = map (\c -> if c == ',' then '.' else c)

trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

-- | A NumberMap maps integers to integers
type NumberMap = IntMap.IntMap Int

-- | A NumberMap can be inverted (keys become values and values become keys)
invertMap :: NumberMap -> NumberMap
invertMap theMap =
    let list = IntMap.toList theMap
        invertedList = map (\(x, y) -> (y, x)) list
    in IntMap.fromList invertedList

-- | commasAnd combines a list of strings to one string by placing
--   commas in between and the word "and" just before the last element
commasAnd :: [String] -> String
commasAnd [] = ""
commasAnd [x] = x
commasAnd [x, y] = x ++ " and " ++ y
commasAnd (x:xs) = x ++ ", " ++ commasAnd xs


-- TODO: is niceFloat 2 0.0001 = "0.0" correct? (as opposed to "0.00")
-- | niceFloat prints a floating-point value with maximum
--   number of decimals
niceFloat :: Int -> Double -> String
niceFloat nrOfDigits f =
    let s = formatRealFloat FFFixed (Just nrOfDigits) f
        s' = reverse s -- s -- dropWhile (== '0') (reverse s)
        s'' = if head s' == '.' then '0':s' else s'
    in reverse s''

-- | niceFloatFix prints a floating-point value with fixed
--   number of decimals
niceFloatFix :: Int -> Double -> String
niceFloatFix nrOfDigits f =
    let s = formatRealFloat FFFixed (Just nrOfDigits) f
    in  if head s == '.' then '0':s else s

-- Compute the average of a list of fractionals, with average [] equal to 0.
average :: Fractional a => [a] -> a
average [] = 0
average xs = (sum xs) / fromIntegral (length xs)

-- | updateList changes the element at the given zero-based index in a list
--   Example: updateList 2 "yes" ["no","maybe","often","always"] ==>
--                    ["no","maybe","yes","always"]
updateList :: Int -> a -> [a] -> [a]
updateList i x l = take i l ++ [x] ++ drop (i+1) l

-- | groups splits a list into groups of given length. The
--   last group might be shorter.
--   Example: groups 3 [1..10] ==> [[1,2,3],[4,5,6],[7,8,9],[10]]
groups :: Int -> [a] -> [[a]]
groups _ [] = []
groups n xs = let (col, rest) = splitAt n xs
              in  col: groups n rest

swap :: (a, b) -> (b, a)
swap (a, b) = (b, a)

-- remove the extension from a file name (or path).
removeExtension :: String -> String
removeExtension filename =
  case break (=='.') $ reverse filename of
    (_ , _ {- dot -}:properName) -> reverse properName
    (_ , []) -> filename

tabDelimited :: [[String]] -> String
tabDelimited = unlines . map (concat . intersperse "\t")

singleton :: a -> [a]
singleton x = [x]

-- | a version of Prelude.lookup that fails when the element is not present in the assoc-list
unsafeLookup :: (Show k, Eq k) => k -> [(k,v)] -> v
unsafeLookup x assocs =
  case lookup x assocs of
    Just v  -> v
    Nothing -> internalError "Common" "unsafeLookup" ("element " ++ show x ++ " not in list.")

-- | a version of Prelude.elemIndex that fails when the element is not present in the list
unsafeElemIndex :: (Show a, Eq a) => a -> [a] -> Int
unsafeElemIndex x xs =
  case elemIndex x xs of
    Just i  -> i
    Nothing -> internalError "Common" "unsafeElemIndex" ("element " ++ show x ++ " not in list")

-- Approximately equals
(~=) :: Double -> Double -> Bool
(~=) d1 d2 = abs (d1 - d2) < 0.000001

fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a

snd3 :: (a, b, c) -> b
snd3 (_, b, _) = b

thd3 :: (a, b, c) -> c
thd3 (_, _, c) = c

safeIndex :: String -> [a] -> Int -> a
safeIndex msg xs i
    | i >= 0 && i < length xs = xs !! i
    | otherwise = internalError "Common" "safeIndex" msg

-- reorderList [0,2,1] "hoi" ==> "hio"
reorderList :: Show a => [Int] -> [a] -> [a]
reorderList order xs
    | sort order /= [0..length xs-1] =
        internalError "Common" "reorderList" ("order = " ++ show order ++ ", list = " ++ show xs)
    | otherwise =
        [ xs !! i | i <- order ]

infix 6 /\ 
infix 7 ><

(/\) :: ( a -> b ) -> ( a -> c ) -> a -> (b,c)
(/\) f1 f2 a = (f1 a, f2 a)

(><) :: ( a -> c ) -> ( b -> d ) -> (a,b) -> (c,d)
(><) f1 f2 (a, b) = (f1 a, f2 b)

diag :: a -> (a,a)
diag a = (a, a)

int2name :: Int -> String
int2name n | n<=0 = error "Unexpected number; a positive number was expected." 
           | otherwise = aux (n-1)
           where aux m = (if q == 0 then [] else int2name q) ++ [toEnum (r + fromEnum 'a')]
                         where (q, r) = m `divMod` 26

takeJust :: String -> Maybe a -> a
takeJust erro (Just res) = res
takeJust erro Nothing = error erro

removeQuotes :: String -> String
removeQuotes ('"':str) = init str
removeQuotes str = str 

spaces2underscores :: String -> String
spaces2underscores = map f 
                     where f ' ' = '_'
                           f c = c

indent :: Int -> String -> String
indent n = unlines' . map (replicate n '\t' ++) . lines

-- | Similar to 'unlines' but without an @'\n'@ in the end.
unlines' :: [String] -> String
unlines' = foldr1 (\str1 str2 -> str1 ++ '\n':str2)

infix 9 !+!

(!+!) :: [a] -> [Int] -> [a]
(!+!) l li = map (l !!) li

-- | 'foldl' for compositions
foldlCont :: (a -> b -> a) -> [b] -> a -> a
foldlCont f l init = foldl f init l

-- | Filter repeated elements only, mentioning the number of repetitions.
repeateds :: Ord a => [a] -> [(a, Int)]
repeateds = Map.toList . Map.filter (>1) . Map.fromListWith (+) . map (\x -> (x,1))

-- | Test for repeated elements.
haveRepeateds :: Ord a => [a] -> Bool
haveRepeateds = any ( (/=1) . snd) . repeateds