mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 03:09:33 -06:00
Added Graphviz module for graphviz stuff. Move a lot of utility functions to GF.Data.Utilities.
This commit is contained in:
@@ -4,9 +4,9 @@
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/05/09 09:28:44 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.2 $
|
||||
-- > CVS $Date: 2005/09/14 15:17:29 $
|
||||
-- > CVS $Author: bringert $
|
||||
-- > CVS $Revision: 1.3 $
|
||||
--
|
||||
-- Basic functions not in the standard libraries
|
||||
-----------------------------------------------------------------------------
|
||||
@@ -14,7 +14,9 @@
|
||||
|
||||
module GF.Data.Utilities where
|
||||
|
||||
import Monad (liftM)
|
||||
import Data.Maybe
|
||||
import Data.List
|
||||
import Control.Monad (MonadPlus(..),liftM)
|
||||
|
||||
-- * functions on lists
|
||||
|
||||
@@ -32,6 +34,11 @@ lookupList a [] = []
|
||||
lookupList a (p:ps) | a == fst p = snd p : lookupList a ps
|
||||
| otherwise = lookupList a ps
|
||||
|
||||
-- | Find the first list in a list of lists
|
||||
-- which contains the argument.
|
||||
findSet :: Eq c => c -> [[c]] -> Maybe [c]
|
||||
findSet x = find (x `elem`)
|
||||
|
||||
split :: [a] -> ([a], [a])
|
||||
split (x : y : as) = (x:xs, y:ys)
|
||||
where (xs, ys) = split as
|
||||
@@ -60,6 +67,24 @@ 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
|
||||
|
||||
-- | Like 'nub', but more efficient as it uses sorting internally.
|
||||
sortNub :: Ord a => [a] -> [a]
|
||||
sortNub = map head . group . sort
|
||||
|
||||
-- | 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' :: Eq a => a -> [(a,b)] -> b
|
||||
lookup' x = fromJust . lookup x
|
||||
|
||||
-- * functions on pairs
|
||||
|
||||
mapFst :: (a -> a') -> (a, b) -> (a', b)
|
||||
@@ -68,4 +93,59 @@ mapFst f (a, b) = (f a, b)
|
||||
mapSnd :: (b -> b') -> (a, b) -> (a, b')
|
||||
mapSnd f (a, b) = (a, f b)
|
||||
|
||||
-- * 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)
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user