product-profunctor example

{-# LANGUAGE TemplateHaskell #-}

module Main where

import ClassyPrelude
import Data.Profunctor
import Data.Profunctor.Product
import Data.Profunctor.Product.Default
import Data.Profunctor.Product.TH

newtype Wrap1 i = Wrap1 {unWrap1 :: i} deriving (Num, Functor, Generic)

newtype Wrap2 i = Wrap2 {unWrap2 :: i} deriving (Num, Functor, Generic)

instance Applicative Wrap1 where
    pure = Wrap1
    Wrap1 x <*> Wrap1 y = Wrap1 $ x y

instance Applicative Wrap2 where
    pure = Wrap2
    Wrap2 x <*> Wrap2 y = Wrap2 $ x y

newtype PP a b = PP {unPP :: a -> b} deriving (Profunctor, ProductProfunctor)

pp1 :: forall c. Show c => PP (Wrap1 c) String
pp1 = PP $ show . unWrap1

pp2 :: forall c. (Num c, Show c) => PP (Wrap2 c) String
pp2 = PP $ show . (* 2) . unWrap2

instance Show a => Default PP (Wrap1 a) String where def = pp1
instance (Num a, Show a) => Default PP (Wrap2 a) String where def = pp2

v1 :: (String, String)
v1 = unPP def (Wrap1 @Int 2, Wrap2 @Int 3)

-- Some product type that has potentially many fields relative to its type params, so manually spelling out
-- what to do with each field is laborious and using ProductProfunctor specifying in terms of what to do with
-- each field type is more succinct.
data Foo a b = Foo { x :: a, y :: b, z :: b } deriving (Generic, Show)

$(makeAdaptorAndInstance' ''Foo)

v2 :: Foo String String
v2 = unPP def $ Foo (Wrap1 @Int 2) (Wrap2 @Int 3) (Wrap2 @Int 4)

main :: IO ()
main = print v1 >> print v2
-- OUTPUT:
-- ("2","6")
-- Foo {x = "2", y = "6", z = "8"}