content: -- ------------------------------------------------------------
  
  {- |
     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 often indicates that the function is undefined
     for the given argument.
     The empty list may also represent False, non-empty lists True.
     A list with more than one element gives all results for a
     so called 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" == ["<foo>42</foo>","<bar>420</bar>"]
      -- >     runLA (a1 >>> mergeA (+=)  >>> xshow this) "42" == ["<foo>42<bar>420</bar></foo>"]
      --
      -- 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 #-}
  
  -- ------------------------------------------------------------
  