-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Arrow.Operations
-- Copyright   :  (c) Ross Paterson 2003
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  non-portable (multi-parameter type classes)
--
-- Subclasses of 'Arrow' providing additional operations.
--
-- The signatures are designed to be compatible with the proposed
-- notation for arrows, cf. <http://www.haskell.org/arrows/>.

module Control.Arrow.Operations (
    -- * Conventions
    -- $conventions

    -- * State transformers
    ArrowState(..),
    -- * State readers
    ArrowReader(..),
    -- * Monoid writers
    ArrowWriter(..),
    -- * Errors
    ArrowError(..),
    tryInUnlessDefault,
    -- * Synchronous circuits
    ArrowCircuit(..),
    ) where

import Control.Arrow
import Data.Monoid

-- $conventions
-- The arrow classes defined in this module have names like @Arrow@/Foo/,
-- and contain operations specific to such arrows.  Some of these include
-- a method @new@/Foo/, which maps computations to computations of the
-- same arrow type, but exposing some of the internals of the arrow.
--
-- Arrow transformers have names like /Bar/@Arrow@, and are
-- instances of appropriate arrow classes.  For each arrow
-- transformer, there is typically an encapsulation operator
-- @run@/Bar/ that removes that transformer from the outside of an
-- arrow type.  The 'Control.Arrow.Transformer.lift' method of the
-- 'Control.Arrow.Transformer.ArrowTransformer' class adds an arrow
-- transformer to the outside of an arrow type.
--
-- Typically a composite arrow type is built by applying a series of arrow
-- transformers to a base arrow (usually either a function arrow or a
-- 'Kleisli' arrow.  The 'Control.Arrow.Transformer.lift' method and the
-- @run@/Bar/ function operate only on the arrow transformer at the top
-- of this stack.  For more sophisticated manipulation of this stack of
-- arrow transformers, many arrow transformers provide an @ArrowAdd@/Bar/
-- class, with methods methods @lift@/Bar/ and @elim@/Bar/ to add and remove
-- the transformer anywhere in the stack.

-- | An arrow type that provides a read-only state (an environment).
-- If you also need to modify the state, use 'ArrowState'.

class Arrow a => ArrowReader r a | a -> r where
    -- | Obtain the current value of the state.
    readState :: a b r

    -- | Run a subcomputation in the same arrow, but with a different
    -- environment.  The environment of the outer computation is
    -- unaffected.
    --
    -- Typical usage in arrow notation:
    --
    -- >    proc p -> ...
    -- >        (|newReader cmd|) env

    newReader :: a e b -> a (e,r) b

-- | An arrow type that provides a modifiable state,
-- based of section 9 of /Generalising Monads to Arrows/, by John Hughes,
-- /Science of Computer Programming/ 37:67-111, May 2000.

class Arrow a => ArrowState s a | a -> s where
    -- | Obtain the current value of the state.
    fetch :: a e s
    -- | Assign a new value to the state.
    store :: a s ()

-- | An arrow type that collects additional output (of some 'Monoid' type).

class (Monoid w, Arrow a) => ArrowWriter w a | a -> w where
    -- | Add a piece of additional output.
    write :: a w ()

    -- | Run a subcomputation in the same arrow, making its additional
    -- output accessible.
    --
    -- Typical usage in arrow notation:
    --
    -- >    proc p -> do
    -- >        ...
    -- >        (value, output) <- (|newWriter cmd|)

    newWriter :: a e b -> a e (b,w)

-- | An arrow type that includes errors (or exceptions).
--
-- Minimal definition: 'raise' and 'tryInUnless'.
--
-- /TODO:/ the operations here are inconsistent with other arrow transformers.

class Arrow a => ArrowError ex a | a -> ex where
    -- | Raise an error.
    raise :: a ex b

    -- | Traditional exception construct.
    --
    -- Typical usage in arrow notation:
    --
    -- >    proc p -> ...
    -- >        body `handle` \ex -> handler

    handle ::
        a e b           -- ^ computation that may raise errors
        -> a (e,ex) b   -- ^ computation to handle errors
        -> a e b
    handle a e b
f a (e, ex) b
h = a e b -> a (e, b) b -> a (e, ex) b -> a e b
forall ex (a :: * -> * -> *) e b c.
ArrowError ex a =>
a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnless a e b
f (((e, b) -> b) -> a (e, b) b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (e, b) -> b
forall a b. (a, b) -> b
snd) a (e, ex) b
h

    -- | Exception construct in the style of /Exceptional Syntax/,
    -- by Nick Benton and Andrew Kennedy, /JFP/ 11(4):395-410, July 2001.
    --
    -- Typical usage in arrow notation:
    --
    -- >    proc p -> ...
    -- >        (|tryInUnless
    -- >            body
    -- >            (\res -> success)
    -- >            (\ex -> handler)
    -- >        |)
    tryInUnless ::
        a e b           -- ^ computation that may raise errors
        -> a (e,b) c    -- ^ computation to receive successful results
        -> a (e,ex) c   -- ^ computation to handle errors
        -> a e c

    -- | Handler that returns the error as a value.
    newError :: a e b -> a e (Either ex b)
    newError a e b
f = a e (Either ex b) -> a (e, ex) (Either ex b) -> a e (Either ex b)
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a (e, ex) b -> a e b
handle (a e b
f a e b -> a b (Either ex b) -> a e (Either ex b)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (b -> Either ex b) -> a b (Either ex b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> Either ex b
forall a b. b -> Either a b
Right) (((e, ex) -> Either ex b) -> a (e, ex) (Either ex b)
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (ex -> Either ex b
forall a b. a -> Either a b
Left (ex -> Either ex b) -> ((e, ex) -> ex) -> (e, ex) -> Either ex b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (e, ex) -> ex
forall a b. (a, b) -> b
snd))

-- | A suitable value for 'tryInUnless' when the arrow type belongs to
-- 'ArrowChoice'.  To use it, you must define either 'handle' or 'newError'.

tryInUnlessDefault :: (ArrowError ex a, ArrowChoice a) =>
    a e b           -- ^ computation that may raise errors
    -> a (e,b) c    -- ^ computation to receive successful results
    -> a (e,ex) c   -- ^ computation to handle errors
    -> a e c
tryInUnlessDefault :: a e b -> a (e, b) c -> a (e, ex) c -> a e c
tryInUnlessDefault a e b
f a (e, b) c
s a (e, ex) c
h = (e -> e) -> a e e
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr e -> e
forall a. a -> a
id a e e -> a e (Either ex b) -> a e (e, Either ex b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a e b -> a e (Either ex b)
forall ex (a :: * -> * -> *) e b.
ArrowError ex a =>
a e b -> a e (Either ex b)
newError a e b
f a e (e, Either ex b) -> a (e, Either ex b) c -> a e c
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((e, Either ex b) -> Either (e, ex) (e, b))
-> a (e, Either ex b) (Either (e, ex) (e, b))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (e, Either ex b) -> Either (e, ex) (e, b)
forall a b b. (a, Either b b) -> Either (a, b) (a, b)
dist a (e, Either ex b) (Either (e, ex) (e, b))
-> a (Either (e, ex) (e, b)) c -> a (e, Either ex 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 (e, ex) c
h a (e, ex) c -> a (e, b) c -> a (Either (e, ex) (e, b)) c
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| a (e, b) c
s
  where
    dist :: (a, Either b b) -> Either (a, b) (a, b)
dist (a
e, Left b
ex) = (a, b) -> Either (a, b) (a, b)
forall a b. a -> Either a b
Left (a
e, b
ex)
    dist (a
e, Right b
b) = (a, b) -> Either (a, b) (a, b)
forall a b. b -> Either a b
Right (a
e, b
b)

-- tryInUnless (and thus handle) could be replaced by newError if:
-- 1. When ArrowChoice is available, tryInUnless and newError are equivalent.
-- 2. When tryInUnless is available, so is ArrowChoice.
--    (Counterexample: general CoKleisli)

-- | An arrow type that can be used to interpret synchronous circuits.

class ArrowLoop a => ArrowCircuit a where
    -- | A delay component.
    delay ::
        b        -- ^ the value to return initially.
        -> a b b -- ^ an arrow that propagates its input with a one-tick delay.