-- ------------------------------------------------------------

{- |
   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 b -> Bool
p               = a b b -> a b d -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ((b -> Bool) -> a b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA b -> Bool
p)
    {-# INLINE ifP #-}

    -- | negation: @ neg f = ifA f none this @

    neg                 :: a b c -> a b b
    neg a b c
f               = a b c -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
f a b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
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
    a b b
f `when` a b c
g          = a b c -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
g a b b
f a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
    {-# INLINE when #-}

    -- | shortcut: @ f \`whenP\` p = f \`when\` (isA p) @

    whenP               :: a b b -> (b -> Bool) -> a b b
    a b b
f `whenP` b -> Bool
g         = (b -> Bool) -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP b -> Bool
g a b b
f a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
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
    a b b
f `whenNot` a b c
g       = a b c -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
g a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this a b b
f
    {-# INLINE whenNot #-}

    -- | like 'whenP'

    whenNotP            :: a b b -> (b -> Bool) -> a b b
    a b b
f `whenNotP` b -> Bool
g      = (b -> Bool) -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP b -> Bool
g a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this a b b
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
    a b c
f `guards` a b d
g        = a b c -> a b d -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
f a b d
g a b d
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
    {-# INLINE guards #-}

    -- | like 'whenP'

    guardsP             :: (b -> Bool) -> a b d -> a b d
    b -> Bool
f `guardsP` a b d
g       = (b -> Bool) -> a b d -> a b d -> a b d
forall (a :: * -> * -> *) b d.
ArrowIf a =>
(b -> Bool) -> a b d -> a b d -> a b d
ifP b -> Bool
f a b d
g a b d
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
    {-# INLINE guardsP #-}

    -- | shortcut for @ f `guards` this @

    filterA             :: a b c -> a b b
    filterA a b c
f           = a b c -> a b b -> a b b -> a b b
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
f a b b
forall (a :: * -> * -> *) b. ArrowList a => a b b
this a b b
forall (a :: * -> * -> *) b c. ArrowList a => a b c
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
    a b c
f `containing` a c d
g    = a b c
f a b c -> a c c -> a b c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a c d
g a c d -> a c c -> a c c
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d
`guards` a c c
forall (a :: * -> * -> *) b. ArrowList a => a b b
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
    a b c
f `notContaining` a c d
g = a b c
f a b c -> a c c -> a b c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a c d -> a c c -> a c c -> a c c
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a c d
g a c c
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none a c c
forall (a :: * -> * -> *) b. ArrowList a => a b b
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             = (IfThen (a b c) (a b d) -> a b d -> a b d)
-> a b d -> [IfThen (a b c) (a b d)] -> a b d
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfThen (a b c) (a b d) -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
IfThen (a b c) (a b d) -> a b d -> a b d
ifA' a b d
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                          where
                          ifA' :: IfThen (a b c) (a b d) -> a b d -> a b d
ifA' (a b c
g :-> a b d
f) = a b c -> a b d -> a b d -> a b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
g a b d
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 a b c
p              = a b c -> a b (Either b b) -> a b (Either b b) -> a b (Either b b)
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA a b c
p ((b -> Either b b) -> a b (Either b b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> Either b b
forall a b. a -> Either a b
Left) ((b -> Either b b) -> a b (Either b b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> Either b b
forall a b. b -> Either a b
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 a b b
p             = a [b] b -> a [b] ([b], [b]) -> a [b] ([b], [b]) -> a [b] ([b], [b])
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA ( ([b] -> [b]) -> a [b] b
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
1) a [b] b -> a b b -> a [b] b
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a b b
p )
                          ( ([b] -> b) -> a [b] b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [b] -> b
forall a. [a] -> a
head a [b] b -> a [b] ([b], [b]) -> a [b] (b, ([b], [b]))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (([b] -> [b]) -> a [b] [b]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [b] -> [b]
forall a. [a] -> [a]
tail a [b] [b] -> a [b] ([b], [b]) -> a [b] ([b], [b])
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a b b -> a [b] ([b], [b])
forall (a :: * -> * -> *) b. ArrowIf a => a b b -> a [b] ([b], [b])
spanA a b b
p)
                            a [b] (b, ([b], [b]))
-> a (b, ([b], [b])) ([b], [b]) -> a [b] ([b], [b])
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                            ((b, ([b], [b])) -> ([b], [b])) -> a (b, ([b], [b])) ([b], [b])
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ ~(b
x, ~([b]
xs,[b]
ys)) -> (b
x b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
xs, [b]
ys))
                          )
                          ( ([b] -> ([b], [b])) -> a [b] ([b], [b])
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ [b]
l -> ([],[b]
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  a b b
p       = a [b] (Either b b) -> a [b] [Either b b]
forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
listA ( ([b] -> [b]) -> a [b] b
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL [b] -> [b]
forall a. a -> a
id a [b] b -> a b (Either b b) -> a [b] (Either b b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a b b -> a b (Either b b)
forall (a :: * -> * -> *) b c.
ArrowIf a =>
a b c -> a b (Either b b)
tagA a b b
p )
                          a [b] [Either b b]
-> ([Either b b] -> ([b], [b])) -> a [b] ([b], [b])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^
                          ( (\ ~([Either b b]
l1, [Either b b]
l2) -> ([Either b b] -> [b]
forall b. [Either b b] -> [b]
unTag [Either b b]
l1, [Either b b] -> [b]
forall b. [Either b b] -> [b]
unTag [Either b b]
l2) ) (([Either b b], [Either b b]) -> ([b], [b]))
-> ([Either b b] -> ([Either b b], [Either b b]))
-> [Either b b]
-> ([b], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either b b -> Bool)
-> [Either b b] -> ([Either b b], [Either b b])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Either b b -> Bool
forall a b. Either a b -> Bool
isLeft) )
                          where
                          isLeft :: Either a b -> Bool
isLeft (Left a
_) = Bool
True
                          isLeft Either a b
_        = Bool
False
                          unTag :: [Either b b] -> [b]
unTag = (Either b b -> b) -> [Either b b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b) -> (b -> b) -> Either b b -> b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> b
forall a. a -> a
id b -> b
forall a. a -> a
id)

-- ------------------------------------------------------------

-- | an auxiliary data type for 'choiceA'

data IfThen a b = a :-> b

-- ------------------------------------------------------------