module UHC.Util.Utils where
import Data.Char
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Graph as Graph
unionMapSet :: Ord b => (a -> Set.Set b) -> (Set.Set a -> Set.Set b)
unionMapSet f = Set.unions . map f . Set.toList
inverseMap :: (Ord k, Ord v') => (k -> v -> (v',k')) -> Map.Map k v -> Map.Map v' k'
inverseMap mk = Map.fromList . map (uncurry mk) . Map.toList
showStringMapKeys :: Map.Map String x -> String -> String
showStringMapKeys m sep = concat $ intersperse sep $ Map.keys m
hdAndTl' :: a -> [a] -> (a,[a])
hdAndTl' _ (a:as) = (a,as)
hdAndTl' n [] = (n,[])
hdAndTl :: [a] -> (a,[a])
hdAndTl = hdAndTl' (panic "hdAndTl")
maybeNull :: r -> ([a] -> r) -> [a] -> r
maybeNull n f l = if null l then n else f l
maybeHd :: r -> (a -> r) -> [a] -> r
maybeHd n f = maybeNull n (f . head)
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy p l
= w l
where w [] = []
w l = let (l',ls') = break p l
in l' : case ls' of [] -> []
(_:[]) -> [[]]
(_:ls'') -> w ls''
initlast :: [a] -> Maybe ([a],a)
initlast as
= il [] as
where il acc [a] = Just (reverse acc,a)
il acc (a:as) = il (a:acc) as
il _ _ = Nothing
last' :: a -> [a] -> a
last' e = maybe e snd . initlast
initlast2 :: [a] -> Maybe ([a],a,a)
initlast2 as
= il [] as
where il acc [a,b] = Just (reverse acc,a,b)
il acc (a:as) = il (a:acc) as
il _ _ = Nothing
firstNotEmpty :: [[x]] -> [x]
firstNotEmpty = maybeHd [] id . filter (not . null)
listSaturate :: (Enum a,Ord a) => a -> a -> (x -> a) -> (a -> x) -> [x] -> [x]
listSaturate min max get mk xs
= [ Map.findWithDefault (mk i) i mp | i <- [min..max] ]
where mp = Map.fromList [ (get x,x) | x <- xs ]
listSaturateWith :: (Enum a,Ord a) => a -> a -> (x -> a) -> [(a,x)] -> [x] -> [x]
listSaturateWith min max get missing l
= listSaturate min max get mk l
where mp = Map.fromList missing
mk a = panicJust "listSaturateWith" $ Map.lookup a mp
spanOnRest :: ([a] -> Bool) -> [a] -> ([a],[a])
spanOnRest p [] = ([],[])
spanOnRest p xs@(x:xs')
| p xs = (x:ys, zs)
| otherwise = ([],xs)
where (ys,zs) = spanOnRest p xs'
tup123to1 (a,_,_) = a
tup123to2 (_,a,_) = a
tup123to12 (a,b,_) = (a,b)
tup123to23 (_,a,b) = (a,b)
tup12to123 c (a,b) = (a,b,c)
strWhite :: Int -> String
strWhite sz = replicate sz ' '
strPad :: String -> Int -> String
strPad s sz = s ++ strWhite (sz length s)
strCapitalize :: String -> String
strCapitalize s
= case s of
(c:cs) -> toUpper c : cs
_ -> s
strToInt :: String -> Int
strToInt = foldl (\i c -> i * 10 + ord c ord '0') 0
splitForQualified :: String -> [String]
splitForQualified s
= ws''
where ws = wordsBy (=='.') s
ws' = case initlast2 ws of
Just (ns,n,"") -> ns ++ [n ++ "."]
_ -> ws
ws''= case break (=="") ws' of
(nq,(_:ns)) -> nq ++ [concatMap ("."++) ns]
_ -> ws'
panic m = error ("panic: " ++ m)
isSortedByOn :: (b -> b -> Ordering) -> (a -> b) -> [a] -> Bool
isSortedByOn cmp sel l
= isSrt l
where isSrt (x1:tl@(x2:_)) = cmp (sel x1) (sel x2) /= GT && isSrt tl
isSrt _ = True
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn = sortByOn compare
sortByOn :: (b -> b -> Ordering) -> (a -> b) -> [a] -> [a]
sortByOn cmp sel = sortBy (\e1 e2 -> sel e1 `cmp` sel e2)
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn sel = groupBy (\e1 e2 -> sel e1 == sel e2)
groupSortOn :: Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn sel = groupOn sel . sortOn sel
groupByOn :: (b -> b -> Bool) -> (a -> b) -> [a] -> [[a]]
groupByOn eq sel = groupBy (\e1 e2 -> sel e1 `eq` sel e2)
groupSortByOn :: (b -> b -> Ordering) -> (a -> b) -> [a] -> [[a]]
groupSortByOn cmp sel = groupByOn (\e1 e2 -> cmp e1 e2 == EQ) sel . sortByOn cmp sel
nubOn :: Eq b => (a->b) -> [a] -> [a]
nubOn sel = nubBy (\a1 a2 -> sel a1 == sel a2)
consecutiveBy :: (a -> a -> Bool) -> [a] -> [[a]]
consecutiveBy _ [] = []
consecutiveBy isConsec (x:xs) = ys : consecutiveBy isConsec zs
where (ys,zs) = consec x xs
consec x [] = ([x],[])
consec x yys@(y:ys) | isConsec x y = let (yys',zs) = consec y ys in (x:yys',zs)
| otherwise = ([x],yys)
partitionAndRebuild :: (v -> Bool) -> [v] -> ([v], [v], [v'] -> [v'] -> [v'])
partitionAndRebuild f (v:vs)
| f v = (v : vs1, vs2, \(r:r1) r2 -> r : mk r1 r2)
| otherwise = ( vs1, v : vs2, \ r1 (r:r2) -> r : mk r1 r2)
where (vs1,vs2,mk) = partitionAndRebuild f vs
partitionAndRebuild _ [] = ([], [], \_ _ -> [])
orderingLexic :: [Ordering] -> Ordering
orderingLexic = foldr1 (\o1 o2 -> if o1 == EQ then o2 else o1)
panicJust :: String -> Maybe a -> a
panicJust m = maybe (panic m) id
infixr 0 $?
($?) :: (a -> Maybe b) -> Maybe a -> Maybe b
f $? mx = do x <- mx
f x
orMb :: Maybe a -> Maybe a -> Maybe a
orMb m1 m2 = maybe m2 (const m1) m1
maybeAnd :: x -> (a -> b -> x) -> Maybe a -> Maybe b -> x
maybeAnd n jj ma mb
= case ma of
Just a
-> case mb of {Just b -> jj a b ; _ -> n}
_ -> n
maybeOr :: x -> (a -> x) -> (b -> x) -> Maybe a -> Maybe b -> x
maybeOr n fa fb ma mb
= case ma of
Just a -> fa a
_ -> case mb of
Just b -> fb b
_ -> n
scc :: Ord n => [(n,[n])] -> [[n]]
scc = map Graph.flattenSCC . Graph.stronglyConnComp . map (\(n,ns) -> (n, n, ns))
mapLookup2' :: (Ord k1, Ord k2) => (v1 -> Map.Map k2 v2) -> k1 -> k2 -> Map.Map k1 v1 -> Maybe (Map.Map k2 v2, v2)
mapLookup2' f k1 k2 m1
= do m2 <- Map.lookup k1 m1
let m2' = f m2
fmap ((,) m2') $ Map.lookup k2 m2'
mapLookup2 :: (Ord k1, Ord k2) => k1 -> k2 -> Map.Map k1 (Map.Map k2 v2) -> Maybe v2
mapLookup2 k1 k2 m1 = fmap snd $ mapLookup2' id k1 k2 m1