tuple-th-0.2.5: Generate (non-recursive) utility functions for tuples of statically known size

Safe HaskellNone
LanguageHaskell98

TupleTH

Contents

Description

Note: One-tuples are currently understood as just the original type by Template Haskell (though this could be an undefined case which is not guaranteed to work this way?), so for example, we get

 $(catTuples 1 2) = \x (y,z) -> (x,y,z)

Synopsis

Transformation

mapTuple :: Int -> ExpQ Source

Type of the generated expression:

(a -> b) -> (a, ..) -> (b, ..)

mapTuple' :: Int -> ExpQ -> Q Exp Source

Takes the mapping as a quoted expression. This can sometimes produce an expression that typechecks when the analogous expression using filterTuple does not, e.g.:

$(mapTuple 2) Just        ((),"foo") -- Type error
$(mapTuple' 2 [| Just |]) ((),"foo") -- OK

filterTuple :: Int -> ExpQ Source

Type of the generated expression:

(a -> Bool) -> (a, ..) -> [a]

filterTuple' :: Int -> ExpQ -> ExpQ Source

Takes the predicate as a quoted expression. See mapTuple' for how this can be useful.

reindexTuple :: Int -> [Int] -> Q Exp Source

reindexTuple n js =>

\(x_0, ..., x_{n-1}) -> (x_{js !! 0}, x_{js !! 1}, ... x_{last js})

For example,

$(reindexTuple 3 [1,1,0,0]) ('a','b','c') == ('b','b','a','a')

Each element of js must be nonnegative and less than n.

rotateTuple :: Int -> Int -> Q Exp Source

rotateTuple n k creates a function which rotates an n-tuple rightwards by k positions (k may be negative or greater than n-1).

subtuples :: Int -> Int -> Q Exp Source

Generates the function which maps a tuple (x_1, ..., x_n) to the tuple of all its subtuples of the form (x_{i_1}, ..., x_{i_k}), where i_1 < i_2 < ... < i_k.

deleteAtTuple :: Int -> Q Exp Source

Generates a function which takes a Num i and a homogenous tuple of size n and deletes the i-th (0-based) element of the tuple.

takeTuple :: Int -> Int -> Q Exp Source

takeTuple n i = \(x_0, ..., x_{n-1}) -> (x_0, ..., x_{i-1})

dropTuple :: Int -> Int -> Q Exp Source

dropTuple n i = \(x_0, ..., x_{n-1}) -> (x_i, ..., x_{n-1})

safeDeleteTuple :: Int -> Q Exp Source

safeDeleteTuple n generates a function analogous to delete that takes an element and an n-tuple and maybe returns an n-1-tuple (if and only if the element was found).

updateAtN Source

Arguments

:: Int

Length of the input tuple

-> Int

0-based index of the element to be modified

-> Q Exp

(b -> c) -> (a1,a2,b,a3,a4) -> (a1,a2,c,a3,a4)

Generates a function modifying a single element of a tuple.

Combination

zipTuple :: Int -> Q Exp Source

Like zip.

Type of the generated expression:

(a1, a2, ..) -> (b1, b2, ..) -> ((a1,b1), (a2,b2), ..)

catTuples :: Int -> Int -> Q Exp Source

Type of the generated expression:

(a1, ..) -> (b1, ..) -> (a1, .., b1, ..)

uncatTuple :: Int -> Int -> Q Exp Source

uncatTuple n m = splitTupleAt (n+m) n

uncatTuple n m is the inverse function of uncurry (catTuples n m).

splitTupleAt :: Int -> Int -> Q Exp Source

splitTupleAt n i => \(x_0, ..., x_{n-1}) -> ((x_0, ..., x_{i-1}),(x_i, ..., x_{n-1})

ZipWith

zipTupleWith :: Int -> ExpQ Source

Like zipWith.

Type of the generated expression:

(a -> b -> c) -> (a, ..) -> (b, ..) -> (c, ..)

zipTupleWith' :: Int -> ExpQ -> ExpQ Source

Takes the zipping function as a quoted expression. See mapTuple' for how this can be useful.

Construction

safeTupleFromList :: Int -> Q Exp Source

Type of the generated expression:

[a] -> Maybe (a, ..)

tupleFromList :: Int -> Q Exp Source

Type of the generated expression:

[a] -> (a, ..)

The generated function is partial.

Deconstruction

proj Source

Arguments

:: Int

Size of tuple

-> Int

0-based index of component to retrieve

-> ExpQ 
Generate a projection (like 'fst' and 'snd').

proj' :: Int -> Q Exp Source

Like proj, but takes the index argument as the first argument at runtime and returns a Maybe.

>>> :t $(proj' 3)
$(proj' 3) :: Num a => (a1, a1, a1) -> a -> Maybe a1

elemTuple :: Int -> Q Exp Source

Like elem.

Type of generated expression:

Eq a => a -> (a, ..) -> Bool

findSuccessiveElementsSatisfying :: Int -> Q Exp Source

Generates a function that takes a binary relation and a tuple xs, and returns Just the first index i such that the relation holds for x_i, x_{i+1}, or Nothing.

>>> :t $(findSuccessiveElementsSatisfying 4)
$(findSuccessiveElementsSatisfying 4)
  :: (t -> t -> Bool) -> (t, t, t, t) -> Maybe Int

Right folds

foldrTuple :: Int -> ExpQ Source

Type of the generated expression:

(a -> r -> r) -> r -> (a, ..) -> r

foldrTuple' :: Int -> ExpQ -> ExpQ Source

Takes the folding function (but not the seed element) as a quoted expression. See mapTuple' for how this can be useful.

foldr1Tuple :: Int -> ExpQ Source

Type of the generated expression:

(a -> a -> a) -> (a, ..) -> a

foldr1Tuple' :: Int -> ExpQ -> Q Exp Source

Takes the folding function as a quoted expression. See mapTuple' for how this can be useful.

Left folds

foldlTuple :: Int -> ExpQ Source

Type of the generated expression:

(r -> a -> r) -> r -> (a, ..) -> r

foldlTuple' :: Int -> ExpQ -> ExpQ Source

Takes the folding function (but not the seed element) as a quoted expression. See mapTuple' for how this can be useful.

foldl1Tuple :: Int -> ExpQ Source

Type of the generated expression:

(a -> a -> a) -> (a, ..) -> a

foldl1Tuple' :: Int -> ExpQ -> Q Exp Source

Takes the folding function as a quoted expression. See mapTuple' for how this can be useful.

Predicates

andTuple :: Int -> Q Exp Source

Like and.

orTuple :: Int -> Q Exp Source

Like or.

anyTuple :: Int -> Q Exp Source

Like any.

allTuple :: Int -> Q Exp Source

Like all.

Monadic/applicative

sequenceATuple :: Int -> Q Exp Source

Like sequenceA.

Types

htuple :: Int -> TypeQ -> TypeQ Source

Makes a homogenous tuple type of the given size and element type

$(htuple 2) [t| Char |] = (Char,Char)