mirror of
https://github.com/ilyakooo0/semi-iso-optics.git
synced 2024-09-11 07:55:36 +03:00
Add instances for Dual categories.
This commit is contained in:
parent
8a6f5302d4
commit
49e56e33c8
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{- |
|
||||
Module : Control.Category.Structures
|
||||
@ -20,6 +21,7 @@ import Control.Arrow (Kleisli(..))
|
||||
import qualified Control.Arrow as BadArrow
|
||||
import Control.Category
|
||||
import Control.Monad
|
||||
import Data.Semigroupoid.Dual
|
||||
import Prelude hiding (id, (.))
|
||||
|
||||
infixl 3 ***
|
||||
@ -50,6 +52,9 @@ class Category cat => Products cat where
|
||||
instance Monad m => Products (Kleisli m) where
|
||||
(***) = (BadArrow.***)
|
||||
|
||||
instance Products cat => Products (Dual cat) where
|
||||
Dual f *** Dual g = Dual $ f *** g
|
||||
|
||||
instance Products (->) where
|
||||
(***) = (BadArrow.***)
|
||||
|
||||
@ -77,6 +82,9 @@ class Category cat => Coproducts cat where
|
||||
instance Monad m => Coproducts (Kleisli m) where
|
||||
(+++) = (BadArrow.+++)
|
||||
|
||||
instance Coproducts cat => Coproducts (Dual cat) where
|
||||
Dual f +++ Dual g = Dual $ f +++ g
|
||||
|
||||
instance Coproducts (->) where
|
||||
(+++) = (BadArrow.+++)
|
||||
|
||||
@ -93,6 +101,10 @@ instance MonadPlus m => CatPlus (Kleisli m) where
|
||||
cempty = BadArrow.zeroArrow
|
||||
(/+/) = (BadArrow.<+>)
|
||||
|
||||
instance CatPlus cat => CatPlus (Dual cat) where
|
||||
cempty = Dual cempty
|
||||
Dual f /+/ Dual g = Dual $ f /+/ g
|
||||
|
||||
-- | A category transformer.
|
||||
class CatTrans t where
|
||||
-- | Lift an arrow from the base category.
|
||||
|
@ -39,8 +39,10 @@ import Control.Category
|
||||
import Control.Category.Structures
|
||||
import Control.Lens.Cons
|
||||
import Control.Lens.Empty
|
||||
import Control.Lens.Iso
|
||||
import Control.Lens.SemiIso
|
||||
import Control.Monad
|
||||
import Data.Semigroupoid.Dual
|
||||
import Data.Tuple.Morph
|
||||
import Prelude hiding (id, (.))
|
||||
|
||||
@ -94,6 +96,10 @@ instance MonadPlus m => SIArrow (Kleisli m) where
|
||||
siarr ai = Kleisli $ either fail return . apply ai
|
||||
sibind ai = Kleisli $ \a -> either fail (($ a) . runKleisli) $ apply ai a
|
||||
|
||||
instance SIArrow cat => SIArrow (Dual cat) where
|
||||
siarr = Dual . sipure
|
||||
sibind ai = Dual $ sibind (iso id getDual . rev ai . iso getDual id)
|
||||
|
||||
instance SIArrow ReifiedSemiIso' where
|
||||
siarr = reifySemiIso
|
||||
sibind ai = ReifiedSemiIso' $
|
||||
|
@ -66,6 +66,6 @@ library
|
||||
Control.Category.Reader
|
||||
Control.Category.Structures
|
||||
Data.Profunctor.Exposed
|
||||
build-depends: base >= 4 && < 5, profunctors, transformers, lens, tuple-morph
|
||||
build-depends: base >= 4 && < 5, profunctors, transformers, lens, tuple-morph, semigroupoids
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
Loading…
Reference in New Issue
Block a user