Everything is a record

record.hs

#! /usr/bin/env nix-shell
#! nix-shell --pure -i runghc -p "ghc.withPackages (ps: with ps; [ tagged bifunctors ])"

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}

module Main where

import Data.Tagged
import Data.Functor.Sum
import Data.Bifunctor.Join

{-

  I am trying to play with records only instead of type constructors.
  With this kind of stuff we could have free instances without even deriving.

  But by default, the functor instance for (,) is mapping over the right argument.
  I would like to be able to redefine it like for the Product type, mapping both arguments.

  This would let me write something like:

  data K
  type RecordK a = (Maybe a, Either String a)
  type TypeK a = Tagged K (RecordK a)

  f :: TypeK Int -> TypeK String
  -- first fmap we go inside the Tagged
  -- second we fmap the tuple => only right
  f = fmap $ fmap $ fmap show

  Right now, the above code would create a (Maybe Int, Identity String), which is not typechecking.
  We can use the Product type for thatn but we have to manually wrap/unwrap which is boring.

  data Prod f g a = Prod { unProd :: (f a, g a) }
  
  instance (Functor f, Functor g) => Functor (Prod f g) where
    fmap f (Prod (fa, ga)) = Prod (f <$> fa, f <$> ga)
  
  data K
  type RecordK a = (Maybe a, Either String a)
  type TypeK a = Tagged K (RecordK a)
  
  f :: TypeK Int -> TypeK String
  f = fmap $ unProduct . fmap show . Product

-}

type (:+:) = Either

data T
type RecordT = (Int, Int)
type TypeT = Tagged T RecordT

data U
type RecordU = (Int, Int)
type TypeU = Tagged U RecordU

data V
type RecordV a = (Int, a)
type TypeV a = Tagged V (RecordV a)

type TypeW = Tagged (T :+: U) (RecordT :+: RecordU)

mkT :: Int -> Int -> TypeT
mkT x y = Tagged (x, y)

tGetX :: TypeT -> Int
tGetX = fst . unTagged

tGetY :: TypeT -> Int
tGetY = snd . unTagged

mkU :: Int -> Int -> TypeU
mkU x y = Tagged (x, y)

uGetX :: TypeU -> Int
uGetX = fst . unTagged

uGetY :: TypeU -> Int
uGetY = snd . unTagged

mkV :: Int -> a -> TypeV a
mkV x y = Tagged (x, y)

mkGeneric :: a -> Tagged k a
mkGeneric = Tagged

main :: IO ()
main = 
  let x = tGetX $ mkT 4 5
      y = mkV 3 $ mkT 2 4
      z :: TypeV RecordT
      z = retag $ (5,) <$> mkT 2 4
  in pure ()