module Data.Layer.Coat where
import Prelude
import Control.Lens
import Control.Monad
import Data.Construction
import Data.Layer
newtype Coat a = Coat a deriving (Show, Functor, Foldable, Traversable)
type instance Unlayered (Coat a) = a
type family Uncoated a where Uncoated (Coat a) = a
Uncoated a = Uncoated (Unlayered a)
instance Layered (Coat a)
instance Rewrapped (Coat a) (Coat a')
instance Wrapped (Coat a) where
type Unwrapped (Coat a) = a
_Wrapped' = iso (\(Coat a) -> a) Coat
class Coated a where coated :: Lens' a (Uncoated a)
instance ( Layered a
, Coated (Unlayered a)
, Uncoated a ~ Uncoated (Unlayered a)
) => Coated a where coated = layered . coated
instance Coated (Coat a) where coated = _Wrapped'
uncoat :: Coated a => a -> Uncoated a
uncoat = view coated
class CoatedM m a where viewCoatedM :: a -> m (Uncoated a)
setCoatedM :: Uncoated a -> a -> m a
instance ( Monad m
, LayeredM m a
, CoatedM m (Unlayered a)
, Uncoated a ~ Uncoated (Unlayered a)
) => CoatedM m a where viewCoatedM = viewLayeredM >=> viewCoatedM
setCoatedM = withLayeredM . setCoatedM
instance Monad m => CoatedM m (Coat a) where viewCoatedM = return . uncoat
setCoatedM v = return . set coated v
class CoatConstructor m a where constructCoat :: Uncoated a -> m a
instance ( Monad m
, CoatConstructor m (Destructed a)
, Uncoated a ~ Uncoated (Destructed a)
, Constructor m a
) => CoatConstructor m a where constructCoat = constructCoat >=> construct
instance Monad m => CoatConstructor m (Coat a) where constructCoat = return . Coat