----------------------------------------------------------------------
-- |
-- Maintainer  : PL
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/10/26 18:47:16 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.6 $
--
-- Basic functions not in the standard libraries
-----------------------------------------------------------------------------


module GF.Data.Utilities(module GF.Data.Utilities) where

import Data.Maybe
import Data.List
import Control.Monad (MonadPlus(..),liftM,when)
import qualified Data.Set as Set

-- * functions on lists

sameLength :: [a] -> [a] -> Bool
sameLength :: [a] -> [a] -> Bool
sameLength [] [] = Bool
True
sameLength (a
_:[a]
xs) (a
_:[a]
ys) = [a] -> [a] -> Bool
forall a. [a] -> [a] -> Bool
sameLength [a]
xs [a]
ys
sameLength [a]
_ [a]
_ = Bool
False

notLongerThan, longerThan :: Int -> [a] -> Bool
notLongerThan :: Int -> [a] -> Bool
notLongerThan Int
n = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> [a]
forall a b. (a, b) -> b
snd (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n
longerThan :: Int -> [a] -> Bool
longerThan    Int
n = Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> Bool
forall a. Int -> [a] -> Bool
notLongerThan Int
n

lookupList :: Eq a => a -> [(a, b)] -> [b]
lookupList :: a -> [(a, b)] -> [b]
lookupList a
a [] = []
lookupList a
a ((a, b)
p:[(a, b)]
ps) | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
p = (a, b) -> b
forall a b. (a, b) -> b
snd (a, b)
p b -> [b] -> [b]
forall a. a -> [a] -> [a]
: a -> [(a, b)] -> [b]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookupList a
a [(a, b)]
ps
                    | Bool
otherwise  =         a -> [(a, b)] -> [b]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookupList a
a [(a, b)]
ps

split :: [a] -> ([a], [a])
split :: [a] -> ([a], [a])
split (a
x : a
y : [a]
as) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    where ([a]
xs, [a]
ys) = [a] -> ([a], [a])
forall a. [a] -> ([a], [a])
split [a]
as
split [a]
as = ([a]
as, [])

splitBy :: (a -> Bool) -> [a] -> ([a], [a])
splitBy :: (a -> Bool) -> [a] -> ([a], [a])
splitBy a -> Bool
p [] = ([], [])
splitBy a -> Bool
p (a
a : [a]
as) = if a -> Bool
p a
a then (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, [a]
ys) else ([a]
xs, a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
    where ([a]
xs, [a]
ys) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
splitBy a -> Bool
p [a]
as

foldMerge :: (a -> a -> a) -> a -> [a] -> a
foldMerge :: (a -> a -> a) -> a -> [a] -> a
foldMerge a -> a -> a
merge a
zero = [a] -> a
fm
    where fm :: [a] -> a
fm [] = a
zero
          fm [a
a] = a
a
          fm [a]
abs = let ([a]
as, [a]
bs) = [a] -> ([a], [a])
forall a. [a] -> ([a], [a])
split [a]
abs in [a] -> a
fm [a]
as a -> a -> a
`merge` [a] -> a
fm [a]
bs

select :: [a] -> [(a, [a])]
select :: [a] -> [(a, [a])]
select [] = []
select (a
x:[a]
xs) = (a
x,[a]
xs) (a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
: [ (a
y,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys) | (a
y,[a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
select [a]
xs ]

updateNth :: (a -> a) -> Int -> [a] -> [a]
updateNth :: (a -> a) -> Int -> [a] -> [a]
updateNth a -> a
update Int
0 (a
a : [a]
as) = a -> a
update a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
updateNth a -> a
update Int
n (a
a : [a]
as) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> Int -> [a] -> [a]
forall a. (a -> a) -> Int -> [a] -> [a]
updateNth a -> a
update (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
as

updateNthM :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
updateNthM :: (a -> m a) -> Int -> [a] -> m [a]
updateNthM a -> m a
update Int
0 (a
a : [a]
as) = (a -> [a]) -> m a -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as) (a -> m a
update a
a)
updateNthM a -> m a
update Int
n (a
a : [a]
as) = ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)  ((a -> m a) -> Int -> [a] -> m [a]
forall (m :: * -> *) a.
Monad m =>
(a -> m a) -> Int -> [a] -> m [a]
updateNthM a -> m a
update (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [a]
as)

-- | Like 'init', but returns the empty list when the input is empty.
safeInit :: [a] -> [a]
safeInit :: [a] -> [a]
safeInit [] = []
safeInit [a]
xs = [a] -> [a]
forall a. [a] -> [a]
init [a]
xs

-- | Sorts and then groups elements given an ordering of the
--   elements.
sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
sortGroupBy a -> a -> Ordering
f = (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((a -> a -> Ordering) -> a -> a -> Bool
forall a. (a -> a -> Ordering) -> a -> a -> Bool
compareEq a -> a -> Ordering
f) ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
f

-- | Take the union of a list of lists.
unionAll :: Eq a => [[a]] -> [a]
unionAll :: [[a]] -> [a]
unionAll = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ([a] -> [a]) -> ([[a]] -> [a]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

-- | Like 'lookup', but fails if the argument is not found,
--   instead of returning Nothing.
lookup' :: (Show a, Eq a) => a -> [(a,b)] -> b
lookup' :: a -> [(a, b)] -> b
lookup' a
x = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"Not found: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
x) (Maybe b -> b) -> ([(a, b)] -> Maybe b) -> [(a, b)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x

-- | Like 'find', but fails if nothing is found.
find' :: (a -> Bool) -> [a] -> a
find' :: (a -> Bool) -> [a] -> a
find' a -> Bool
p = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> ([a] -> Maybe a) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find a -> Bool
p

-- | Set a value in a lookup table.
tableSet :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
tableSet :: a -> b -> [(a, b)] -> [(a, b)]
tableSet a
x b
y [] = [(a
x,b
y)]
tableSet a
x b
y (p :: (a, b)
p@(a
x',b
_):[(a, b)]
xs) | a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = (a
x,b
y)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
xs
                           | Bool
otherwise = (a, b)
p(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:a -> b -> [(a, b)] -> [(a, b)]
forall a b. Eq a => a -> b -> [(a, b)] -> [(a, b)]
tableSet a
x b
y [(a, b)]
xs

-- | Group tuples by their first elements.
buildMultiMap :: Ord a => [(a,b)] -> [(a,[b])]
buildMultiMap :: [(a, b)] -> [(a, [b])]
buildMultiMap = ([(a, b)] -> (a, [b])) -> [[(a, b)]] -> [(a, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (\[(a, b)]
g -> ((a, b) -> a
forall a b. (a, b) -> a
fst ([(a, b)] -> (a, b)
forall a. [a] -> a
head [(a, b)]
g), ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
g) )
                 ([[(a, b)]] -> [(a, [b])])
-> ([(a, b)] -> [[(a, b)]]) -> [(a, b)] -> [(a, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Ordering) -> [a] -> [[a]]
sortGroupBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall b a. Ord b => (a -> b) -> a -> a -> Ordering
compareBy (a, b) -> a
forall a b. (a, b) -> a
fst)

-- * equality functions

-- | Use an ordering function as an equality predicate.
compareEq :: (a -> a -> Ordering) -> a -> a -> Bool
compareEq :: (a -> a -> Ordering) -> a -> a -> Bool
compareEq a -> a -> Ordering
f a
x a
y = case a -> a -> Ordering
f a
x a
y of
                             Ordering
EQ -> Bool
True
                             Ordering
_ -> Bool
False

-- * ordering functions

compareBy :: Ord b => (a -> b) -> a -> a -> Ordering
compareBy :: (a -> b) -> a -> a -> Ordering
compareBy a -> b
f = (a -> b) -> (b -> b -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b) -> (b -> b -> c) -> a -> a -> c
both a -> b
f b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

both :: (a -> b) -> (b -> b -> c) -> a -> a -> c
both :: (a -> b) -> (b -> b -> c) -> a -> a -> c
both a -> b
f b -> b -> c
g a
x a
y = b -> b -> c
g (a -> b
f a
x) (a -> b
f a
y)

-- * functions on pairs

apFst :: (a -> a') -> (a, b) -> (a', b)
apFst :: (a -> a') -> (a, b) -> (a', b)
apFst a -> a'
f (a
a, b
b) = (a -> a'
f a
a, b
b)

apSnd :: (b -> b') -> (a, b) -> (a, b')
apSnd :: (b -> b') -> (a, b) -> (a, b')
apSnd b -> b'
f (a
a, b
b) = (a
a, b -> b'
f b
b)

apBoth :: (a -> b) -> (a, a) -> (b, b)
apBoth :: (a -> b) -> (a, a) -> (b, b)
apBoth a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

-- * functions on lists of pairs

mapFst :: (a -> a') -> [(a, b)] -> [(a', b)]
mapFst = ((a, b) -> (a', b)) -> [(a, b)] -> [(a', b)]
forall a b. (a -> b) -> [a] -> [b]
map (((a, b) -> (a', b)) -> [(a, b)] -> [(a', b)])
-> ((a -> a') -> (a, b) -> (a', b))
-> (a -> a')
-> [(a, b)]
-> [(a', b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a') -> (a, b) -> (a', b)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
apFst
mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd = ((a, b) -> (a, b')) -> [(a, b)] -> [(a, b')]
forall a b. (a -> b) -> [a] -> [b]
map (((a, b) -> (a, b')) -> [(a, b)] -> [(a, b')])
-> ((b -> b') -> (a, b) -> (a, b'))
-> (b -> b')
-> [(a, b)]
-> [(a, b')]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b') -> (a, b) -> (a, b')
forall b b' a. (b -> b') -> (a, b) -> (a, b')
apSnd
mapBoth :: (a -> b) -> [(a, a)] -> [(b, b)]
mapBoth = ((a, a) -> (b, b)) -> [(a, a)] -> [(b, b)]
forall a b. (a -> b) -> [a] -> [b]
map (((a, a) -> (b, b)) -> [(a, a)] -> [(b, b)])
-> ((a -> b) -> (a, a) -> (b, b))
-> (a -> b)
-> [(a, a)]
-> [(b, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (a, a) -> (b, b)
forall a b. (a -> b) -> (a, a) -> (b, b)
apBoth

-- * functions on monads

-- | Return the given value if the boolean is true, els return 'mzero'.
whenMP :: MonadPlus m => Bool -> a -> m a
whenMP :: Bool -> a -> m a
whenMP Bool
b a
x = if Bool
b then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x else m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

whenM :: m Bool -> m () -> m ()
whenM m Bool
bm m ()
m = (Bool -> m () -> m ()) -> m () -> Bool -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when m ()
m (Bool -> m ()) -> m Bool -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
bm

repeatM :: m Bool -> m ()
repeatM m Bool
m = m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
m (m Bool -> m ()
repeatM m Bool
m)

-- * functions on Maybes

-- | Returns true if the argument is Nothing or Just []
nothingOrNull :: Maybe [a] -> Bool
nothingOrNull :: Maybe [a] -> Bool
nothingOrNull = Bool -> ([a] -> Bool) -> Maybe [a] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

-- * functions on functions

-- | Apply all the functions in the list to the argument.
foldFuns :: [a -> a] -> a -> a
foldFuns :: [a -> a] -> a -> a
foldFuns [a -> a]
fs a
x = (a -> (a -> a) -> a) -> a -> [a -> a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((a -> a) -> a -> a) -> a -> (a -> a) -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($)) a
x [a -> a]
fs

-- | Fixpoint iteration.
fix :: Eq a => (a -> a) -> a -> a
fix :: (a -> a) -> a -> a
fix a -> a
f a
x = let x' :: a
x' = a -> a
f a
x in if a
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a
x else (a -> a) -> a -> a
forall a. Eq a => (a -> a) -> a -> a
fix a -> a
f a
x'

-- * functions on strings

-- | Join a number of lists by using the given glue
--   between the lists.
join :: [a] -- ^ glue
     -> [[a]] -- ^ lists to join
     -> [a]
join :: [a] -> [[a]] -> [a]
join [a]
g = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
intersperse [a]
g

-- * ShowS-functions

nl :: ShowS
nl :: [Char] -> [Char]
nl = Char -> [Char] -> [Char]
showChar Char
'\n'

sp :: ShowS
sp :: [Char] -> [Char]
sp = Char -> [Char] -> [Char]
showChar Char
' '

wrap :: String -> ShowS -> String -> ShowS
wrap :: [Char] -> ([Char] -> [Char]) -> [Char] -> [Char] -> [Char]
wrap [Char]
o [Char] -> [Char]
s [Char]
c = [Char] -> [Char] -> [Char]
showString [Char]
o ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
s ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
c

concatS :: [ShowS] -> ShowS
concatS :: [[Char] -> [Char]] -> [Char] -> [Char]
concatS = (([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [[Char] -> [Char]] -> [Char] -> [Char]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) [Char] -> [Char]
forall a. a -> a
id

unwordsS :: [ShowS] -> ShowS
unwordsS :: [[Char] -> [Char]] -> [Char] -> [Char]
unwordsS = [Char] -> [[Char] -> [Char]] -> [Char] -> [Char]
joinS [Char]
" "

unlinesS :: [ShowS] -> ShowS
unlinesS :: [[Char] -> [Char]] -> [Char] -> [Char]
unlinesS = [Char] -> [[Char] -> [Char]] -> [Char] -> [Char]
joinS [Char]
"\n"

joinS :: String -> [ShowS] -> ShowS
joinS :: [Char] -> [[Char] -> [Char]] -> [Char] -> [Char]
joinS [Char]
glue = [[Char] -> [Char]] -> [Char] -> [Char]
concatS ([[Char] -> [Char]] -> [Char] -> [Char])
-> ([[Char] -> [Char]] -> [[Char] -> [Char]])
-> [[Char] -> [Char]]
-> [Char]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char] -> [Char]] -> [[Char] -> [Char]]
forall a. a -> [a] -> [a]
intersperse ([Char] -> [Char] -> [Char]
showString [Char]
glue)



-- | Like 'Data.List.nub', but O(n log n) instead of O(n^2), since it uses a set to lookup previous things.
--   The result list is stable (the elements are returned in the order they occur), and lazy.
--   Requires that the list elements can be compared by Ord.
--   Code ruthlessly taken from <http://hpaste.org/54411>
nub' :: Ord a => [a] -> [a]
nub' :: [a] -> [a]
nub' = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
loop Set a
forall a. Set a
Set.empty
    where loop :: Set a -> [a] -> [a]
loop Set a
_    []            = []
          loop Set a
seen (a
x : [a]
xs)
              | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
seen = Set a -> [a] -> [a]
loop Set a
seen [a]
xs
              | Bool
otherwise         = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
loop (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
seen) [a]
xs


-- | Replace all occurences of an element by another element.
replace :: Eq a => a -> a -> [a] -> [a]
replace :: a -> a -> [a] -> [a]
replace a
x a
y = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
z -> if a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x then a
y else a
z)