{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}

{-|
Module      : Data.Partial
Description : Constructing records with default values
Copyright   : (C) mniip 2019
License     : BSD3
Maintainer  : mniip@email.com
Stability   : experimental

If you have a datatype with a lot of default-able fields, e.g.

@
data Foo =
  { fld1 :: Maybe Int
  , fld2 :: Maybe Char
  , fld3 :: Word
  }
@

and you want to avoid the the boilerplate of writing all the default values
every time you construct a record of this type, you could write a "default
value" of this type:

@
defaultFoo :: Foo
defaultFoo = Foo { fld1 = Nothing, fld2 = Nothing, fld3 = 0 }
@

You could then use record modification syntax to make necessary changes to
this value. But perhaps you can't/don't want to provide default values for
/all/ of the fields, but only some of them? You could implement a "default
smart constructor" that would take the non-optional arguments and then fill in
the optional ones like so:

@
defaultFoo :: Word -> Foo
defaultFoo x = Foo { fld1 = Nothing, fld2 = Nothing, fld3 = x }
@

But then you lose the benefit of record syntax: you can't name the fields
you're providing values for.

This package reconciles the two problems: with only a little bit of Template
Haskell it provides a way to construct a record with optional fields while
also letting you refer to the names of those fields. You make two splices:

@
'Data.Partial.TH.mkToPartial' ''Foo
  -- defines mkfld1, mkfld2, mkfld3
'Data.Partial.TH.mkFromPartial' "mkFoo" [t|Foo|] [|Foo { fld1 = Nothing, fld2 = Nothing }|]
  -- defines mkFoo
@

And then you can use them like so:

@
val :: Foo
val = mkFoo
  $ mkfld3 123
  '?' mkfld1 (Just 456)
-- val = Foo { fld1 = Just 456, fld2 = Nothing, fld3 = 123 }
@

The Template Haskell splice lets you define default values for a subset of the
fields, and those defaults will be used when you call @mkFoo@. You can list
fields in any order, but if you omit a mandatory field (one that doesn't have
a default), that would be a type error at compile time.

You can make multiple 'Data.Partial.TH.mkFromPartial' splices, this is
occasionally useful for parameterized types, for example:

@
data Bar a =
  { bar1 :: Maybe Int
  , bar2 :: a
  }
'Data.Partial.TH.mkToPartial' ''Bar
'Data.Partial.TH.mkFromPartial' "mkBar" [t|forall a. Bar a|]
  [|Bar { bar1 = Nothing }|]
  -- mkBar :: ... -> Bar a, and bar2 is a required field
'Data.Partial.TH.mkFromPartial' "mkBarMaybe" [t|forall a. Bar (Maybe a)|]
  [|Bar { bar1 = Nothing, bar2 = Nothing }|]
  -- mkBarMaybe :: ... -> Bar (Maybe a), and bar2 is an optional field
@
-}
module Data.Partial
  ( Partial
  , Graded(..)
  , type (<||>)
  )
  where

import Data.Type.Bool

-- | @Partial T '[b1, b2, ...]@ is a partial version of the datatype @T@ where
-- the first field's presence is indicated by @b1 :: Bool@, second field's
-- presence is indicated by @b2@ and so on. Instances of this would be generated
-- by 'Data.Partial.TH.mkToPartial'.
data family Partial (a :: *) :: [Bool] -> *

-- | A "graded semigroup": if we have two partial structures with only some of
-- the fields, we can merge them to obtain a partial structure with the union of
-- the fields. Prefers to take fields from the left hand side. Instances of this
-- would be generated by 'Data.Partial.TH.mkToPartial'.
class Graded a where
  (?) :: Partial a b1 -> Partial a b2 -> Partial a (b1 <||> b2)

type family (b1 :: [Bool]) <||> (b2 :: [Bool]) :: [Bool] where
  (x0 ': x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': xs) <||> (y0 ': y1 ': y2 ': y3 ': y4 ': y5 ': y6 ': y7 ': ys) = (x0 || y0) ': (x1 || y1) ': (x2 || y2) ': (x3 || y3) ': (x4 || y4) ': (x5 || y5) ': (x6 || y6) ': (x7 || y7) ': (xs <||> ys)
  -- This equation is semantically not necessary, but it reduces the number of
  -- reductions this type family has to make and thus the size of the generated
  -- coercions that the typechecker has to drag around, greatly reducing
  -- compilation time. The length of 8 has been found to be optimal when
  -- benchmarking on GHC 8.6.5
  (x ': xs) <||> (y ': ys) = (x || y) ': (xs <||> ys)
  '[] <||> '[] = '[]