linear-base-0.2.0: src/Data/Bifunctor/Linear/Internal/SymmetricMonoidal.hs
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Bifunctor.Linear.Internal.SymmetricMonoidal
( SymmetricMonoidal (..),
)
where
import Data.Bifunctor.Linear.Internal.Bifunctor
import Data.Kind (Type)
import Data.Void
import Prelude.Linear
-- | A SymmetricMonoidal class
--
-- This allows you to shuffle around a bifunctor nested in itself and swap the
-- places of the two types held in the bifunctor. For instance, for tuples:
--
-- * You can use @lassoc :: (a,(b,c)) %1-> ((a,b),c)@ and then use 'first' to access the @a@
-- * You can use the dual, i.e., @ rassoc :: ((a,b),c) %1-> (a,(b,c))@ and then 'second'
-- * You can swap the first and second values with @swap :: (a,b) %1-> (b,a)@
--
-- == Laws
--
-- * @swap . swap = id@
-- * @rassoc . lassoc = id@
-- * @lassoc . rassoc = id@
-- * @second swap . rassoc . first swap = rassoc . swap . rassoc@
class
Bifunctor m =>
SymmetricMonoidal (m :: Type -> Type -> Type) (u :: Type)
| m -> u,
u -> m
where
{-# MINIMAL swap, (rassoc | lassoc) #-}
rassoc :: (a `m` b) `m` c %1 -> a `m` (b `m` c)
rassoc = swap . lassoc . swap . lassoc . swap
lassoc :: a `m` (b `m` c) %1 -> (a `m` b) `m` c
lassoc = swap . rassoc . swap . rassoc . swap
swap :: a `m` b %1 -> b `m` a
-- XXX: should unitors be added?
-- XXX: Laws don't seem minimial
-- # Instances
-------------------------------------------------------------------------------
instance SymmetricMonoidal (,) () where
swap (x, y) = (y, x)
rassoc ((x, y), z) = (x, (y, z))
instance SymmetricMonoidal Either Void where
swap = either Right Left
rassoc (Left (Left x)) = Left x
rassoc (Left (Right x)) = (Right :: a %1 -> Either b a) (Left x)
rassoc (Right x) = (Right :: a %1 -> Either b a) (Right x)
-- XXX: the above type signatures are necessary for certain older versions of
-- the compiler, and as such are temporary