{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Row.Barbies
--
-- This module adds Barbies instances for 'Rec' and 'Var'.
--
-----------------------------------------------------------------------------


module Data.Row.Barbies () where

import           Data.Functor.Compose
import           Data.Functor.Identity
import           Data.Functor.Product
import           Data.Row
import           Data.Row.Dictionaries
import qualified Data.Row.Records      as Rec
import qualified Data.Row.Variants     as Var

import           Data.Functor.Barbie (FunctorB(..), TraversableB(..), DistributiveB(..), ApplicativeB(..), ConstraintsB(..))
import qualified Barbies.Constraints as B

-- | Barbies requires that the functor be the final argument of the type.  So,
-- even though the real type is @Rec (Map f ρ)@, we must wrap it in a newtype
-- wrapper so that 'f' is at the end.
newtype BarbieRec (ρ :: Row *) (f :: * -> *) = BarbieRec { BarbieRec ρ f -> Rec (Map f ρ)
unBarbieRec :: Rec (Rec.Map f ρ) }
newtype BarbieVar (ρ :: Row *) (f :: * -> *) = BarbieVar { BarbieVar ρ f -> Var (Map f ρ)
unBarbieVar :: Var (Var.Map f ρ) }

instance FreeForall r => FunctorB (BarbieRec r) where
  bmap :: (forall a. f a -> g a) -> BarbieRec r f -> BarbieRec r g
bmap forall a. f a -> g a
f = Rec (Map g r) -> BarbieRec r g
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (Rec (Map g r) -> BarbieRec r g)
-> (BarbieRec r f -> Rec (Map g r))
-> BarbieRec r f
-> BarbieRec r g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> g a) -> Rec (Map f r) -> Rec (Map g r)
forall a (r :: Row a) (f :: a -> *) (g :: a -> *).
FreeForall r =>
(forall (a1 :: a). f a1 -> g a1) -> Rec (Map f r) -> Rec (Map g r)
Rec.transform' @r forall a. f a -> g a
f (Rec (Map f r) -> Rec (Map g r))
-> (BarbieRec r f -> Rec (Map f r))
-> BarbieRec r f
-> Rec (Map g r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieRec r f -> Rec (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieRec ρ f -> Rec (Map f ρ)
unBarbieRec

instance FreeForall r => TraversableB (BarbieRec r) where
  btraverse :: forall e f g. Applicative e => (forall a. f a -> e (g a)) -> BarbieRec r f -> e (BarbieRec r g)
  btraverse :: (forall a. f a -> e (g a)) -> BarbieRec r f -> e (BarbieRec r g)
btraverse forall a. f a -> e (g a)
f  = (Rec (Map g r) -> BarbieRec r g)
-> e (Rec (Map g r)) -> e (BarbieRec r g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (Map g r) -> BarbieRec r g
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (e (Rec (Map g r)) -> e (BarbieRec r g))
-> (BarbieRec r f -> e (Rec (Map g r)))
-> BarbieRec r f
-> e (BarbieRec r g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a1. Unconstrained1 a1 => f a1 -> e (g a1))
-> Rec (Map f r) -> e (Rec (Map g r))
forall a (c :: a -> Constraint) (f :: * -> *) (g :: a -> *)
       (h :: a -> *) (r :: Row a).
(Forall r c, Applicative f) =>
(forall (a1 :: a). c a1 => g a1 -> f (h a1))
-> Rec (Map g r) -> f (Rec (Map h r))
Rec.traverseMap @Unconstrained1 @e @f @g @r forall a. f a -> e (g a)
forall a1. Unconstrained1 a1 => f a1 -> e (g a1)
f (Rec (Map f r) -> e (Rec (Map g r)))
-> (BarbieRec r f -> Rec (Map f r))
-> BarbieRec r f
-> e (Rec (Map g r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieRec r f -> Rec (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieRec ρ f -> Rec (Map f ρ)
unBarbieRec

instance FreeForall r => DistributiveB (BarbieRec r) where
  bdistribute :: forall f g. Functor f => f (BarbieRec r g) -> BarbieRec r (Compose f g)
  bdistribute :: f (BarbieRec r g) -> BarbieRec r (Compose f g)
bdistribute = Rec (Map (Compose f g) r) -> BarbieRec r (Compose f g)
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (Rec (Map (Compose f g) r) -> BarbieRec r (Compose f g))
-> (f (BarbieRec r g) -> Rec (Map (Compose f g) r))
-> f (BarbieRec r g)
-> BarbieRec r (Compose f g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeForall r => Rec (Map f (Map g r)) -> Rec (Map (Compose f g) r)
forall k a (f :: k -> *) (g :: a -> k) (r :: Row a).
FreeForall r =>
Rec (Map f (Map g r)) -> Rec (Map (Compose f g) r)
Rec.compose @f @g @r (Rec (Map f (Map g r)) -> Rec (Map (Compose f g) r))
-> (f (BarbieRec r g) -> Rec (Map f (Map g r)))
-> f (BarbieRec r g)
-> Rec (Map (Compose f g) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Forall (Map g r) Unconstrained1, Functor f) =>
f (Rec (Map g r)) -> Rec (Map f (Map g r))
forall (f :: * -> *) (r :: Row *).
(FreeForall r, Functor f) =>
f (Rec r) -> Rec (Map f r)
Rec.distribute @f @(Rec.Map g r) (f (Rec (Map g r)) -> Rec (Map f (Map g r)))
-> (f (BarbieRec r g) -> f (Rec (Map g r)))
-> f (BarbieRec r g)
-> Rec (Map f (Map g r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarbieRec r g -> Rec (Map g r))
-> f (BarbieRec r g) -> f (Rec (Map g r))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BarbieRec r g -> Rec (Map g r)
forall (ρ :: Row *) (f :: * -> *). BarbieRec ρ f -> Rec (Map f ρ)
unBarbieRec
    (Forall (Map g r) Unconstrained1 =>
 f (BarbieRec r g) -> BarbieRec r (Compose f g))
-> (Forall (Map g r) (IsA Unconstrained1 g)
    :- Forall (Map g r) Unconstrained1)
-> f (BarbieRec r g)
-> BarbieRec r (Compose f g)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Forall (Map g r) (IsA Unconstrained1 g)
:- Forall (Map g r) Unconstrained1
forall k (r :: Row k) (c :: k -> Constraint).
Forall r c :- Forall r Unconstrained1
freeForall @(Rec.Map g r) @(IsA Unconstrained1 g) (Forall (Map g r) (IsA Unconstrained1 g) =>
 f (BarbieRec r g) -> BarbieRec r (Compose f g))
-> (FreeForall r :- Forall (Map g r) (IsA Unconstrained1 g))
-> f (BarbieRec r g)
-> BarbieRec r (Compose f g)
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ FreeForall r :- Forall (Map g r) (IsA Unconstrained1 g)
forall k1 k2 (f :: k1 -> k2) (ρ :: Row k1) (c :: k1 -> Constraint).
Forall ρ c :- Forall (Map f ρ) (IsA c f)
mapForall @g @r @Unconstrained1

instance (AllUniqueLabels r, FreeForall r) => ApplicativeB (BarbieRec r) where
  bpure :: forall f. (forall a. f a) -> BarbieRec r f
  bpure :: (forall a. f a) -> BarbieRec r f
bpure forall a. f a
fa = Rec (Map f r) -> BarbieRec r f
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (Rec (Map f r) -> BarbieRec r f) -> Rec (Map f r) -> BarbieRec r f
forall a b. (a -> b) -> a -> b
$ Identity (Rec (Map f r)) -> Rec (Map f r)
forall a. Identity a -> a
runIdentity (Identity (Rec (Map f r)) -> Rec (Map f r))
-> Identity (Rec (Map f r)) -> Rec (Map f r)
forall a b. (a -> b) -> a -> b
$ (forall (l :: Symbol) a1.
 (KnownSymbol l, Unconstrained1 a1) =>
 Label l -> Identity (f a1))
-> Identity (Rec (Map f r))
forall a (c :: a -> Constraint) (f :: * -> *) (g :: a -> *)
       (ρ :: Row a).
(Applicative f, Forall ρ c, AllUniqueLabels ρ) =>
(forall (l :: Symbol) (a1 :: a).
 (KnownSymbol l, c a1) =>
 Label l -> f (g a1))
-> f (Rec (Map g ρ))
Rec.fromLabelsMapA @Unconstrained1 @Identity @f @r (Identity (f a1) -> Label l -> Identity (f a1)
forall a b. a -> b -> a
const (Identity (f a1) -> Label l -> Identity (f a1))
-> Identity (f a1) -> Label l -> Identity (f a1)
forall a b. (a -> b) -> a -> b
$ f a1 -> Identity (f a1)
forall a. a -> Identity a
Identity f a1
forall a. f a
fa)

  bprod :: forall f g. BarbieRec r f -> BarbieRec r g -> BarbieRec r (f `Product` g)
  bprod :: BarbieRec r f -> BarbieRec r g -> BarbieRec r (Product f g)
bprod (BarbieRec Rec (Map f r)
r1) (BarbieRec Rec (Map g r)
r2) = Rec (Map (Product f g) r) -> BarbieRec r (Product f g)
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (Rec (Map (Product f g) r) -> BarbieRec r (Product f g))
-> Rec (Map (Product f g) r) -> BarbieRec r (Product f g)
forall a b. (a -> b) -> a -> b
$ (forall a1. Unconstrained1 a1 => f a1 -> g a1 -> Product f g a1)
-> Rec (Map f r) -> Rec (Map g r) -> Rec (Map (Product f g) r)
forall a (c :: a -> Constraint) (r :: Row a) (f :: a -> *)
       (g :: a -> *) (h :: a -> *).
Forall r c =>
(forall (a1 :: a). c a1 => f a1 -> g a1 -> h a1)
-> Rec (Map f r) -> Rec (Map g r) -> Rec (Map h r)
Rec.zipTransform @Unconstrained1 @r @f @g @(Product f g) forall a1. Unconstrained1 a1 => f a1 -> g a1 -> Product f g a1
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair Rec (Map f r)
r1 Rec (Map g r)
r2

instance FreeForall r => ConstraintsB (BarbieRec r) where
  type AllB c (BarbieRec r) = Forall r c
  baddDicts :: forall c f. Forall r c => BarbieRec r f -> BarbieRec r (B.Dict c `Product` f)
  baddDicts :: BarbieRec r f -> BarbieRec r (Product (Dict c) f)
baddDicts = Rec (Map (Product (Dict c) f) r)
-> BarbieRec r (Product (Dict c) f)
forall (ρ :: Row *) (f :: * -> *). Rec (Map f ρ) -> BarbieRec ρ f
BarbieRec (Rec (Map (Product (Dict c) f) r)
 -> BarbieRec r (Product (Dict c) f))
-> (BarbieRec r f -> Rec (Map (Product (Dict c) f) r))
-> BarbieRec r f
-> BarbieRec r (Product (Dict c) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a1. c a1 => f a1 -> Product (Dict c) f a1)
-> Rec (Map f r) -> Rec (Map (Product (Dict c) f) r)
forall a (c :: a -> Constraint) (r :: Row a) (f :: a -> *)
       (g :: a -> *).
Forall r c =>
(forall (a1 :: a). c a1 => f a1 -> g a1)
-> Rec (Map f r) -> Rec (Map g r)
Rec.transform @c @r @f @(B.Dict c `Product` f) (Dict c a1 -> f a1 -> Product (Dict c) f a1
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall a. c a => Dict c a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
B.Dict @c)) (Rec (Map f r) -> Rec (Map (Product (Dict c) f) r))
-> (BarbieRec r f -> Rec (Map f r))
-> BarbieRec r f
-> Rec (Map (Product (Dict c) f) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieRec r f -> Rec (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieRec ρ f -> Rec (Map f ρ)
unBarbieRec



instance FreeForall r => FunctorB (BarbieVar r) where
  bmap :: (forall a. f a -> g a) -> BarbieVar r f -> BarbieVar r g
bmap forall a. f a -> g a
f = Var (Map g r) -> BarbieVar r g
forall (ρ :: Row *) (f :: * -> *). Var (Map f ρ) -> BarbieVar ρ f
BarbieVar (Var (Map g r) -> BarbieVar r g)
-> (BarbieVar r f -> Var (Map g r))
-> BarbieVar r f
-> BarbieVar r g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. f a -> g a) -> Var (Map f r) -> Var (Map g r)
forall a (r :: Row a) (f :: a -> *) (g :: a -> *).
FreeForall r =>
(forall (a1 :: a). f a1 -> g a1) -> Var (Map f r) -> Var (Map g r)
Var.transform' @r forall a. f a -> g a
f (Var (Map f r) -> Var (Map g r))
-> (BarbieVar r f -> Var (Map f r))
-> BarbieVar r f
-> Var (Map g r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieVar r f -> Var (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieVar ρ f -> Var (Map f ρ)
unBarbieVar

instance FreeForall r => TraversableB (BarbieVar r) where
  btraverse :: forall e f g. Applicative e => (forall a. f a -> e (g a)) -> BarbieVar r f -> e (BarbieVar r g)
  btraverse :: (forall a. f a -> e (g a)) -> BarbieVar r f -> e (BarbieVar r g)
btraverse forall a. f a -> e (g a)
f  = (Var (Map g r) -> BarbieVar r g)
-> e (Var (Map g r)) -> e (BarbieVar r g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var (Map g r) -> BarbieVar r g
forall (ρ :: Row *) (f :: * -> *). Var (Map f ρ) -> BarbieVar ρ f
BarbieVar (e (Var (Map g r)) -> e (BarbieVar r g))
-> (BarbieVar r f -> e (Var (Map g r)))
-> BarbieVar r f
-> e (BarbieVar r g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a1. Unconstrained1 a1 => f a1 -> e (g a1))
-> Var (Map f r) -> e (Var (Map g r))
forall a (c :: a -> Constraint) (f :: * -> *) (g :: a -> *)
       (h :: a -> *) (r :: Row a).
(Forall r c, Functor f) =>
(forall (a1 :: a). c a1 => g a1 -> f (h a1))
-> Var (Map g r) -> f (Var (Map h r))
Var.traverseMap @Unconstrained1 @e @f @g @r forall a. f a -> e (g a)
forall a1. Unconstrained1 a1 => f a1 -> e (g a1)
f (Var (Map f r) -> e (Var (Map g r)))
-> (BarbieVar r f -> Var (Map f r))
-> BarbieVar r f
-> e (Var (Map g r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieVar r f -> Var (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieVar ρ f -> Var (Map f ρ)
unBarbieVar

instance FreeForall r => ConstraintsB (BarbieVar r) where
  type AllB c (BarbieVar r) = Forall r c
  baddDicts :: forall c f. Forall r c => BarbieVar r f -> BarbieVar r (B.Dict c `Product` f)
  baddDicts :: BarbieVar r f -> BarbieVar r (Product (Dict c) f)
baddDicts = Var (Map (Product (Dict c) f) r)
-> BarbieVar r (Product (Dict c) f)
forall (ρ :: Row *) (f :: * -> *). Var (Map f ρ) -> BarbieVar ρ f
BarbieVar (Var (Map (Product (Dict c) f) r)
 -> BarbieVar r (Product (Dict c) f))
-> (BarbieVar r f -> Var (Map (Product (Dict c) f) r))
-> BarbieVar r f
-> BarbieVar r (Product (Dict c) f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a1. c a1 => f a1 -> Product (Dict c) f a1)
-> Var (Map f r) -> Var (Map (Product (Dict c) f) r)
forall a (c :: a -> Constraint) (r :: Row a) (f :: a -> *)
       (g :: a -> *).
Forall r c =>
(forall (a1 :: a). c a1 => f a1 -> g a1)
-> Var (Map f r) -> Var (Map g r)
Var.transform @c @r @f @(B.Dict c `Product` f) (Dict c a1 -> f a1 -> Product (Dict c) f a1
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair (forall a. c a => Dict c a
forall k (c :: k -> Constraint) (a :: k). c a => Dict c a
B.Dict @c)) (Var (Map f r) -> Var (Map (Product (Dict c) f) r))
-> (BarbieVar r f -> Var (Map f r))
-> BarbieVar r f
-> Var (Map (Product (Dict c) f) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BarbieVar r f -> Var (Map f r)
forall (ρ :: Row *) (f :: * -> *). BarbieVar ρ f -> Var (Map f ρ)
unBarbieVar