PartialFill.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}

module Main where

import Control.Lens
import GHC.TypeLits (Symbol)
import Data.Type.Set
import GHC.TypeLits

data Thing = Thing
    { fieldOne      :: String
    , fieldTwo         :: String
    , fieldThree       :: String }
    deriving (Show, Eq)
-- $(makeLensesWith abbreviatedFields ''Thing)

data Partially :: * -> * -> * where
    Partially :: a -> Partially missing a

-- Hack needed because I don't know how can 'Set' use non-'*' kind
data FieldName (s::Symbol)

type instance Cmp (FieldName v) (FieldName u) = CmpSymbol v u

initial :: Partially (Set '[FieldName "one",
                            FieldName "two",
                            FieldName "three"]) Thing
initial =
    Partially (Thing undefined undefined undefined)

setOne :: Partially xs Thing
       -> Partially (Delete (FieldName "one") xs) Thing
setOne (Partially d) = Partially (d { fieldOne = "first value" })

setTwo :: Partially xs Thing
       -> Partially (Delete (FieldName "two") xs) Thing
setTwo (Partially d) = Partially (d { fieldTwo = "second value" })

setThree :: Partially xs Thing
         -> Partially (Delete (FieldName "three") xs) Thing
setThree (Partially d) = Partially (d { fieldThree = "third value" })

finalizePartial :: Partially (Set '[]) a -> a
finalizePartial (Partially a) = a

main :: IO ()
main = do
  print (finalizePartial
           (setThree
              (setTwo
                 (setOne initial))))

  -- Boom!
  -- print (finalizePartial (setTwo (setOne initial)))