content: -- ------------------------------------------------------------
  
  {- |
     Module     : Control.Arrow.ArrowIf
     Copyright  : Copyright (C) 2005 Uwe Schmidt
     License    : MIT
  
     Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
     Stability  : experimental
     Portability: portable
  
     Conditionals for List Arrows
  
     This module defines conditional combinators for list arrows.
  
     The empty list as result represents False, none empty lists True.
  -}
  
  -- ------------------------------------------------------------
  
  module Control.Arrow.ArrowIf
      ( module Control.Arrow.ArrowIf
      )
  where
  
  import Control.Arrow
  import Control.Arrow.ArrowList
  
  import Data.List
      ( partition )
  
  -- ------------------------------------------------------------
  
  -- | The interface for arrows as conditionals.
  --
  -- Requires list arrows because False is represented as empty list, True as none empty lists.
  --
  -- Only 'ifA' and 'orElse' don't have default implementations
  
  class ArrowList a => ArrowIf a where
  
      -- | if lifted to arrows
  
      ifA                 :: a b c -> a b d -> a b d -> a b d
  
      -- | shortcut: @ ifP p = ifA (isA p) @
  
      ifP                 :: (b -> Bool) -> a b d -> a b d -> a b d
      ifP p               = ifA (isA p)
      {-# INLINE ifP #-}
  
      -- | negation: @ neg f = ifA f none this @
  
      neg                 :: a b c -> a b b
      neg f               = ifA f none this
      {-# INLINE neg #-}
  
      -- | @ f \`when\` g @ : when the predicate g holds, f is applied, else the identity filter this
  
      when                :: a b b -> a b c -> a b b
      f `when` g          = ifA g f this
      {-# INLINE when #-}
  
      -- | shortcut: @ f \`whenP\` p = f \`when\` (isA p) @
  
      whenP               :: a b b -> (b -> Bool) -> a b b
      f `whenP` g         = ifP g f this
      {-# INLINE whenP #-}
  
      -- | @ f \`whenNot\` g @ : when the predicate g does not hold, f is applied, else the identity filter this
  
      whenNot             :: a b b -> a b c -> a b b
      f `whenNot` g       = ifA g this f
      {-# INLINE whenNot #-}
  
      -- | like 'whenP'
  
      whenNotP            :: a b b -> (b -> Bool) -> a b b
      f `whenNotP` g      = ifP g this f
      {-# INLINE whenNotP #-}
  
      -- | @ g \`guards\` f @ : when the predicate g holds, f is applied, else none
  
      guards              :: a b c -> a b d -> a b d
      f `guards` g        = ifA f g none
      {-# INLINE guards #-}
  
      -- | like 'whenP'
  
      guardsP             :: (b -> Bool) -> a b d -> a b d
      f `guardsP` g       = ifP f g none
      {-# INLINE guardsP #-}
  
      -- | shortcut for @ f `guards` this @
  
      filterA             :: a b c -> a b b
      filterA f           = ifA f this none
      {-# INLINE filterA #-}
  
      -- | @ f \`containing\` g @ : keep only those results from f for which g holds
      --
      -- definition: @ f \`containing\` g = f >>> g \`guards\` this @
  
      containing          :: a b c -> a c d -> a b c
      f `containing` g    = f >>> g `guards` this
      {-# INLINE containing #-}
  
      -- | @ f \`notContaining\` g @ : keep only those results from f for which g does not hold
      --
      -- definition: @ f \`notContaining\` g = f >>> ifA g none this @
  
      notContaining       :: a b c -> a c d -> a b c
      f `notContaining` g = f >>> ifA g none this
      {-# INLINE notContaining #-}
  
      -- | @ f \`orElse\` g @ : directional choice: if f succeeds, the result of f is the result, else g is applied
      orElse              :: a b c -> a b c -> a b c
  
      -- | 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 ] @
      choiceA             :: [IfThen (a b c) (a b d)] -> a b d
      choiceA             = foldr ifA' none
                            where
                            ifA' (g :-> f) = ifA g f
  
  
      -- | tag a value with Left or Right, if arrow has success, input is tagged with Left, else with Right
      tagA                :: a b c -> a b (Either b b)
      tagA p              = ifA p (arr Left) (arr Right)
  
  
      -- | 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
  
      spanA               :: a b b -> a [b] ([b],[b])
      spanA p             = ifA ( arrL (take 1) >>> p )
                            ( arr head &&& (arr tail >>> spanA p)
                              >>>
                              arr (\ ~(x, ~(xs,ys)) -> (x : xs, ys))
                            )
                            ( arr (\ l -> ([],l)) )
  
      -- | partition a list of values into a pair of lists
      --
      -- This is the arrow Version of 'Data.List.partition'
  
      partitionA          :: a b b -> a [b] ([b],[b])
      partitionA  p       = listA ( arrL id >>> tagA p )
                            >>^
                            ( (\ ~(l1, l2) -> (unTag l1, unTag l2) ) . partition (isLeft) )
                            where
                            isLeft (Left _) = True
                            isLeft _        = False
                            unTag = map (either id id)
  
  -- ------------------------------------------------------------
  
  -- | an auxiliary data type for 'choiceA'
  
  data IfThen a b = a :-> b
  
  -- ------------------------------------------------------------
  