-- | This module provides a variant of the standard
-- 'Control.Arrow.Arrow' type class with a different
-- 'Control.Arrow.arr' method so that it can be implemented for signal
-- functions in Rattus.
module Rattus.Arrow where
import Prelude hiding (id)
import Rattus.Primitives
import Control.Category
-- | Variant of the standard 'Control.Arrow.Arrow' type class with a
-- different 'Control.Arrow.arr' method so that it can be implemented
-- for signal functions in Rattus.
class Category a => Arrow a where
{-# MINIMAL arrBox, (first | (***)) #-}
-- | Lift a function to an arrow. It is here the definition of the
-- 'Arrow' class differs from the standard one. The function to be
-- lifted has to be boxed.
--
arrBox :: Box (b -> c) -> a b c
-- | Send the first component of the input through the argument
-- arrow, and copy the rest unchanged to the output.
first :: a b c -> a (b,d) (c,d)
first = (*** id)
-- | A mirror image of 'first'.
--
-- The default definition may be overridden with a more efficient
-- version if desired.
second :: a b c -> a (d,b) (d,c)
second = (id ***)
-- | Split the input between the two argument arrows and combine
-- their output. Note that this is in general not a functor.
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
f *** g = first f >>> arr swap >>> first g >>> arr swap
where swap ~(x,y) = (y,x)
-- | Fanout: send the input to both argument arrows and combine
-- their output.
--
-- The default definition may be overridden with a more efficient
-- version if desired.
(&&&) :: a b c -> a b c' -> a b (c,c')
f &&& g = arr (\b -> (b,b)) >>> f *** g
-- | This combinator is subject to the same restrictions as the 'box'
-- primitive of Rattus. That is,
--
-- > Γ☐ ⊢ t :: b -> c
-- > --------------------
-- > Γ ⊢ arr t :: a b c
--
-- where Γ☐ is obtained from Γ by removing ✓ and any variables @x ::
-- 𝜏@, where 𝜏 is not a stable type.
arr :: Arrow a => (b -> c) -> a b c
arr f = arrBox (box f)
-- | The identity arrow, which plays the role of 'return' in arrow notation.
returnA :: Arrow a => a b b
returnA = arrBox (box id)