-- ------------------------------------------------------------
{- |
Module : Control.Arrow.ArrowList
Copyright : Copyright (C) 2005 Uwe Schmidt
License : MIT
Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
Stability : experimental
Portability: portable
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.
-}
-- ------------------------------------------------------------
module Control.Arrow.ArrowList
( ArrowList(..)
)
where
import Control.Arrow
infixl 8 >>., >.
infixl 2 $<, $<<, $<<<, $<<<<
infixl 2 $<$
-- ------------------------------------------------------------
-- | The interface for list arrows
--
-- Only 'mkA', 'isA' '(>>.)' don't have default implementations
class (Arrow a, ArrowPlus a, ArrowZero a, ArrowApply a) => ArrowList a where
-- | construction of a 2 argument arrow from a binary function
-- |
-- | example: @ a1 &&& a2 >>> arr2 f @
arr2 :: (b1 -> b2 -> c) -> a (b1, b2) c
arr2 = arr . uncurry
{-# INLINE arr2 #-}
-- | construction of a 3 argument arrow from a 3-ary function
-- |
-- | example: @ a1 &&& a2 &&& a3 >>> arr3 f @
arr3 :: (b1 -> b2 -> b3 -> c) -> a (b1, (b2, b3)) c
arr3 f = arr (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)
{-# INLINE arr3 #-}
-- | construction of a 4 argument arrow from a 4-ary function
-- |
-- | example: @ a1 &&& a2 &&& a3 &&& a4 >>> arr4 f @
arr4 :: (b1 -> b2 -> b3 -> b4 -> c) -> a (b1, (b2, (b3, b4))) c
arr4 f = arr (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)
{-# INLINE arr4 #-}
-- | construction of a 2 argument arrow from a singe argument arrow
arr2A :: (b -> a c d) -> a (b, c) d
arr2A f = first (arr f) >>> app
{-# INLINE arr2A #-}
-- | constructor for a list arrow from a function with a list as result
arrL :: (b -> [c]) -> a b c
-- | constructor for a list arrow with 2 arguments
arr2L :: (b -> c -> [d]) -> a (b, c) d
arr2L = arrL . uncurry
{-# INLINE arr2L #-}
-- | constructor for a const arrow: @ constA = arr . const @
constA :: c -> a b c
constA = arr . const
{-# INLINE constA #-}
-- | constructor for a const arrow: @ constL = arrL . const @
constL :: [c] -> a b c
constL = arrL . const
{-# INLINE constL #-}
-- | builds an arrow from a predicate.
-- If the predicate holds, the single list containing the input is returned, else the empty list
isA :: (b -> Bool) -> a b b
-- | 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
-- | combinator for converting the result of an arrow into a single element result
(>.) :: a b c -> ([c] -> d ) -> a b d
af >. f = af >>. ((:[]) . f)
{-# INLINE (>.) #-}
-- | 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
listA :: a b c -> a b [c]
listA af = af >>. (:[])
{-# INLINE listA #-}
-- | the inverse of 'listA'
--
-- @ listA af >>> unlistA = af @
--
-- unlistA is defined as @ arrL id @
unlistA :: a [b] b
unlistA = arrL id
{-# INLINE unlistA #-}
-- | the identity arrow, alias for returnA
this :: a b b
this = returnA
{-# INLINE this #-}
-- | the zero arrow, alias for zeroArrow
none :: a b c
none = zeroArrow
{-# INLINE none #-}
-- | converts an arrow, that may fail, into an arrow that always succeeds
--
-- example: @ withDefault none \"abc\" @ is equivalent to @ constA \"abc\" @
withDefault :: a b c -> c -> a b c
withDefault a d = a >>. \ x -> if null x then [d] else x
{-# INLINE withDefault #-}
-- | 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"]
single :: a b c -> a b c
single f = f >>. take 1
-- | 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: '$<', '$<<', '$<<<', '$<<<<', '$<$'
applyA :: a b (a b c) -> a b c
applyA f = (f &&& this) >>> app
-- | 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', '$<<', '$<<<', '$<<<<', '$<$'
($<) :: (c -> a b d) -> a b c -> a b d
g $< f = applyA (f >>> arr g)
-- | 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 -> a b d) -> a b (c1, c2) -> a b d
f $<< g = applyA (g >>> arr2 f)
-- | version of '$<' for arrows with 3 extra parameters
--
-- typical usage
--
-- > f $<<< g1 &&& g2 &&& g3
($<<<) :: (c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d
f $<<< g = applyA (g >>> arr3 f)
-- | version of '$<' for arrows with 4 extra parameters
--
-- typical usage
--
-- > f $<<<< g1 &&& g2 &&& g3 &&& g4
($<<<<) :: (c1 -> c2 -> c3 -> c4 -> a b d) -> a b (c1, (c2, (c3, c4))) -> a b d
f $<<<< g = applyA (g >>> arr4 f)
-- | 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', '$<'
($<$) :: (c -> (a b b)) -> a b c -> a b b
g $<$ f = applyA (listA (f >>> arr g) >>> arr seqA)
-- | 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" == ["42","420"]
-- > runLA (a1 >>> mergeA (+=) >>> xshow this) "42" == ["42420"]
--
-- see also: 'applyA', '$<' and '+=' in class 'Text.XML.HXT.Arrow.ArrowXml'
mergeA :: (a (a1, b1) a1 -> a (a1, b1) b1 -> a (a1, b1) c) ->
a (a1, b1) c
mergeA op = (\ x -> arr fst `op` constA (snd x)) $< this
-- | useful only for arrows with side effects: perform applies an arrow to the input
-- ignores the result and returns the input
--
-- example: @ ... >>> perform someTraceArrow >>> ... @
perform :: a b c -> a b b
perform f = listA f &&& this >>> arr snd
{-# INLINE perform #-}
-- | generalization of arrow combinator '<+>'
--
-- definition: @ catA = foldl (\<+\>) none @
catA :: [a b c] -> a b c
catA = foldl (<+>) none
{-# INLINE catA #-}
-- | generalization of arrow combinator '>>>'
--
-- definition: @ seqA = foldl (>>>) this @
seqA :: [a b b] -> a b b
seqA = foldl (>>>) this
{-# INLINE seqA #-}
-- ------------------------------------------------------------