mirror of
https://github.com/ilyakooo0/semi-iso-optics.git
synced 2024-10-26 08:19:54 +03:00
Add comment, remove (~$/) and (~$~) for clarity.
This commit is contained in:
parent
c97679d0e3
commit
94f0a75e92
@ -9,6 +9,10 @@ License : MIT
|
||||
Maintainer : Paweł Nowak <pawel834@gmail.com>
|
||||
Stability : experimental
|
||||
|
||||
This module defines some basic structures in a category in a more fine-grained
|
||||
way then "Control.Arrow".
|
||||
|
||||
Unfortunately names in this module clash with "Control.Arrow".
|
||||
-}
|
||||
module Control.Category.Structures where
|
||||
|
||||
@ -22,6 +26,7 @@ infixl 3 ***
|
||||
infixl 2 +++
|
||||
infixl 3 /+/
|
||||
|
||||
-- | A category with finite products.
|
||||
class Category cat => Products cat where
|
||||
first :: cat a b -> cat (a, c) (b, c)
|
||||
first a = a *** id
|
||||
@ -37,6 +42,7 @@ class Category cat => Products cat where
|
||||
instance Monad m => Products (Kleisli m) where
|
||||
(***) = (BadArrow.***)
|
||||
|
||||
-- | A category with finite coproducts.
|
||||
class Category cat => Coproducts cat where
|
||||
left :: cat a b -> cat (Either a c) (Either b c)
|
||||
left a = a +++ id
|
||||
@ -52,6 +58,7 @@ class Category cat => Coproducts cat where
|
||||
instance Monad m => Coproducts (Kleisli m) where
|
||||
(+++) = (BadArrow.+++)
|
||||
|
||||
-- | A category @cat@ is a CatPlus when @cat a b@ is a monoid for all a, b.
|
||||
class Category cat => CatPlus cat where
|
||||
cempty :: cat a b
|
||||
(/+/) :: cat a b -> cat a b -> cat a b
|
||||
@ -62,6 +69,7 @@ instance MonadPlus m => CatPlus (Kleisli m) where
|
||||
cempty = BadArrow.zeroArrow
|
||||
(/+/) = (BadArrow.<+>)
|
||||
|
||||
-- | A category transformer.
|
||||
class CategoryTrans t where
|
||||
clift :: Category cat => cat a b -> t cat a b
|
||||
|
||||
|
@ -10,7 +10,24 @@ Maintainer : Paweł Nowak <pawel834@gmail.com>
|
||||
Stability : experimental
|
||||
|
||||
-}
|
||||
module Control.SIArrow where
|
||||
module Control.SIArrow (
|
||||
-- * Arrow.
|
||||
SIArrow(..),
|
||||
(^>>), (>>^), (^<<), (<<^),
|
||||
|
||||
-- * Functor and applicative.
|
||||
(/$/), (/$~),
|
||||
(/*/), (/*), (*/),
|
||||
|
||||
-- * Signaling errors.
|
||||
sifail, (/?/),
|
||||
|
||||
-- * Combinators.
|
||||
sisequence,
|
||||
sisequence_,
|
||||
sireplicate,
|
||||
sireplicate_
|
||||
) where
|
||||
|
||||
import Control.Arrow (Kleisli(..))
|
||||
import Control.Category
|
||||
@ -24,7 +41,7 @@ import Prelude hiding (id, (.))
|
||||
|
||||
infixr 1 ^>>, >>^
|
||||
infixr 1 ^<<, <<^
|
||||
infixl 4 /$/, /$~, ~$/, ~$~
|
||||
infixl 4 /$/, /$~
|
||||
infixl 5 /*/, */, /*
|
||||
|
||||
-- Categories.
|
||||
@ -75,21 +92,6 @@ ai /$/ f = sipure ai . f
|
||||
=> ASemiIso' a b' -> cat c b -> cat c a
|
||||
ai /$~ h = cloneSemiIso ai . morphed /$/ h
|
||||
|
||||
-- | > ai ~$/ f = morphed . ai /$/ f
|
||||
(~$/) :: (SIArrow cat, HFoldable a', HFoldable a,
|
||||
HUnfoldable a', HUnfoldable a, Rep a' ~ Rep a)
|
||||
=> ASemiIso' a' b -> cat c b -> cat c a
|
||||
ai ~$/ h = morphed . cloneSemiIso ai /$/ h
|
||||
|
||||
-- | > ai ~$~ f = morphed . ai . morphed /$/ f
|
||||
(~$~) :: (SIArrow cat,
|
||||
HFoldable a, HUnfoldable a,
|
||||
HFoldable b, HUnfoldable b,
|
||||
HFoldable b', HUnfoldable b',
|
||||
Rep b' ~ Rep b, Rep b' ~ Rep a)
|
||||
=> ASemiIso b' b' b' b' -> cat c b -> cat c a
|
||||
ai ~$~ h = morphed . cloneSemiIso ai . morphed /$/ h
|
||||
|
||||
(/*/) :: SIArrow cat => cat () b -> cat () c -> cat () (b, c)
|
||||
a /*/ b = unit ^>> (a *** b)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user