module Composite.Opaleye.ProductProfunctors where
import BasicPrelude
import Data.Profunctor (dimap)
import Data.Profunctor.Product (ProductProfunctor, (***!))
import qualified Data.Profunctor.Product as PP
import Data.Profunctor.Product.Default (Default(def))
import Data.Vinyl.Core (Rec((:&), RNil))
import Data.Vinyl.Functor (Identity(Identity))
import Frames ((:->)(Col))
class ProductProfunctor p => PRec p rs where
type PRecContra p rs :: [*]
type PRecCo p rs :: [*]
pRec :: Rec Identity rs -> p (Rec Identity (PRecContra p rs)) (Rec Identity (PRecCo p rs))
instance ProductProfunctor p => PRec p '[] where
type PRecContra p '[] = '[]
type PRecCo p '[] = '[]
pRec RNil = dimap (const ()) (const RNil) PP.empty
instance (ProductProfunctor p, PRec p rs) => PRec p (s :-> p a b ': rs) where
type PRecContra p (s :-> p a b ': rs) = (s :-> a ': PRecContra p rs)
type PRecCo p (s :-> p a b ': rs) = (s :-> b ': PRecCo p rs)
pRec (Identity (Col p) :& rs) =
dimap (\ (Identity (Col a) :& aRs) -> (a, aRs))
(\ (b, bRs) -> (Identity (Col b) :& bRs))
(p ***! pRec rs)
instance ProductProfunctor p => Default p (Rec Identity '[]) (Rec Identity '[]) where
def = dimap (const ()) (const RNil) PP.empty
instance forall p s a b rsContra rsCo. (ProductProfunctor p, Default p a b, Default p (Rec Identity rsContra) (Rec Identity rsCo))
=> Default p (Rec Identity (s :-> a ': rsContra)) (Rec Identity (s :-> b ': rsCo)) where
def =
dimap (\ (Identity (Col a) :& aRs) -> (a, aRs))
(\ (b, bRs) -> (Identity (Col b) :& bRs))
(step ***! recur)
where
step :: p a b
step = def
recur :: p (Rec Identity rsContra) (Rec Identity rsCo)
recur = def