row type HasCodec instance attempt

row-hascodec.hs

-- Necessary Language extensions

import Autodocodec (HasCodec (codec), bimapCodec, (.=))
import Autodocodec qualified as Auto
import Control.Lens
import Data.Row
import Data.Row.Records ()
import Data.Row.Records qualified as Rec
import Data.Text qualified as T
import GHC.OverloadedLabels (IsLabel (fromLabel))
import Data.Generics.Labels


instance forall r. (AllUniqueLabels r, Forall r HasCodec, Rec.Modify "l" (r .! "l") r ~ r) => HasCodec (Rec r) where
    codec =
        Auto.object "" $ Rec.fromLabelsA @HasCodec @(Auto.Codec Object (Rec r)) @r bor
      where
        bor :: (KnownSymbol l, HasCodec a, v ~ a) => Label l -> Auto.Codec Object (Rec r) a
        bor l = Auto.requiredFieldWith' (T.pack $ show l) codec Auto..= (\v -> (v ^. #l) :: a)

instance forall r. (AllUniqueLabels r, Forall r HasCodec) => HasCodec (Rec r) where
    codec =
        Auto.object "" $
            getCompose $
                metamorph @_ @r @HasCodec @Const @(Const ()) @_ @Proxy
                    Proxy
                    (\_ -> Compose (pure Rec.empty))
                    (\_ _ -> Const $ Const ())
                    -- (\l (Const (Compose r)) -> Compose $ Rec.extend l <$> Auto.requiredField' (T.pack $ symbolVal l) Auto..= (Rec..! fromLabel l) <*> r)
                    (doCons (\l -> Auto.requiredField' (T.pack $ symbolVal l) Auto..= (^. #l)))
                    (Const ())

doCons :: forall c f ℓ τ ρ. (KnownSymbol ℓ, c τ, Rec.HasType ℓ τ ρ) => (Label ℓ -> f τ) -> Label ℓ -> Const (Compose f Rec ρ) (Proxy τ) -> Compose f Rec (Rec.Extend ℓ τ ρ)
doCons mk l (Const (Compose r)) = Compose $ Rec.extend l <$> mk l <*> r