forked from GitHub/gf-core
3814841d7d
+ References to modules under src/compiler have been eliminated from the PGF library (under src/runtime/haskell). Only two functions had to be moved (from GF.Data.Utilities to PGF.Utilities) to make this possible, other apparent dependencies turned out to be vacuous. + In gf.cabal, the GF executable no longer directly depends on the PGF library source directory, but only on the exposed library modules. This means that there is less duplication in gf.cabal and that the 30 modules in the PGF library will no longer be compiled twice while building GF. To make this possible, additional PGF library modules have been exposed, even though they should probably be considered for internal use only. They could be collected in a PGF.Internal module, or marked as "unstable", to make this explicit. + Also, by using the -fwarn-unused-imports flag, ~220 redundant imports were found and removed, reducing the total number of imports by ~15%.
189 lines
4.9 KiB
Haskell
189 lines
4.9 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- 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, module PGF.Utilities) where
|
|
|
|
import Data.Maybe
|
|
import Data.List
|
|
import Control.Monad (MonadPlus(..),liftM)
|
|
import PGF.Utilities
|
|
|
|
-- * functions on lists
|
|
|
|
sameLength :: [a] -> [a] -> Bool
|
|
sameLength [] [] = True
|
|
sameLength (_:xs) (_:ys) = sameLength xs ys
|
|
sameLength _ _ = False
|
|
|
|
notLongerThan, longerThan :: Int -> [a] -> Bool
|
|
notLongerThan n = null . snd . splitAt n
|
|
longerThan n = not . notLongerThan n
|
|
|
|
lookupList :: Eq a => a -> [(a, b)] -> [b]
|
|
lookupList a [] = []
|
|
lookupList a (p:ps) | a == fst p = snd p : lookupList a ps
|
|
| otherwise = lookupList a ps
|
|
|
|
split :: [a] -> ([a], [a])
|
|
split (x : y : as) = (x:xs, y:ys)
|
|
where (xs, ys) = split as
|
|
split as = (as, [])
|
|
|
|
splitBy :: (a -> Bool) -> [a] -> ([a], [a])
|
|
splitBy p [] = ([], [])
|
|
splitBy p (a : as) = if p a then (a:xs, ys) else (xs, a:ys)
|
|
where (xs, ys) = splitBy p as
|
|
|
|
foldMerge :: (a -> a -> a) -> a -> [a] -> a
|
|
foldMerge merge zero = fm
|
|
where fm [] = zero
|
|
fm [a] = a
|
|
fm abs = let (as, bs) = split abs in fm as `merge` fm bs
|
|
|
|
select :: [a] -> [(a, [a])]
|
|
select [] = []
|
|
select (x:xs) = (x,xs) : [ (y,x:ys) | (y,ys) <- select xs ]
|
|
|
|
updateNth :: (a -> a) -> Int -> [a] -> [a]
|
|
updateNth update 0 (a : as) = update a : as
|
|
updateNth update n (a : as) = a : updateNth update (n-1) as
|
|
|
|
updateNthM :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
|
|
updateNthM update 0 (a : as) = liftM (:as) (update a)
|
|
updateNthM update n (a : as) = liftM (a:) (updateNthM update (n-1) as)
|
|
|
|
-- | Like 'init', but returns the empty list when the input is empty.
|
|
safeInit :: [a] -> [a]
|
|
safeInit [] = []
|
|
safeInit xs = init xs
|
|
|
|
-- | Sorts and then groups elements given an ordering of the
|
|
-- elements.
|
|
sortGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
|
|
sortGroupBy f = groupBy (compareEq f) . sortBy f
|
|
|
|
-- | Take the union of a list of lists.
|
|
unionAll :: Eq a => [[a]] -> [a]
|
|
unionAll = nub . 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' x = fromMaybe (error $ "Not found: " ++ show x) . lookup x
|
|
|
|
-- | Like 'find', but fails if nothing is found.
|
|
find' :: (a -> Bool) -> [a] -> a
|
|
find' p = fromJust . find p
|
|
|
|
-- | Set a value in a lookup table.
|
|
tableSet :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
|
|
tableSet x y [] = [(x,y)]
|
|
tableSet x y (p@(x',_):xs) | x' == x = (x,y):xs
|
|
| otherwise = p:tableSet x y xs
|
|
|
|
-- | Group tuples by their first elements.
|
|
buildMultiMap :: Ord a => [(a,b)] -> [(a,[b])]
|
|
buildMultiMap = map (\g -> (fst (head g), map snd g) )
|
|
. sortGroupBy (compareBy fst)
|
|
|
|
-- * equality functions
|
|
|
|
-- | Use an ordering function as an equality predicate.
|
|
compareEq :: (a -> a -> Ordering) -> a -> a -> Bool
|
|
compareEq f x y = case f x y of
|
|
EQ -> True
|
|
_ -> False
|
|
|
|
-- * ordering functions
|
|
|
|
compareBy :: Ord b => (a -> b) -> a -> a -> Ordering
|
|
compareBy f = both f compare
|
|
|
|
both :: (a -> b) -> (b -> b -> c) -> a -> a -> c
|
|
both f g x y = g (f x) (f y)
|
|
|
|
-- * functions on pairs
|
|
|
|
apFst :: (a -> a') -> (a, b) -> (a', b)
|
|
apFst f (a, b) = (f a, b)
|
|
|
|
apSnd :: (b -> b') -> (a, b) -> (a, b')
|
|
apSnd f (a, b) = (a, f b)
|
|
|
|
apBoth :: (a -> b) -> (a, a) -> (b, b)
|
|
apBoth f (x, y) = (f x, f y)
|
|
|
|
-- * functions on lists of pairs
|
|
|
|
mapFst = map . apFst
|
|
mapSnd = map . apSnd
|
|
mapBoth = map . apBoth
|
|
|
|
-- * functions on monads
|
|
|
|
-- | Return the given value if the boolean is true, els return 'mzero'.
|
|
whenMP :: MonadPlus m => Bool -> a -> m a
|
|
whenMP b x = if b then return x else mzero
|
|
|
|
-- * functions on Maybes
|
|
|
|
-- | Returns true if the argument is Nothing or Just []
|
|
nothingOrNull :: Maybe [a] -> Bool
|
|
nothingOrNull = maybe True null
|
|
|
|
-- * functions on functions
|
|
|
|
-- | Apply all the functions in the list to the argument.
|
|
foldFuns :: [a -> a] -> a -> a
|
|
foldFuns fs x = foldl (flip ($)) x fs
|
|
|
|
-- | Fixpoint iteration.
|
|
fix :: Eq a => (a -> a) -> a -> a
|
|
fix f x = let x' = f x in if x' == x then x else fix f 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 g = concat . intersperse g
|
|
|
|
-- * ShowS-functions
|
|
|
|
nl :: ShowS
|
|
nl = showChar '\n'
|
|
|
|
sp :: ShowS
|
|
sp = showChar ' '
|
|
|
|
wrap :: String -> ShowS -> String -> ShowS
|
|
wrap o s c = showString o . s . showString c
|
|
|
|
concatS :: [ShowS] -> ShowS
|
|
concatS = foldr (.) id
|
|
|
|
unwordsS :: [ShowS] -> ShowS
|
|
unwordsS = joinS " "
|
|
|
|
unlinesS :: [ShowS] -> ShowS
|
|
unlinesS = joinS "\n"
|
|
|
|
joinS :: String -> [ShowS] -> ShowS
|
|
joinS glue = concatS . intersperse (showString glue)
|
|
|
|
|
|
|