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

    {- |
       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 b c d. 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 ((b -> Bool) -> a b b
    forall b. (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 b c d. 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 b
    forall b c. a b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none a b b
    forall b. 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 b c d. 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 b
    f a b b
    forall b. 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 b d. (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
    g a b b
    f a b b
    forall b. 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 b c d. 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 b
    forall b. 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 b d. (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
    g a b b
    forall b. 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 b c d. 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 b c. a b c
    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 b d. (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 b c. a b c
    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 b c d. 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 b
    forall b. a b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this a b b
    forall b c. a b c
    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 b c d. a b c -> a b d -> a b d
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d
    `guards` a c c
    forall b. a b b
    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 b c d. 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 c d
    g a c c
    forall b c. a b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none a c c
    forall b. a b b
    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 a b. (a -> b -> b) -> b -> [a] -> b
    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 b c. a b c
    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 b c d. 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 b c d. 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
    p ((b -> Either b b) -> a b (Either b b)
    forall b c. (b -> c) -> a b c
    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 b c. (b -> c) -> a b c
    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 b c d. 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 ( ([b] -> [b]) -> a [b] b
    forall b c. (b -> [c]) -> a b c
    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 b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr [b] -> b
    forall a. HasCallStack => [a] -> a
    head a [b] b -> a [b] ([b], [b]) -> a [b] (b, ([b], [b]))
    forall b c c'. a b c -> a b c' -> a b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (([b] -> [b]) -> a [b] [b]
    forall b c. (b -> c) -> a b c
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr [b] -> [b]
    forall a. HasCallStack => [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 b. 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 b c. (b -> c) -> a b c
    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 b c. (b -> c) -> a b c
    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 b c. a b c -> a b [c]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA ( ([b] -> [b]) -> a [b] b
    forall b c. (b -> [c]) -> a b c
    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 b c. a b c -> 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

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