{-# LANGUAGE RankNTypes #-}

module Barbies.Bare.Layered
  ( -- * Bare values
    Wear
  , Bare
  , Covered
    -- * Covering and stripping
  , BareB (bstrip, bcover)
  , bstripFrom
  , bcoverWith
  ) where

import Barbies.Bare                (Bare, Covered, Wear)
import Data.Functor.Barbie.Layered (FunctorB (bmap))
import Data.Functor.Identity       (Identity (Identity, runIdentity))

-- | Class of Barbie-types defined using 'Wear' and can therefore
-- have 'Bare' versions. Must satisfy:
--
-- @
-- 'bcover' . 'bstrip' = 'id'
-- 'bstrip' . 'bcover' = 'id'
-- @
class FunctorB (b Covered) => BareB b where
  bstrip :: b Covered Identity -> b Bare Identity
  bcover :: b Bare Identity -> b Covered Identity

-- | Generalization of 'bstrip' to arbitrary functors.
bstripFrom :: (BareB b, Functor f) => (forall a . f a -> a) -> b Covered f -> b Bare Identity
bstripFrom :: (forall a. f a -> a) -> b Covered f -> b Bare Identity
bstripFrom forall a. f a -> a
f = b Covered Identity -> b Bare Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Covered Identity -> b Bare Identity
bstrip (b Covered Identity -> b Bare Identity)
-> (b Covered f -> b Covered Identity)
-> b Covered f
-> b Bare Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> Identity a) -> b Covered f -> b Covered Identity
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap (a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> (f a -> a) -> f a -> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> a
forall a. f a -> a
f)

-- | Generalization of 'bcover' to arbitrary functors.
bcoverWith :: (BareB b, Functor f) => (forall a . a -> f a) -> b Bare Identity -> b Covered f
bcoverWith :: (forall a. a -> f a) -> b Bare Identity -> b Covered f
bcoverWith forall a. a -> f a
f = (forall a. Identity a -> f a) -> b Covered Identity -> b Covered f
forall (b :: (* -> *) -> *) (f :: * -> *) (g :: * -> *).
(FunctorB b, Functor f, Functor g) =>
(forall a. f a -> g a) -> b f -> b g
bmap (a -> f a
forall a. a -> f a
f (a -> f a) -> (Identity a -> a) -> Identity a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) (b Covered Identity -> b Covered f)
-> (b Bare Identity -> b Covered Identity)
-> b Bare Identity
-> b Covered f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b Bare Identity -> b Covered Identity
forall (b :: * -> (* -> *) -> *).
BareB b =>
b Bare Identity -> b Covered Identity
bcover