hxt-9.3.1.16: A collection of tools for processing XML with Haskell.

CopyrightCopyright (C) 2005 Uwe Schmidt
LicenseMIT
MaintainerUwe Schmidt (uwe\@fh-wedel.de)
Stabilityexperimental
Portabilityportable
Safe HaskellSafe
LanguageHaskell98

Control.Arrow.ArrowList

Description

The list arrow class

This module defines the interface for list arrows.

A list arrow is a function, that gives a list of results for a given argument. A single element result represents a normal function. An empty list oven indicates, the function is undefined for the given argument. The empty list may also represent False, none empty lists True. A list with more than one element gives all results for a nondeterministic function.

Synopsis

Documentation

class (Arrow a, ArrowPlus a, ArrowZero a, ArrowApply a) => ArrowList a where Source #

The interface for list arrows

Only mkA, isA '(>>.)' don't have default implementations

Minimal complete definition

arrL, isA, (>>.)

Methods

arr2 :: (b1 -> b2 -> c) -> a (b1, b2) c Source #

construction of a 2 argument arrow from a binary function | | example: a1 &&& a2 >>> arr2 f

arr3 :: (b1 -> b2 -> b3 -> c) -> a (b1, (b2, b3)) c Source #

construction of a 3 argument arrow from a 3-ary function | | example: a1 &&& a2 &&& a3 >>> arr3 f

arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> a (b1, (b2, (b3, b4))) c Source #

construction of a 4 argument arrow from a 4-ary function | | example: a1 &&& a2 &&& a3 &&& a4 >>> arr4 f

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

construction of a 2 argument arrow from a singe argument arrow

arrL :: (b -> [c]) -> a b c Source #

constructor for a list arrow from a function with a list as result

arr2L :: (b -> c -> [d]) -> a (b, c) d Source #

constructor for a list arrow with 2 arguments

constA :: c -> a b c Source #

constructor for a const arrow: constA = arr . const

constL :: [c] -> a b c Source #

constructor for a const arrow: constL = arrL . const

isA :: (b -> Bool) -> a b b Source #

builds an arrow from a predicate. If the predicate holds, the single list containing the input is returned, else the empty list

(>>.) :: a b c -> ([c] -> [d]) -> a b d infixl 8 Source #

combinator for converting the result of a list arrow into another list

example: foo >>. reverse reverses the the result of foo

example: foo >>. take 1 constructs a deterministic version of foo by deleting all further results

(>.) :: a b c -> ([c] -> d) -> a b d infixl 8 Source #

combinator for converting the result of an arrow into a single element result

listA :: a b c -> a b [c] Source #

combinator for converting an arrow into a determinstic version with all results collected in a single element list

 listA af = af >>. (:[])

this is useful when the list of results computed by an arrow must be manipulated (e.g. sorted)

example for sorting the results of a filter

collectAndSort         :: a b c -> a b c

collectAndSort collect = listA collect >>> arrL sort

unlistA :: a [b] b Source #

the inverse of listA

 listA af >>> unlistA = af

unlistA is defined as arrL id

this :: a b b Source #

the identity arrow, alias for returnA

none :: a b c Source #

the zero arrow, alias for zeroArrow

withDefault :: a b c -> c -> a b c Source #

converts an arrow, that may fail, into an arrow that always succeeds

example: withDefault none "abc" is equivalent to constA "abc"

single :: a b c -> a b c Source #

makes a list arrow deterministic, the number of results is at most 1

definition

single f = f >>. take 1

examples with strings:

runLA ( single none ) "x" == []
runLA ( single this ) "x" == ["x"]
runLA ( single
        (constA "y"
         <+> this ) ) "x" == ["y"]

applyA :: a b (a b c) -> a b c Source #

compute an arrow from the input and apply the arrow to this input

definition: (f &&& this) >>> app

in a point free style, there is no way to use an argument in 2 places, this is a combinator for simulating this. first the argument is used to compute an arrow, then this new arrow is applied to the input

applyA coresponds to: apply f x = let g = f x in g x

see also: $<, $<<, $<<<, $<<<<, $<$

($<) :: (c -> a b d) -> a b c -> a b d infixl 2 Source #

compute the parameter for an arrow with extra parameters from the input and apply the arrow for all parameter values to the input

a kind of "function call" for arrows, useful for joining arrows

infixl 2 ($<)

definition:

g $< f = applyA (f >>> arr g)

if f fails, the whole arrow fails, e.g. g $< none == none

