AtLeastOneValue.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- https://twitter.com/ChShersh/status/1544240982559948801
module Main where

import Data.Kind (Type)
import Data.RBR -- from package "red-black-record"
  ( Deletable (Delete),
    FromList,
    I,
    Record,
    Variant,
    injectI,
    insert,
    unit,
  )
import Data.RBR.Subset (projectSubset)
import GHC.TypeLits (Symbol)

type MyTypeTypes = ['("a", Int), '("b", Bool), '("c", Char), '("d", Float)]

type MyTypeTree = FromList MyTypeTypes

type family Expand (x :: [(Symbol, Type)]) :: [(Symbol, Type)] where
  Expand '[] = '[]
  Expand ('(k, v) ': ts) = '(k, (v, Record Maybe (Delete k v MyTypeTree))) ': Expand ts

type MyTypeTreeExpanded = FromList (Expand MyTypeTypes)

type MyType = Variant I MyTypeTreeExpanded

myVal :: MyType
myVal =
  injectI @"b" $
    ( True,
      projectSubset $
        insert @"a" @Int (Just 3) $ insert @"c" @Char (Just 'c') $ insert @"d" @Float Nothing $ unit
    )

main :: IO ()
main = print myVal
-- fromNS (S (Z (I (True,fromNP (Just 3 :* Just 'c' :* Nothing :* Nil)))))