Safe Haskell | Safe |
---|---|
Language | Haskell98 |
- module CHR.Utils
- unionMapSet :: Ord b => (a -> Set b) -> Set a -> Set b
- inverseMap :: (Ord k, Ord v') => (k -> v -> (v', k')) -> Map k v -> Map v' k'
- showStringMapKeys :: Map String x -> String -> String
- mapLookup2' :: (Ord k1, Ord k2) => (v1 -> Map k2 v2) -> k1 -> k2 -> Map k1 v1 -> Maybe (Map k2 v2, v2)
- mapLookup2 :: (Ord k1, Ord k2) => k1 -> k2 -> Map k1 (Map k2 v2) -> Maybe v2
- hdAndTl' :: a -> [a] -> (a, [a])
- hdAndTl :: [a] -> (a, [a])
- wordsBy :: (a -> Bool) -> [a] -> [[a]]
- initlast :: [a] -> Maybe ([a], a)
- initlast2 :: [a] -> Maybe ([a], a, a)
- last' :: a -> [a] -> a
- firstNotEmpty :: [[x]] -> [x]
- listSaturate :: (Enum a, Ord a) => a -> a -> (x -> a) -> (a -> x) -> [x] -> [x]
- listSaturateWith :: (Enum a, Ord a) => a -> a -> (x -> a) -> [(a, x)] -> [x] -> [x]
- spanOnRest :: ([a] -> Bool) -> [a] -> ([a], [a])
- filterMb :: (a -> Maybe b) -> [a] -> [b]
- partitionOnSplit :: (a -> (x, y)) -> (x -> x') -> (x -> Bool) -> [a] -> ([(x', y)], [y])
- tup123to1 :: (a, b, c) -> a
- tup123to2 :: (a, b, c) -> b
- tup123to12 :: (a, b, c) -> (a, b)
- tup123to23 :: (a1, a2, b) -> (a2, b)
- tup12to123 :: c -> (a, b) -> (a, b, c)
- fst3 :: (a, b, c) -> a
- snd3 :: (a, b, c) -> b
- thd3 :: (a, b, c) -> c
- thd :: (a, b, c) -> c
- tup1234to1 :: (a, b, c, d) -> a
- tup1234to2 :: (a, b, c, d) -> b
- tup1234to3 :: (a, b, c, d) -> c
- tup1234to4 :: (a, b, c, d) -> d
- tup1234to12 :: (a, b, c, d) -> (a, b)
- tup1234to13 :: (a, b1, b2, d) -> (a, b2)
- tup1234to14 :: (a, b1, c, b2) -> (a, b2)
- tup1234to23 :: (a1, a2, b, d) -> (a2, b)
- tup1234to24 :: (a1, a2, c, b) -> (a2, b)
- tup1234to34 :: (a1, b1, a2, b2) -> (a2, b2)
- tup1234to123 :: (a, b, c, d) -> (a, b, c)
- tup1234to234 :: (a1, a2, b, c) -> (a2, b, c)
- tup1234to124 :: (a, b, c1, c2) -> (a, b, c2)
- tup1234to134 :: (a, b1, b2, c) -> (a, b2, c)
- tup123to1234 :: d -> (a, b, c) -> (a, b, c, d)
- fst4 :: (a, b, c, d) -> a
- snd4 :: (a, b, c, d) -> b
- thd4 :: (a, b, c, d) -> c
- fth4 :: (a, b, c, d) -> d
- fth :: (a, b, c, d) -> d
- strWhite :: Int -> String
- strPad :: String -> Int -> String
- strCapitalize :: String -> String
- strToLower :: String -> String
- strToInt :: String -> Int
- splitForQualified :: String -> [String]
- showUnprefixedWithShowTypeable :: (Show x, Typeable x) => Int -> x -> String
- class DataAndConName x where
- showUnprefixed :: DataAndConName x => Int -> x -> String
- nubOn :: Eq b => (a -> b) -> [a] -> [a]
- consecutiveBy :: (a -> a -> Bool) -> [a] -> [[a]]
- partitionAndRebuild :: (v -> Bool) -> [v] -> ([v], [v], [v'] -> [v'] -> [v'])
- ($?) :: (a -> Maybe b) -> Maybe a -> Maybe b
- orMb :: Maybe a -> Maybe a -> Maybe a
- maybeAnd :: x -> (a -> b -> x) -> Maybe a -> Maybe b -> x
- maybeOr :: x -> (a -> x) -> (b -> x) -> Maybe a -> Maybe b -> x
- scc :: Ord n => [(n, [n])] -> [[n]]
- firstMaybeM :: Monad m => a -> [a -> m (Maybe a)] -> m a
- breakM :: Monad m => (a -> Bool) -> [m a] -> m ([a], Maybe (a, [m a]))
Documentation
module CHR.Utils
Set
unionMapSet :: Ord b => (a -> Set b) -> Set a -> Set b Source #
Union a set where each element itself is mapped to a set
Map
inverseMap :: (Ord k, Ord v') => (k -> v -> (v', k')) -> Map k v -> Map v' k' Source #
Inverse of a map
mapLookup2' :: (Ord k1, Ord k2) => (v1 -> Map k2 v2) -> k1 -> k2 -> Map k1 v1 -> Maybe (Map k2 v2, v2) Source #
double lookup, with transformer for 2nd map
List
firstNotEmpty :: [[x]] -> [x] Source #
First non empty list of list of lists
listSaturate :: (Enum a, Ord a) => a -> a -> (x -> a) -> (a -> x) -> [x] -> [x] Source #
Saturate a list, that is: for all indices i between min and max, if there is no listelement x for which get x returns i, add an element mk i to the list
listSaturateWith :: (Enum a, Ord a) => a -> a -> (x -> a) -> [(a, x)] -> [x] -> [x] Source #
Saturate a list with values from assoc list, that is: for all indices i between min and max, if there is no listelement x for which get x returns i, add a candidate from the associationlist (which must be present) to the list
spanOnRest :: ([a] -> Bool) -> [a] -> ([a], [a]) Source #
filterMb :: (a -> Maybe b) -> [a] -> [b] Source #
variant on filter
, where predicate also yields a result
partitionOnSplit :: (a -> (x, y)) -> (x -> x') -> (x -> Bool) -> [a] -> ([(x', y)], [y]) Source #
Partition on part of something, yielding a something else in the partitioning
Tuple
tup123to12 :: (a, b, c) -> (a, b) Source #
tup123to23 :: (a1, a2, b) -> (a2, b) Source #
tup12to123 :: c -> (a, b) -> (a, b, c) Source #
tup1234to1 :: (a, b, c, d) -> a Source #
tup1234to2 :: (a, b, c, d) -> b Source #
tup1234to3 :: (a, b, c, d) -> c Source #
tup1234to4 :: (a, b, c, d) -> d Source #
tup1234to12 :: (a, b, c, d) -> (a, b) Source #
tup1234to13 :: (a, b1, b2, d) -> (a, b2) Source #
tup1234to14 :: (a, b1, c, b2) -> (a, b2) Source #
tup1234to23 :: (a1, a2, b, d) -> (a2, b) Source #
tup1234to24 :: (a1, a2, c, b) -> (a2, b) Source #
tup1234to34 :: (a1, b1, a2, b2) -> (a2, b2) Source #
tup1234to123 :: (a, b, c, d) -> (a, b, c) Source #
tup1234to234 :: (a1, a2, b, c) -> (a2, b, c) Source #
tup1234to124 :: (a, b, c1, c2) -> (a, b, c2) Source #
tup1234to134 :: (a, b1, b2, c) -> (a, b2, c) Source #
tup123to1234 :: d -> (a, b, c) -> (a, b, c, d) Source #
String
strCapitalize :: String -> String Source #
Capitalize first letter
strToLower :: String -> String Source #
Lower case
splitForQualified :: String -> [String] Source #
Split into fragments based on .
convention for qualified Haskell names
Show utils
showUnprefixedWithShowTypeable :: (Show x, Typeable x) => Int -> x -> String Source #
Show, additionally removing type name prefix, assuming constructor names are prefixed with type name, possibly with additional underscore (or something like that)
class DataAndConName x where Source #
showUnprefixed :: DataAndConName x => Int -> x -> String Source #
Show, additionally removing type name prefix, assuming constructor names are prefixed with type name, possibly with additional underscore (or something like that)
Ordering
Misc
consecutiveBy :: (a -> a -> Bool) -> [a] -> [[a]] Source #
The consecutiveBy
function groups like groupBy, but based on a function which says whether 2 elements are consecutive
partitionAndRebuild :: (v -> Bool) -> [v] -> ([v], [v], [v'] -> [v'] -> [v']) Source #
Partition, but also return a function which will rebuild according to the original ordering of list elements
Maybe
Graph
Monad
firstMaybeM :: Monad m => a -> [a -> m (Maybe a)] -> m a Source #
loop over monads yielding a Maybe from a start value, yielding the first Just or the start (when no Just is returned)