mandatory and optional parameters, using vinyl and composite

OptionalParameters.hs

-- In response to https://twitter.com/mattoflambda/status/1430314500285214725,
-- more specifically the "It could be a row type, like PureScript. That’d be
-- awesome" bit. We do have row types in Haskell, they just come as a library
-- instead of being built into the language! Here's my solution using vinyl and
-- composite.
{-# LANGUAGE DataKinds, FlexibleContexts, TemplateHaskell, TypeApplications, TypeOperators #-}
module Main where

import Control.Lens
import Composite.Record (type (:->), Record, val)
import Composite.TH (withLensesAndProxies)
import Data.Vinyl (type (⊆), Rec((:&), RNil), rappend, rcast, rreplace)
import Data.Vinyl.TypeLevel (type (++))


-- First, let's copy the definitions from the blog post.

data Request = Request String
  deriving Show
data Response = Response String
  deriving Show

logRequest :: Request -> IO ()
logRequest req = do
  putStrLn $ "logRequest: " ++ show req

data Env = Env
  { _accountId       :: String
  , _accountPassword :: String
  , _requestHook     :: Request -> IO Request
  , _responseHook    :: Response -> IO Response
  }


-- The goal is to write a smart constructor for 'Env' which makes the first two
-- fields mandatory while leaving the last two optional (defaulting to "pure"),
-- in a way which doesn't silently do the wrong thing if we reorder fields which
-- happen to have the same type, nor require code changes in the callers if we
-- add more optional fields.


-- My solution uses the composite-base library, so let's first create composite
-- versions of the fields. Note that if 'Env' was defined as a composite record
-- to begin with, this would already be done, so this is extra boilerplate if
-- you're only using composite for this smart constructor, but not if you're
-- buying into the composite ecosystem for the rest of your program.

withLensesAndProxies [d|
  type AccountId       = "accountId"       :-> String
  type AccountPassword = "accountPassword" :-> String
  type RequestHook     = "requestHook"     :-> (Request -> IO Request)
  type ResponseHook    = "responseHook"    :-> (Response -> IO Response)
  |]


-- Next, let's clearly specify which fields are required and optional.
-- If we were buying into the composite ecosystem, we'd be using 'FullEnv'
-- instead of 'Env' everywhere in our program.

type RequiredEnv = '[AccountId, AccountPassword]
type OptionalEnv = '[RequestHook, ResponseHook]
type FullEnv = RequiredEnv ++ OptionalEnv


-- Finally, here is the smart constructor. Note how the constraints on rs
-- express that the caller must specify all the required fields (the required
-- fields must be a subset of the specified fields) and may only specify fields
-- of 'FullEnv' (so that if the caller typos a field names they get an error
-- instead of a silently-ignored argument).

mkEnv
  :: (RequiredEnv ⊆ rs, rs ⊆ FullEnv)
  => Record rs
  -> Env
mkEnv rs = Env
  { _accountId       = overriddenEnv ^. accountId
  , _accountPassword = overriddenEnv ^. accountPassword
  , _requestHook     = overriddenEnv ^. requestHook
  , _responseHook    = overriddenEnv ^. responseHook
  }
  where
    requiredEnv :: Record RequiredEnv
    requiredEnv = rcast rs

    defaultEnv :: Record OptionalEnv
    defaultEnv
      = val @"requestHook" pure
     :& val @"responseHook" pure
     :& RNil

    minimalEnv :: Record FullEnv
    minimalEnv
      = requiredEnv `rappend` defaultEnv

    overriddenEnv :: Record FullEnv
    overriddenEnv
      = rreplace rs minimalEnv


-- And here's what calling the smart constructor looks like. We can't have
--
-- @
--   mkEnv
--     { accountId = "asdfasdf"
--     , accountPassword = "hunter42"
--     , requestHook = \req -> do
--         logRequest req
--         pure req
--     }
-- @
--
-- without shenanigans like TemplateHaskell or a source plugin because curlies
-- are builtin syntax, but as you can see, we can get pretty close!

myCustomEnv
  :: Env
myCustomEnv
  = mkEnv
    $ val @"accountId" "asdfasdf"
   :& val @"accountPassword" "hunter42"
   :& val @"requestHook" (\req -> do
      logRequest req
      pure req)
   :& RNil


-- |
-- >>> main
-- "asdfasdf"
-- "hunter42"
-- logRequest: Request "my request"
-- Request "my request"
-- Response "my response"
main :: IO ()
main = do
  print $ _accountId myCustomEnv
  print $ _accountPassword myCustomEnv
  req <- _requestHook myCustomEnv $ Request "my request"
  print req
  res <- _responseHook myCustomEnv $ Response "my response"
  print res