Copyright | Copyright (C) 2005 Uwe Schmidt |
---|---|
License | MIT |
Maintainer | Uwe Schmidt (uwe\@fh-wedel.de) |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Conditionals for List Arrows
This module defines conditional combinators for list arrows.
The empty list as result represents False, none empty lists True.
Synopsis
- data IfThen a b = a :-> b
- class ArrowList a => ArrowIf a where
- ifA :: a b c -> a b d -> a b d -> a b d
- ifP :: (b -> Bool) -> a b d -> a b d -> a b d
- neg :: a b c -> a b b
- when :: a b b -> a b c -> a b b
- whenP :: a b b -> (b -> Bool) -> a b b
- whenNot :: a b b -> a b c -> a b b
- whenNotP :: a b b -> (b -> Bool) -> a b b
- guards :: a b c -> a b d -> a b d
- guardsP :: (b -> Bool) -> a b d -> a b d
- filterA :: a b c -> a b b
- containing :: a b c -> a c d -> a b c
- notContaining :: a b c -> a c d -> a b c
- orElse :: a b c -> a b c -> a b c
- choiceA :: [IfThen (a b c) (a b d)] -> a b d
- tagA :: a b c -> a b (Either b b)
- spanA :: a b b -> a [b] ([b], [b])
- partitionA :: a b b -> a [b] ([b], [b])
Documentation
class ArrowList a => ArrowIf a where Source #
The interface for arrows as conditionals.
Requires list arrows because False is represented as empty list, True as none empty lists.
ifA :: a b c -> a b d -> a b d -> a b d Source #
if lifted to arrows
ifP :: (b -> Bool) -> a b d -> a b d -> a b d Source #
shortcut: ifP p = ifA (isA p)
neg :: a b c -> a b b Source #
negation: neg f = ifA f none this
when :: a b b -> a b c -> a b b Source #
f `when` g
: when the predicate g holds, f is applied, else the identity filter this
whenP :: a b b -> (b -> Bool) -> a b b Source #
shortcut: f `whenP` p = f `when` (isA p)
whenNot :: a b b -> a b c -> a b b Source #
f `whenNot` g
: when the predicate g does not hold, f is applied, else the identity filter this
whenNotP :: a b b -> (b -> Bool) -> a b b Source #
like whenP
guards :: a b c -> a b d -> a b d Source #
g `guards` f
: when the predicate g holds, f is applied, else none
guardsP :: (b -> Bool) -> a b d -> a b d Source #
like whenP
filterA :: a b c -> a b b Source #
shortcut for f
guards
this
containing :: a b c -> a c d -> a b c Source #
f `containing` g
: keep only those results from f for which g holds
definition: f `containing` g = f >>> g `guards` this
notContaining :: a b c -> a c d -> a b c Source #
f `notContaining` g
: keep only those results from f for which g does not hold
definition: f `notContaining` g = f >>> ifA g none this
orElse :: a b c -> a b c -> a b c Source #
f `orElse` g
: directional choice: if f succeeds, the result of f is the result, else g is applied
choiceA :: [IfThen (a b c) (a b d)] -> a b d Source #
generalisation of orElse
for multi way branches like in case expressions.
An auxiliary data type IfThen
with an infix constructor :->
is used for writing multi way branches
example: choiceA [ p1 :-> e1, p2 :-> e2, this :-> default ]
tagA :: a b c -> a b (Either b b) Source #
tag a value with Left or Right, if arrow has success, input is tagged with Left, else with Right
spanA :: a b b -> a [b] ([b], [b]) Source #
split a list value with an arrow and returns a pair of lists.
This is the arrow version of span
. The arrow is deterministic.
example: runLA (spanA (isA (/= '-'))) "abc-def"
gives [("abc","-def")]
as result
partitionA :: a b b -> a [b] ([b], [b]) Source #
partition a list of values into a pair of lists
This is the arrow Version of partition
Instances
ArrowIf LA Source # | |
Defined in Control.Arrow.ListArrow ifA :: LA b c -> LA b d -> LA b d -> LA b d Source # ifP :: (b -> Bool) -> LA b d -> LA b d -> LA b d Source # neg :: LA b c -> LA b b Source # when :: LA b b -> LA b c -> LA b b Source # whenP :: LA b b -> (b -> Bool) -> LA b b Source # whenNot :: LA b b -> LA b c -> LA b b Source # whenNotP :: LA b b -> (b -> Bool) -> LA b b Source # guards :: LA b c -> LA b d -> LA b d Source # guardsP :: (b -> Bool) -> LA b d -> LA b d Source # filterA :: LA b c -> LA b b Source # containing :: LA b c -> LA c d -> LA b c Source # notContaining :: LA b c -> LA c d -> LA b c Source # orElse :: LA b c -> LA b c -> LA b c Source # choiceA :: [IfThen (LA b c) (LA b d)] -> LA b d Source # tagA :: LA b c -> LA b (Either b b) Source # spanA :: LA b b -> LA [b] ([b], [b]) Source # partitionA :: LA b b -> LA [b] ([b], [b]) Source # | |
ArrowIf IOLA Source # | |
Defined in Control.Arrow.IOListArrow ifA :: IOLA b c -> IOLA b d -> IOLA b d -> IOLA b d Source # ifP :: (b -> Bool) -> IOLA b d -> IOLA b d -> IOLA b d Source # neg :: IOLA b c -> IOLA b b Source # when :: IOLA b b -> IOLA b c -> IOLA b b Source # whenP :: IOLA b b -> (b -> Bool) -> IOLA b b Source # whenNot :: IOLA b b -> IOLA b c -> IOLA b b Source # whenNotP :: IOLA b b -> (b -> Bool) -> IOLA b b Source # guards :: IOLA b c -> IOLA b d -> IOLA b d Source # guardsP :: (b -> Bool) -> IOLA b d -> IOLA b d Source # filterA :: IOLA b c -> IOLA b b Source # containing :: IOLA b c -> IOLA c d -> IOLA b c Source # notContaining :: IOLA b c -> IOLA c d -> IOLA b c Source # orElse :: IOLA b c -> IOLA b c -> IOLA b c Source # choiceA :: [IfThen (IOLA b c) (IOLA b d)] -> IOLA b d Source # tagA :: IOLA b c -> IOLA b (Either b b) Source # spanA :: IOLA b b -> IOLA [b] ([b], [b]) Source # partitionA :: IOLA b b -> IOLA [b] ([b], [b]) Source # | |
ArrowIf (SLA s) Source # | |
Defined in Control.Arrow.StateListArrow ifA :: SLA s b c -> SLA s b d -> SLA s b d -> SLA s b d Source # ifP :: (b -> Bool) -> SLA s b d -> SLA s b d -> SLA s b d Source # neg :: SLA s b c -> SLA s b b Source # when :: SLA s b b -> SLA s b c -> SLA s b b Source # whenP :: SLA s b b -> (b -> Bool) -> SLA s b b Source # whenNot :: SLA s b b -> SLA s b c -> SLA s b b Source # whenNotP :: SLA s b b -> (b -> Bool) -> SLA s b b Source # guards :: SLA s b c -> SLA s b d -> SLA s b d Source # guardsP :: (b -> Bool) -> SLA s b d -> SLA s b d Source # filterA :: SLA s b c -> SLA s b b Source # containing :: SLA s b c -> SLA s c d -> SLA s b c Source # notContaining :: SLA s b c -> SLA s c d -> SLA s b c Source # orElse :: SLA s b c -> SLA s b c -> SLA s b c Source # choiceA :: [IfThen (SLA s b c) (SLA s b d)] -> SLA s b d Source # tagA :: SLA s b c -> SLA s b (Either b b) Source # spanA :: SLA s b b -> SLA s [b] ([b], [b]) Source # partitionA :: SLA s b b -> SLA s [b] ([b], [b]) Source # | |
ArrowIf (IOSLA s) Source # | |
Defined in Control.Arrow.IOStateListArrow ifA :: IOSLA s b c -> IOSLA s b d -> IOSLA s b d -> IOSLA s b d Source # ifP :: (b -> Bool) -> IOSLA s b d -> IOSLA s b d -> IOSLA s b d Source # neg :: IOSLA s b c -> IOSLA s b b Source # when :: IOSLA s b b -> IOSLA s b c -> IOSLA s b b Source # whenP :: IOSLA s b b -> (b -> Bool) -> IOSLA s b b Source # whenNot :: IOSLA s b b -> IOSLA s b c -> IOSLA s b b Source # whenNotP :: IOSLA s b b -> (b -> Bool) -> IOSLA s b b Source # guards :: IOSLA s b c -> IOSLA s b d -> IOSLA s b d Source # guardsP :: (b -> Bool) -> IOSLA s b d -> IOSLA s b d Source # filterA :: IOSLA s b c -> IOSLA s b b Source # containing :: IOSLA s b c -> IOSLA s c d -> IOSLA s b c Source # notContaining :: IOSLA s b c -> IOSLA s c d -> IOSLA s b c Source # orElse :: IOSLA s b c -> IOSLA s b c -> IOSLA s b c Source # choiceA :: [IfThen (IOSLA s b c) (IOSLA s b d)] -> IOSLA s b d Source # tagA :: IOSLA s b c -> IOSLA s b (Either b b) Source # spanA :: IOSLA s b b -> IOSLA s [b] ([b], [b]) Source # partitionA :: IOSLA s b b -> IOSLA s [b] ([b], [b]) Source # |