chorale-0.1.4: A module containing basic functions that the prelude does not offer

Copyright2013-2016 Franz-Benjamin Mocnik
LicenseMIT
Maintainermail@mocnik-science.net
Stabilitystable
Portabilityportable
Safe HaskellSafe
LanguageHaskell2010

Chorale.Common

Contents

Description

 

Synopsis

Applicative

(.*) :: (c -> d) -> (a -> b -> c) -> a -> b -> d infixr 8 Source #

f . g a $ b = (f .* g) a b

(.**) :: (d -> e) -> (a -> b -> c -> d) -> a -> b -> c -> e infixr 8 Source #

f . g a b $ c = (f .** g) a b c

(.***) :: (e -> f) -> (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f infixr 8 Source #

f . g a b c $ d = (f .** g) a b c d

uncurryM2 :: (Functor m, Monad m) => (a -> b -> x) -> (m a, m b) -> m x Source #

uncurry for two monadic arguments

uncurryMM2 :: (Functor m, Monad m) => (a -> b -> m x) -> (m a, m b) -> m x Source #

uncurry for two monadic arguments with monadic function

curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d Source #

curry for three arguments

uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d Source #

uncurry for three arguments

uncurryM3 :: (Functor m, Monad m) => (a -> b -> c -> x) -> (m a, m b, m c) -> m x Source #

uncurry for three monadic arguments

uncurryMM3 :: (Functor m, Monad m) => (a -> b -> c -> m x) -> (m a, m b, m c) -> m x Source #

uncurry for three monadic arguments with monadic function

curry4 :: ((a, b, c, d) -> e) -> a -> b -> c -> d -> e Source #

curry for four arguments

uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e Source #

uncurry for four arguments

uncurryM4 :: (Functor m, Monad m) => (a -> b -> c -> d -> x) -> (m a, m b, m c, m d) -> m x Source #

uncurry for four monadic arguments

uncurryMM4 :: (Functor m, Monad m) => (a -> b -> c -> d -> m x) -> (m a, m b, m c, m d) -> m x Source #

uncurry for four monadic arguments with monadic function

curry5 :: ((a, b, c, d, e) -> f) -> a -> b -> c -> d -> e -> f Source #

curry for five arguments

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f Source #

uncurry for five arguments

uncurryM5 :: (Functor m, Monad m) => (a -> b -> c -> d -> e -> x) -> (m a, m b, m c, m d, m e) -> m x Source #

uncurry for five monadic arguments

uncurryMM5 :: (Functor m, Monad m) => (a -> b -> c -> d -> e -> m x) -> (m a, m b, m c, m d, m e) -> m x Source #

uncurry for five monadic arguments with monadic function

Tuples

Generating Tuples

appendFst :: a -> b -> (a, b) Source #

append a first argument for making a 2-tuple

appendSnd :: b -> a -> (a, b) Source #

append a second argument for making a 2-tuple

appendFst3 :: a -> (b, c) -> (a, b, c) Source #

append a first argument for making a 3-tuple

appendSnd3 :: b -> (a, c) -> (a, b, c) Source #

append a second argument for making a 3-tuple

appendThd3 :: c -> (a, b) -> (a, b, c) Source #

append a third argument for making a 3-tuple

removeFst3 :: (a, b, c) -> (b, c) Source #

remove first argument of a 3-tuple

removeSnd3 :: (a, b, c) -> (a, c) Source #

remove second argument of a 3-tuple

removeThd3 :: (a, b, c) -> (a, b) Source #

remove third argument of a 3-tuple

appendFst4 :: a -> (b, c, d) -> (a, b, c, d) Source #

append a first argument for making a 4-tuple

appendSnd4 :: b -> (a, c, d) -> (a, b, c, d) Source #

append a second argument for making a 4-tuple

appendThd4 :: c -> (a, b, d) -> (a, b, c, d) Source #

append a third argument for making a 4-tuple

appendFth4 :: d -> (a, b, c) -> (a, b, c, d) Source #

append a fourth argument for making a 4-tuple

removeFst4 :: (a, b, c, d) -> (b, c, d) Source #

remove first argument of a 4-tuple

removeSnd4 :: (a, b, c, d) -> (a, c, d) Source #

remove second argument of a 4-tuple

removeThd4 :: (a, b, c, d) -> (a, b, d) Source #

remove third argument of a 4-tuple

removeFth4 :: (a, b, c, d) -> (a, b, c) Source #

remove fourth argument of a 4-tuple

appendFst5 :: a -> (b, c, d, e) -> (a, b, c, d, e) Source #

append a first argument for making a 5-tuple

appendSnd5 :: b -> (a, c, d, e) -> (a, b, c, d, e) Source #

append a second argument for making a 5-tuple

appendThd5 :: c -> (a, b, d, e) -> (a, b, c, d, e) Source #

append a third argument for making a 5-tuple

appendFourth5 :: d -> (a, b, c, e) -> (a, b, c, d, e) Source #

append a fourth argument for making a 5-tuple

appendFifth5 :: e -> (a, b, c, d) -> (a, b, c, d, e) Source #

append a fifth argument for making a 5-tuple

removeFst5 :: (a, b, c, d, e) -> (b, c, d, e) Source #

remove first argument of a 5-tuple

removeSnd5 :: (a, b, c, d, e) -> (a, c, d, e) Source #

remove second argument of a 5-tuple

removeThd5 :: (a, b, c, d, e) -> (a, b, d, e) Source #

remove third argument of a 5-tuple

removeFourth5 :: (a, b, c, d, e) -> (a, b, c, e) Source #

remove fourth argument of a 5-tuple

removeFifth5 :: (a, b, c, d, e) -> (a, b, c, d) Source #

remove fifth argument of a 5-tuple

make2 :: a -> (a, a) Source #

make a 2-tuple containing the given value in each component

make3 :: a -> (a, a, a) Source #

make a 3-tuple containing the given value in each component

make4 :: a -> (a, a, a, a) Source #

make a 4-tuple containing the given value in each component

make5 :: a -> (a, a, a, a, a) Source #

make a 5-tuple containing the given value in each component

Retrieving the Tuples' Components

fst3 :: (a, b, c) -> a Source #

get the first argument of a 3-tuple

snd3 :: (a, b, c) -> b Source #

get the second argument of a 3-tuple

thd3 :: (a, b, c) -> c Source #

get the third argument of a 3-tuple

fst4 :: (a, b, c, d) -> a Source #

get the first argument of a 4-tuple

snd4 :: (a, b, c, d) -> b Source #

get the second argument of a 4-tuple

thd4 :: (a, b, c, d) -> c Source #

get the third argument of a 4-tuple

fth4 :: (a, b, c, d) -> d Source #

get the fourth argument of a 4-tuple

fst5 :: (a, b, c, d, e) -> a Source #

get the first argument of a 5-tuple

snd5 :: (a, b, c, d, e) -> b Source #

get the second argument of a 5-tuple

thd5 :: (a, b, c, d, e) -> c Source #

get the third argument of a 5-tuple

fourth5 :: (a, b, c, d, e) -> d Source #

get the fourth argument of a 5-tuple

fifth5 :: (a, b, c, d, e) -> e Source #

get the fourth argument of a 5-tuple

Modifying Tuples

tupleToList2 :: (a, a) -> [a] Source #

convert a 2-tuple to a list

listToTuple2 :: [a] -> Maybe (a, a) Source #

convert a 2-tuple to a list

tupleToList3 :: (a, a, a) -> [a] Source #

convert a 3-tuple to a list

listToTuple3 :: [a] -> Maybe (a, a, a) Source #

convert a 3-tuple to a list

tupleToList4 :: (a, a, a, a) -> [a] Source #

convert a 4-tuple to a list

listToTuple4 :: [a] -> Maybe (a, a, a, a) Source #

convert a 4-tuple to a list

tupleToList5 :: (a, a, a, a, a) -> [a] Source #

convert a 5-tuple to a list

listToTuple5 :: [a] -> Maybe (a, a, a, a, a) Source #

convert a 5-tuple to a list

Applying Functions to Tuples

map12 :: (a -> a') -> (a, a) -> (a', a') Source #

apply one function to a 2-tuple

map21 :: (a -> a', a -> a'') -> a -> (a', a'') Source #

apply a 2-tuple of functions to a value

map22 :: (a -> a', b -> b') -> (a, b) -> (a', b') Source #

apply a 2-tuple of functions to a 2-tuple

map13 :: (a -> a') -> (a, a, a) -> (a', a', a') Source #

apply one function to a 3-tuple

map31 :: (a -> a', a -> a'', a -> a''') -> a -> (a', a'', a''') Source #

apply a 3-tuple of functions to a value

map33 :: (a -> a', b -> b', c -> c') -> (a, b, c) -> (a', b', c') Source #

apply a 3-tuple of functions to a 3-tuple

map14 :: (a -> a') -> (a, a, a, a) -> (a', a', a', a') Source #

apply one function to a 4-tuple

map41 :: (a -> a', a -> a'', a -> a''', a -> a'''') -> a -> (a', a'', a''', a'''') Source #

apply a 4-tuple of functions to a value

map44 :: (a -> a', b -> b', c -> c', d -> d') -> (a, b, c, d) -> (a', b', c', d') Source #

apply a 4-tuple of functions to a 4-tuple

map15 :: (a -> a') -> (a, a, a, a, a) -> (a', a', a', a', a') Source #

apply one function to a 5-tuple

map51 :: (a -> a', a -> a'', a -> a''', a -> a'''', a -> a''''') -> a -> (a', a'', a''', a'''', a''''') Source #

apply a 5-tuple of functions to a value

map55 :: (a -> a', b -> b', c -> c', d -> d', e -> e') -> (a, b, c, d, e) -> (a', b', c', d', e') Source #

apply a 5-tuple of functions to a 5-tuple

mapFst :: (a -> a') -> (a, b) -> (a', b) Source #

apply a function to the first argument of a 2-tuple

mapSnd :: (b -> b') -> (a, b) -> (a, b') Source #

apply a function to the second argument of a 2-tuple

Monads and Tuples

sequence2 :: (Functor m, Monad m) => (m a, m b) -> m (a, b) Source #

like sequence but for a 2-tuple

sequence3 :: (Functor m, Monad m) => (m a, m b, m c) -> m (a, b, c) Source #

like sequence but for a 3-tuple

sequence4 :: (Functor m, Monad m) => (m a, m b, m c, m d) -> m (a, b, c, d) Source #

like sequence but for a 4-tuple

sequence5 :: (Functor m, Monad m) => (m a, m b, m c, m d, m e) -> m (a, b, c, d, e) Source #

like sequence but for a 5-tuple

(<<) :: Monad m => m b -> m a -> m b Source #

like >> but with reversed argument

Ordering

compareUsing :: Eq a => [a] -> a -> a -> Ordering Source #

compare function that uses the order in a given list

e.g. compareUsing [1,3,2] will state 1 < 2 and 3 < 2

Comparing and Sorting

vanishes :: (Num a, Eq a) => a -> Bool Source #

tests whether a given number vanishes

equaling :: Eq b => (a -> b) -> a -> a -> Bool Source #

similar to comparing but for equalities

sortAndGroup :: Ord a => [a] -> [[a]] Source #

sort and group

sortAndGroupBy :: Ord b => (a -> b) -> [a] -> [[a]] Source #

sort and than group, non-overloaded version

sortAndGroupLookupBy :: Ord b => (a -> b) -> [a] -> [(b, [a])] Source #

sort and than group to a lookup table

lookupBy :: Eq b => (a -> b) -> b -> [a] -> Maybe a Source #

lookup by using a function

lookupBy f b xs finds the element x which satisfies f x = b

List Operations

notNull :: [a] -> Bool Source #

returns False if a list is empty, otherwise True

takeWhileList :: ([a] -> Bool) -> [a] -> [a] Source #

like takeWhile but the function p takes the whole list as argument

takeUntilList :: ([a] -> Bool) -> [a] -> [a] Source #

similar takeWhileList but returns the the sublist such that p is met the first time

takeToFirst :: (a -> Bool) -> [a] -> [a] Source #

takeToFirst p xs returns the suffix until (and inclusive) the first occurance where p xs

splitOnFirst :: Eq a => a -> [a] -> ([a], Maybe [a]) Source #

like splitOn but splits only at the first occurance

nubOrd :: Ord a => [a] -> [a] Source #

like nub but requires a to be an instance of Ord

The original nub is O(n^2) on lists of length n. nubOrd is O(n log(n)).

nubOrdBy' :: Ord b => (a -> b) -> [a] -> [a] Source #

like nubBy but requires b to be an instance of Ord

nubOrdBy' f = nubBy (equaling f) The original nubBy is O(n^2) on lists of length n. nubOrdBy' is O(n log(n)).

zipWithDefault :: a -> (a -> a -> c) -> [a] -> [a] -> [c] Source #

like zipWith but with a default value such that the resulting list is as long as the longest input list

subset :: Eq a => [a] -> [a] -> Bool Source #

test whether the first list is a subset of the second one

subsets :: [a] -> [[a]] Source #

all subsets for a list

findIndicesTuples :: (a -> Bool) -> [a] -> [([a], Int)] Source #

like findIndices but results a list of tuples (x, i) where x is the list and i the index

replaceInList :: Int -> [a] -> [a] -> [a] Source #

replace the element at the given position by a given list of elements

for just removing the j-th element of a list, use the following function

replaceInList j []

for replacing the j-th element of a list by an element a, use the following function

replaceInList j [a]

replaceElementInList :: Eq a => a -> [a] -> [a] -> [a] Source #

replace all appearances of an element in a list by a given list of elements

removeFromList :: Int -> [a] -> [a] Source #

remove the j-th element from a list

stripPostfix :: Eq a => [a] -> [a] -> Maybe [a] Source #

like stripPrefix but for postfixes

applyToList :: Int -> (a -> a) -> [a] -> [a] Source #

apply a function to the element at the given position in a given list of elements

mapFoldl :: (Maybe c -> a -> (c, b)) -> [a] -> [b] Source #

map a function f to a list; the function results a result value b as well as a value c which can be used for the computation of the next element (i.e. the next f a)

reverseMap :: [a -> b] -> a -> [b] Source #

map an array of functions to a value

count :: (a -> Bool) -> [a] -> Int Source #

count for how many entries the predicate is met

deleteAll :: Eq a => a -> [a] -> [a] Source #

delete all occurances of an element in a list

deleteAlls :: Eq a => [a] -> [a] -> [a] Source #

delete all occurances of a sublist in a list

cartesian :: [a] -> [b] -> [(a, b)] Source #

cartesian product

Boolean Operations

xor :: Bool -> Bool -> Bool Source #

xor function

xnor :: Bool -> Bool -> Bool Source #

xnor function

Number Operations

average :: [Double] -> Double Source #

compute the average of a list of numbers

String Operations

justifyLeft :: Int -> Char -> String -> String Source #

append a char as often as needed in order to return a string of given length where the given string ist justified left

justifyRight :: Int -> Char -> String -> String Source #

append a char as often as needed in order to return a string of given length where the given string ist justified right

Maybe Operations

mapJust :: (a -> b) -> Maybe a -> Maybe b Source #

maps a Just value

onJustUse :: (a -> b -> b) -> Maybe a -> b -> b Source #

uses an endomorphism parametrised by a Just value

Either Operations

mapLeft :: (a -> c) -> Either a b -> Either c b Source #

maps a Left value

mapRight :: (b -> c) -> Either a b -> Either a c Source #

maps a Right value

fromLeft :: Either a b -> a Source #

returns Left value

fromRight :: Either a b -> b Source #

returns Right value

data Either3 a b c Source #

Either-like type for 3 values

Constructors

E1 a 
E2 b 
E3 c