-- | 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 = (a b c -> a d d -> a (b, d) (c, d) forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') *** a d d forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a 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 = (a d d forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a id a d d -> a b c -> a (d, b) (d, c) forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') ***) -- | 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') a b c f *** a b' c' g = a b c -> a (b, b') (c, b') forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first a b c f a (b, b') (c, b') -> a (c, b') (c, c') -> a (b, b') (c, c') forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ((c, b') -> (b', c)) -> a (c, b') (b', c) forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (c, b') -> (b', c) forall b a. (b, a) -> (a, b) swap a (c, b') (b', c) -> a (b', c) (c, c') -> a (c, b') (c, c') forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b' c' -> a (b', c) (c', c) forall (a :: * -> * -> *) b c d. Arrow a => a b c -> a (b, d) (c, d) first a b' c' g a (b', c) (c', c) -> a (c', c) (c, c') -> a (b', c) (c, c') forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> ((c', c) -> (c, c')) -> a (c', c) (c, c') forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (c', c) -> (c, c') forall b a. (b, a) -> (a, b) swap where swap :: (b, a) -> (a, b) swap ~(b x,a y) = (a y,b 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') a b c f &&& a b c' g = (b -> (b, b)) -> a b (b, b) forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c arr (\b b -> (b b,b b)) a b (b, b) -> a (b, b) (c, c') -> a b (c, c') forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> a b c f a b c -> a b c' -> a (b, b) (c, c') forall (a :: * -> * -> *) b c b' c'. Arrow a => a b c -> a b' c' -> a (b, b') (c, c') *** a b c' 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 :: (b -> c) -> a b c arr b -> c f = Box (b -> c) -> a b c forall (a :: * -> * -> *) b c. Arrow a => Box (b -> c) -> a b c arrBox ((b -> c) -> Box (b -> c) forall a. a -> Box a box b -> c f) -- | The identity arrow, which plays the role of 'return' in arrow notation. returnA :: Arrow a => a b b returnA :: a b b returnA = Box (b -> b) -> a b b forall (a :: * -> * -> *) b c. Arrow a => Box (b -> c) -> a b c arrBox ((b -> b) -> Box (b -> b) forall a. a -> Box a box b -> b forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a id)