configifier-0.0.3: examples/Main.hs

{-# LANGUAGE DataKinds                                #-}
{-# LANGUAGE FlexibleInstances                        #-}
{-# LANGUAGE GADTs                                    #-}
{-# LANGUAGE MultiParamTypeClasses                    #-}
{-# LANGUAGE OverlappingInstances                     #-}
{-# LANGUAGE OverloadedStrings                        #-}
{-# LANGUAGE PolyKinds                                #-}
{-# LANGUAGE ScopedTypeVariables                      #-}
{-# LANGUAGE StandaloneDeriving                       #-}
{-# LANGUAGE TypeFamilies                             #-}
{-# LANGUAGE TypeOperators                            #-}
{-# LANGUAGE UndecidableInstances                     #-}

{-# OPTIONS  #-}

module Main
where

import Control.Applicative ((<$>))
import Data.String.Conversions (ST, cs)
import Data.Typeable (Proxy(Proxy))
import System.Environment (getEnvironment, getArgs)
import Text.Show.Pretty (ppShow)

import qualified Data.ByteString as SBS
import qualified Data.Text.IO as ST

import Data.Configifier


-- * an interesting example

type Cfg = NoDesc CfgDesc
type CfgDesc = ToConfigCode Cfg'

type Cfg' =
             "frontend"      :> ServerCfg :>: "descr"
  :*> Maybe ("backend"       :> ServerCfg)
  :*>        "default_users" :> [UserCfg] :>: "list of users that are created on start if database is empty"

type ServerCfg =
             "bind_port"   :> Int
  :*>        "bind_host"   :> ST
  :*> Maybe ("expose_host" :> ST)

type UserCfg =
             "name"     :> ST :>: "user name (must be unique)"
  :*>        "email"    :> ST :>: "email address (must also be unique)"
  :*>        "password" :> ST :>: "password (not encrypted)"


defaultCfg :: Tagged Cfg
defaultCfg = Tagged $
      Id (Id 8001 :*> Id "localhost" :*> JustO (Id "expose"))
  :*> JustO (Id (Id 8002 :*> Id "localhost" :*> NothingO))
  :*> Id [u1, u2]
  where
    u1 = Id "ralf" :*> Id "ralf@localhost" :*> Id "gandalf"
    u2 = Id "claudi" :*> Id "claudi@remotehost" :*> Id "also_gandalf"


main :: IO ()
main = do
    sources <- sequence
        [ ConfigFileYaml <$> SBS.readFile "examples/config.yaml"
        , ShellEnv       <$> getEnvironment
        , CommandLine    <$> getArgs
        ]

    ST.putStrLn $ docs (Proxy :: Proxy CfgDesc)

    let dump cfg = do
            putStrLn $ ppShow cfg
            putStrLn . cs . renderConfigFile $ cfg

    dump defaultCfg

    case configify sources :: Result Cfg of
        Left e -> print e
        Right cfg -> do
            dump cfg

            putStrLn "accessing config values:"
            print $ cfg >>. (Proxy :: Proxy '["frontend"])
            print $ cfg >>. (Proxy :: Proxy '["frontend", "expose_host"])