Main.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wall #-}

module Main where

import GHC.Generics (Generic)
import Data.Generics.Product (constraints, HasConstraints)

import Data.ByteString (ByteString)
import Database.PostgreSQL.Simple (Connection, connectPostgreSQL)

data UsagePhase = ConfigTime | RunTime

class Config t where
  type Phase (p :: UsagePhase) t

class ToRuntime cty rty where
  toRuntime :: cty -> IO rty

instance ToRuntime ty ty where
  toRuntime = return -- for non-phased config fields

gToRuntime :: (Generic s, Generic t, HasConstraints ToRuntime s t) => s -> IO t
gToRuntime = constraints @ToRuntime toRuntime

---

data AppConfig (p :: UsagePhase) = AppConfig
  { userDatabase :: Phase p Connection
  , otherDatabase :: Phase p Connection
  , nThreads :: Int
  } deriving (Generic)

instance Config Connection where
  type Phase 'ConfigTime Connection = ByteString
  type Phase 'RunTime Connection = Connection

instance ToRuntime ByteString Connection where
  toRuntime = connectPostgreSQL

cfgToRuntime :: AppConfig 'ConfigTime -> IO (AppConfig 'RunTime)
cfgToRuntime = gToRuntime

testCfg :: AppConfig 'ConfigTime
testCfg = AppConfig
            "host=localhost user=test password=secret dbname=user"
            "host=localhost user=test password=secret dbname=other"
            2

main :: IO ()
main = do
  runtime <- cfgToRuntime testCfg
  print $ nThreads runtime
  -- ...