module Language.Symantic.Transforming.Trans where

-- |
-- * 'trans' is generally not /surjective/
-- * 'unTrans' is not /injective/
-- * 'unTrans' . 'trans' == 'id'
-- * 'trans' . 'unTrans' /= 'id'
--
-- NOTE: @DefaultSignatures@ can be used
-- when declaring a symantic type class
-- to provide default definition of the methods:
-- implementing their identity transformation
-- in order to avoid boilerplate code
-- when writting 'Trans' instances which
-- do not need to alterate those methods.
class Trans tr where
	-- | Return the underlying @tr@ of the transformer.
	type UnT tr :: * -> *
	
	-- | Lift a tr to the transformer's.
	trans :: UnT tr a -> tr a
	-- | Unlift a tr from the transformer's.
	unTrans :: tr a -> UnT tr a
	
	-- | Identity transformation for a unary symantic method.
	trans1 :: (UnT tr a -> UnT tr b) -> (tr a -> tr b)
	trans1 f = trans . f . unTrans
	
	-- | Identity transformation for a binary symantic method.
	trans2
	 :: (UnT tr a -> UnT tr b -> UnT tr c)
	 -> (tr a -> tr b -> tr c)
	trans2 f t1 t2 = trans $ f (unTrans t1) (unTrans t2)
	
	-- | Identity transformation for a ternary symantic method.
	trans3
	 :: (UnT tr a -> UnT tr b -> UnT tr c -> UnT tr d)
	 -> (tr a -> tr b -> tr c -> tr d)
	trans3 f t1 t2 t3 = trans $ f (unTrans t1) (unTrans t2) (unTrans t3)