{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DataKinds #-}

module Divisive where

import Data.Functor.Contravariant
import Data.Functor.Contravariant.Divisible
import GHC.Records (HasField (getField))
import GHC.OverloadedLabels
import GHC.Exts

data LabelPrx (l :: Symbol) = LabelPrx

instance (l ~ l') => IsLabel l (LabelPrx l') where
  fromLabel = LabelPrx

newtype Build a = Build (a -> String)
  deriving newtype (Semigroup, Monoid)

instance Contravariant Build where
  contramap f (Build g) = Build $ g . f
  

instance Divisible Build where
  divide f (Build bb) (Build bc) =
    Build $ \a -> let (b, c) = f a in bb b <> bc c
  
stringT = Build id
intDecimalT = Build (show @Int)

bar :: (HasField "foo" r String, HasField "bar" r Int) => Build r
bar = divide2 #foo stringT #bar intDecimalT

-- FIXME: How can I tell GHC to infer the right constraints without type sig?
-- bar works, baz does not infer correctly
baz = divide2 #foo stringT #bar intDecimalT

-- | Combine two divisibles into a struct with any two labelled fields.
divide2 ::
  forall l1 l2 t1 t2 d r1 r2.
  (r1 ~ r2, Divisible d, HasField l1 r1 t1, HasField l2 r1 t2) =>
  LabelPrx l1 ->
  d t1 ->
  LabelPrx l2 ->
  d t2 ->
  d r2
{-# INLINE divide2 #-}
divide2 LabelPrx a LabelPrx b = adapt >$< a `divided` b
  where
    adapt r = (getField @l1 r, getField @l2 r)