{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
module Barbies.Internal.Wrappers
  ( Barbie(..)
  ) where

import Barbies.Internal.ApplicativeB
import Barbies.Internal.ConstraintsB
import Barbies.Internal.Dicts
import Barbies.Internal.FunctorB
import Barbies.Internal.TraversableB

import Data.Kind (Type)


-- | A wrapper for Barbie-types, providing useful instances.
newtype Barbie (b :: (k -> Type) -> Type) f
  = Barbie { forall k (b :: (k -> *) -> *) (f :: k -> *). Barbie b f -> b f
getBarbie :: b f }
  deriving (forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> Barbie b f -> Barbie b g
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
 (forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> g a) -> Barbie b f -> Barbie b g
bmap :: forall (f :: k -> *) (g :: k -> *).
(forall (a :: k). f a -> g a) -> Barbie b f -> Barbie b g
$cbmap :: forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> Barbie b f -> Barbie b g
FunctorB, forall k (b :: (k -> *) -> *).
FunctorB b
-> (forall (f :: k -> *). (forall (a :: k). f a) -> b f)
-> (forall (f :: k -> *) (g :: k -> *).
    b f -> b g -> b (Product f g))
-> ApplicativeB b
forall {k} {b :: (k -> *) -> *}.
ApplicativeB b =>
FunctorB (Barbie b)
forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> Barbie b f
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
Barbie b f -> Barbie b g -> Barbie b (Product f g)
forall (f :: k -> *). (forall (a :: k). f a) -> Barbie b f
forall (f :: k -> *) (g :: k -> *).
Barbie b f -> Barbie b g -> Barbie b (Product f g)
bprod :: forall (f :: k -> *) (g :: k -> *).
Barbie b f -> Barbie b g -> Barbie b (Product f g)
$cbprod :: forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
ApplicativeB b =>
Barbie b f -> Barbie b g -> Barbie b (Product f g)
bpure :: forall (f :: k -> *). (forall (a :: k). f a) -> Barbie b f
$cbpure :: forall k (b :: (k -> *) -> *) (f :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a) -> Barbie b f
ApplicativeB)

-- Need to derive it manually to make GHC 8.0.2 happy
instance ConstraintsB b => ConstraintsB (Barbie b) where
  type AllB c (Barbie b) = AllB c b
  baddDicts :: forall (c :: k -> Constraint) (f :: k -> *).
AllB c (Barbie b) =>
Barbie b f -> Barbie b (Product (Dict c) f)
baddDicts = forall k (b :: (k -> *) -> *) (f :: k -> *). b f -> Barbie b f
Barbie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (c :: k -> Constraint) (f :: k -> *).
(ConstraintsB b, AllB c b) =>
b f -> b (Product (Dict c) f)
baddDicts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (f :: k -> *). Barbie b f -> b f
getBarbie

instance TraversableB b => TraversableB (Barbie b) where
  btraverse :: forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
Applicative e =>
(forall (a :: k). f a -> e (g a)) -> Barbie b f -> e (Barbie b g)
btraverse forall (a :: k). f a -> e (g a)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (b :: (k -> *) -> *) (f :: k -> *). b f -> Barbie b f
Barbie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse forall (a :: k). f a -> e (g a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (b :: (k -> *) -> *) (f :: k -> *). Barbie b f -> b f
getBarbie


instance (ConstraintsB b, ApplicativeB b, AllBF Semigroup f b) => Semigroup (Barbie b f) where
  <> :: Barbie b f -> Barbie b f -> Barbie b f
(<>) = forall {k} (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *)
       (h :: k -> *) (i :: k -> *).
ApplicativeB b =>
(forall (a :: k). f a -> g a -> h a -> i a)
-> b f -> b g -> b h -> b i
bzipWith3 forall (a :: k). Dict (ClassF Semigroup f) a -> f a -> f a -> f a
mk forall {k} (c :: k -> Constraint) (b :: (k -> *) -> *).
(ConstraintsB b, ApplicativeB b, AllB c b) =>
b (Dict c)
bdicts
    where
      mk :: Dict (ClassF Semigroup f) a -> f a -> f a -> f a
      mk :: forall (a :: k). Dict (ClassF Semigroup f) a -> f a -> f a -> f a
mk = forall {k} (c :: k -> Constraint) (a :: k) r.
(c a => r) -> Dict c a -> r
requiringDict forall a. Semigroup a => a -> a -> a
(<>)

instance (ConstraintsB b, ApplicativeB b, AllBF Semigroup f b, AllBF Monoid f b) => Monoid (Barbie b f) where
  mempty :: Barbie b f
mempty  = forall {k} (f :: k -> *) (b :: (k -> *) -> *).
(AllBF Monoid f b, ConstraintsB b, ApplicativeB b) =>
b f
bmempty
  mappend :: Barbie b f -> Barbie b f -> Barbie b f
mappend = forall a. Semigroup a => a -> a -> a
(<>)