if f computes n values and g is deterministic, the whole arrow computes n values

examples with simple list arrows with strings

prefixString   :: String -> a String String
prefixString s =  arr (s++)

runLA ( prefixString $< none           ) "x" == []
runLA ( prefixString $< constA "y"     ) "x" == ["yx"]
runLA ( prefixString $< this           ) "x" == ["xx"]
runLA ( prefixString $< constA "y"
                        <+> constA "z" ) "x" == ["yx","zx"]
runLA ( prefixString $< constA "y"
                        <+> this
                        <+> constA "z" ) "x" == ["yx","xx","zx"]

see also: applyA, $<<, $<<<, $<<<<, $<$

($<<) :: (c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d infixl 2 Source #

binary version of $<

example with simple list arrows with strings

infixString    :: String -> String -> a String String
infixString s1 s2
               = arr (\ s -> s1 ++ s ++ s2)

runLA ( infixString $<< constA "y" &&& constA "z" ) "x" = ["yxz"]
runLA ( infixString $<< this &&& this             ) "x" = ["xxx"]
runLA ( infixString $<< constA "y"
                        &&& (constA "z" <+> this) ) "x" = ["yxz", "yxx"]

($<<<) :: (c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d infixl 2 Source #

version of $< for arrows with 3 extra parameters

typical usage

f $<<< g1 &&& g2 &&& g3

($<<<<) :: (c1 -> c2 -> c3 -> c4 -> a b d) -> a b (c1, (c2, (c3, c4))) -> a b d infixl 2 Source #

version of $< for arrows with 4 extra parameters

typical usage

f $<<<< g1 &&& g2 &&& g3 &&& g4

($<$) :: (c -> a b b) -> a b c -> a b b infixl 2 Source #

compute the parameter for an arrow f with an extra parameter by an arrow g and apply all the results from g sequentially to the input

infixl 2 ($<$)

typical usage:

g :: a b c
g = ...

f :: c -> a b b
f x = ... x ...

f $<$ g

f computes the extra parameters for g from the input of type b and g is applied with this parameter to the input. This allows programming in a point wise style in g, which becomes neccessary, when a value is needed more than once.

this combinator is useful, when transforming a single value (document) step by step, with g for collecting the data for all steps, and f for transforming the input step by step

if g is deterministic (computes exactly one result), g $<$ f == g $< f holds

if g fails, f $<$ g == this

if g computes more than one result, f is applied sequentially to the input for every result from g

examples with simple list arrows with strings

prefixString   :: String -> a String String
prefixString s =  arr (s++)

runLA ( prefixString $<$ none                      ) "x" == ["x"]
runLA ( prefixString $<$ constA "y"                ) "x" == ["yx"]
runLA ( prefixString $<$ constA "y" <+> constA "z" ) "x" == ["zyx"]
runLA ( prefixString $<$ constA "y" <+> this
                         <+> constA "z"            ) "x" == ["zxyx"]

example with two extra parameter

g1 :: a b c1
g2 :: a b c2

f          :: (c1, c2) -> a b b
f (x1, x2) =  ... x1 ... x2 ...

f $<$ g1 &&& g2

see also: applyA, $<

mergeA :: (a (a1, b1) a1 -> a (a1, b1) b1 -> a (a1, b1) c) -> a (a1, b1) c Source #

merge the result pairs of an arrow with type a a1 (b1, b2) by combining the tuple components with the op arrow

examples with simple list arrows working on strings and XmlTrees

    a1 :: a String (XmlTree, XmlTree)
    a1 = selem "foo" [this >>> mkText]
         &&&
         selem "bar" [arr (++"0") >>> mkText]

    runLA (a1 >>> mergeA (<+>) >>> xshow this) "42" == ["<foo>42</foo>","<bar>420</bar>"]
    runLA (a1 >>> mergeA (+=)  >>> xshow this) "42" == ["<foo>42<bar>420</bar></foo>"]

see also: applyA, $< and += in class ArrowXml

perform :: a b c -> a b b Source #

useful only for arrows with side effects: perform applies an arrow to the input ignores the result and returns the input

example: ... >>> perform someTraceArrow >>> ...

catA :: [a b c] -> a b c Source #

generalization of arrow combinator <+>

definition: catA = foldl (<+>) none

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

generalization of arrow combinator >>>

definition: seqA = foldl (>>>) this

Instances

ArrowList LA Source # 

Methods

arr2 :: (b1 -> b2 -> c) -> LA (b1, b2) c Source #

arr3 :: (b1 -> b2 -> b3 -> c) -> LA (b1, (b2, b3)) c Source #

arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> LA (b1, (b2, (b3, b4))) c Source #

arr2A :: (b -> LA c d) -> LA (b, c) d Source #

arrL :: (b -> [c]) -> LA b c Source #

arr2L :: (b -> c -> [d]) -> LA (b, c) d Source #

constA :: c -> LA b c Source #

constL :: [c] -> LA b c Source #

isA :: (b -> Bool) -> LA b b Source #

(>>.) :: LA b c -> ([c] -> [d]) -> LA b d Source #

(>.) :: LA b c -> ([c] -> d) -> LA b d Source #

listA :: LA b c -> LA b [c] Source #

unlistA :: LA [b] b Source #

this :: LA b b Source #

none :: LA b c Source #

withDefault :: LA b c -> c -> LA b c Source #

single :: LA b c -> LA b c Source #

applyA :: LA b (LA b c) -> LA b c Source #

($<) :: (c -> LA b d) -> LA b c -> LA b d Source #

($<<) :: (c1 -> c2 -> LA b d) -> LA b (c1, c2) -> LA b d Source #

($<<<) :: (c1 -> c2 -> c3 -> LA b d) -> LA b (c1, (c2, c3)) -> LA b d Source #

($<<<<) :: (c1 -> c2 -> c3 -> c4 -> LA b d) -> LA b (c1, (c2, (c3, c4))) -> LA b d Source #

($<$) :: (c -> LA b b) -> LA b c -> LA b b Source #

mergeA :: (LA (a1, b1) a1 -> LA (a1, b1) b1 -> LA (a1, b1) c) -> LA (a1, b1) c Source #

perform :: LA b c -> LA b b Source #

catA :: [LA b c] -> LA b c Source #

seqA :: [LA b b] -> LA b b Source #

ArrowList IOLA Source # 

Methods

arr2 :: (b1 -> b2 -> c) -> IOLA (b1, b2) c Source #

arr3 :: (b1 -> b2 -> b3 -> c) -> IOLA (b1, (b2, b3)) c Source #

arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> IOLA (b1, (b2, (b3, b4))) c Source #

arr2A :: (b -> IOLA c d) -> IOLA (b, c) d Source #

arrL :: (b -> [c]) -> IOLA b c Source #

arr2L :: (b -> c -> [d]) -> IOLA (b, c) d Source #

constA :: c -> IOLA b c Source #

constL :: [c] -> IOLA b c Source #

isA :: (b -> Bool) -> IOLA b b Source #

(>>.) :: IOLA b c -> ([c] -> [d]) -> IOLA b d Source #

(>.) :: IOLA b c -> ([c] -> d) -> IOLA b d Source #

listA :: IOLA b c -> IOLA b [c] Source #

unlistA :: IOLA [b] b Source #

this :: IOLA b b Source #

none :: IOLA b c Source #

withDefault :: IOLA b c -> c -> IOLA b c Source #

single :: IOLA b c -> IOLA b c Source #

applyA :: IOLA b (IOLA b c) -> IOLA b c Source #

($<) :: (c -> IOLA b d) -> IOLA b c -> IOLA b d Source #

($<<) :: (c1 -> c2 -> IOLA b d) -> IOLA b (c1, c2) -> IOLA b d Source #

($<<<) :: (c1 -> c2 -> c3 -> IOLA b d) -> IOLA b (c1, (c2, c3)) -> IOLA b d Source #

($<<<<) :: (c1 -> c2 -> c3 -> c4 -> IOLA b d) -> IOLA b (c1, (c2, (c3, c4))) -> IOLA b d Source #

($<$) :: (c -> IOLA b b) -> IOLA b c -> IOLA b b Source #

mergeA :: (IOLA (a1, b1) a1 -> IOLA (a1, b1) b1 -> IOLA (a1, b1) c) -> IOLA (a1, b1) c Source #

perform :: IOLA b c -> IOLA b b Source #

catA :: [IOLA b c] -> IOLA b c Source #

seqA :: [IOLA b b] -> IOLA b b Source #

ArrowList (SLA s) Source # 

Methods

arr2 :: (b1 -> b2 -> c) -> SLA s (b1, b2) c Source #

arr3 :: (b1 -> b2 -> b3 -> c) -> SLA s (b1, (b2, b3)) c Source #

arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> SLA s (b1, (b2, (b3, b4))) c Source #

arr2A :: (b -> SLA s c d) -> SLA s (b, c) d Source #

arrL :: (b -> [c]) -> SLA s b c Source #

arr2L :: (b -> c -> [d]) -> SLA s (b, c) d Source #

constA :: c -> SLA s b c Source #

constL :: [c] -> SLA s b c Source #

isA :: (b -> Bool) -> SLA s b b Source #

(>>.) :: SLA s b c -> ([c] -> [d]) -> SLA s b d Source #

(>.) :: SLA s b c -> ([c] -> d) -> SLA s b d Source #

listA :: SLA s b c -> SLA s b [c] Source #

unlistA :: SLA s [b] b Source #

this :: SLA s b b Source #

none :: SLA s b c Source #

withDefault :: SLA s b c -> c -> SLA s b c Source #

single :: SLA s b c -> SLA s b c Source #

applyA :: SLA s b (SLA s b c) -> SLA s b c Source #

($<) :: (c -> SLA s b d) -> SLA s b c -> SLA s b d Source #

($<<) :: (c1 -> c2 -> SLA s b d) -> SLA s b (c1, c2) -> SLA s b d Source #

($<<<) :: (c1 -> c2 -> c3 -> SLA s b d) -> SLA s b (c1, (c2, c3)) -> SLA s b d Source #

($<<<<) :: (c1 -> c2 -> c3 -> c4 -> SLA s b d) -> SLA s b (c1, (c2, (c3, c4))) -> SLA s b d Source #

($<$) :: (c -> SLA s b b) -> SLA s b c -> SLA s b b Source #

mergeA :: (SLA s (a1, b1) a1 -> SLA s (a1, b1) b1 -> SLA s (a1, b1) c) -> SLA s (a1, b1) c Source #

perform :: SLA s b c -> SLA s b b Source #

catA :: [SLA s b c] -> SLA s b c Source #

seqA :: [SLA s b b] -> SLA s b b Source #

ArrowList (IOSLA s) Source # 

Methods

arr2 :: (b1 -> b2 -> c) -> IOSLA s (b1, b2) c Source #

arr3 :: (b1 -> b2 -> b3 -> c) -> IOSLA s (b1, (b2, b3)) c Source #

arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> IOSLA s (b1, (b2, (b3, b4))) c Source #

arr2A :: (b -> IOSLA s c d) -> IOSLA s (b, c) d Source #

arrL :: (b -> [c]) -> IOSLA s b c Source #

arr2L :: (b -> c -> [d]) -> IOSLA s (b, c) d Source #

constA :: c -> IOSLA s b c Source #

constL :: [c] -> IOSLA s b c Source #

isA :: (b -> Bool) -> IOSLA s b b Source #

(>>.) :: IOSLA s b c -> ([c] -> [d]) -> IOSLA s b d Source #

(>.) :: IOSLA s b c -> ([c] -> d) -> IOSLA s b d Source #

listA :: IOSLA s b c -> IOSLA s b [c] Source #

unlistA :: IOSLA s [b] b Source #

this :: IOSLA s b b Source #

none :: IOSLA s b c Source #

withDefault :: IOSLA s b c -> c -> IOSLA s b c Source #

single :: IOSLA s b c -> IOSLA s b c Source #

applyA :: IOSLA s b (IOSLA s b c) -> IOSLA s b c Source #

($<) :: (c -> IOSLA s b d) -> IOSLA s b c -> IOSLA s b d Source #

($<<) :: (c1 -> c2 -> IOSLA s b d) -> IOSLA s b (c1, c2) -> IOSLA s b d Source #

($<<<) :: (c1 -> c2 -> c3 -> IOSLA s b d) -> IOSLA s b (c1, (c2, c3)) -> IOSLA s b d Source #

($<<<<) :: (c1 -> c2 -> c3 -> c4 -> IOSLA s b d) -> IOSLA s b (c1, (c2, (c3, c4))) -> IOSLA s b d Source #

($<$) :: (c -> IOSLA s b b) -> IOSLA s b c -> IOSLA s b b Source #

mergeA :: (IOSLA s (a1, b1) a1 -> IOSLA s (a1, b1) b1 -> IOSLA s (a1, b1) c) -> IOSLA s (a1, b1) c Source #

perform :: IOSLA s b c -> IOSLA s b b Source #

catA :: [IOSLA s b c] -> IOSLA s b c Source #

seqA :: [IOSLA s b b] -> IOSLA s b b Source #