    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE OverloadedStrings  #-}
    {-# LANGUAGE DeriveDataTypeable #-}

    module Snap.Snaplet.Config where

    ------------------------------------------------------------------------------
    import Data.Function                    (on)
    import Data.Maybe                       (fromMaybe)
    import Data.Monoid                      (Last(..), getLast)

    #if MIN_VERSION_base(4,10,0)
    import           Data.Typeable          (Typeable)
    #elif MIN_VERSION_base(4,7,0)
    import           Data.Typeable.Internal (Typeable)
    #else
    import           Data.Typeable          (Typeable, TyCon, mkTyCon,
                                             mkTyConApp, typeOf)
    #endif

    #if !MIN_VERSION_base(4,8,0)
    import Data.Monoid                      (Monoid, mappend, mempty)
    #endif

    #if !MIN_VERSION_base(4,11,0)
    import           Data.Semigroup         (Semigroup(..))
    #endif

    import System.Console.GetOpt            (OptDescr(Option), ArgDescr(ReqArg))
    ------------------------------------------------------------------------------
    import Snap.Core
    import Snap.Http.Server.Config (Config, fmapOpt, setOther, getOther, optDescrs
                                   ,extendedCommandLineConfig)

    ------------------------------------------------------------------------------
    -- | AppConfig contains the config options for command line arguments in
    -- snaplet-based apps.
    newtype AppConfig = AppConfig { appEnvironment :: Maybe String }
    #if MIN_VERSION_base(4,7,0)
      deriving Typeable
    #else

    ------------------------------------------------------------------------------
    -- | AppConfig has a manual instance of Typeable due to limitations in the
    -- tools available before GHC 7.4, and the need to make dynamic loading
    -- tractable.  When support for earlier versions of GHC is dropped, the
    -- dynamic loader package can be updated so that manual Typeable instances
    -- are no longer needed.
    appConfigTyCon :: TyCon
    appConfigTyCon = mkTyCon "Snap.Snaplet.Config.AppConfig"
    {-# NOINLINE appConfigTyCon #-}

    instance Typeable AppConfig where
        typeOf _ = mkTyConApp appConfigTyCon []
    #endif

    instance Semigroup AppConfig where
        a <> b = AppConfig
            { appEnvironment = ov appEnvironment a b
            }
          where
            ov f x y = getLast $! ((<>) `on` (Last . f)) x y

    ------------------------------------------------------------------------------
    instance Monoid AppConfig where
        mempty = AppConfig Nothing
    #if !MIN_VERSION_base(4,11,0)
        mappend = (<>)
    #endif

    ------------------------------------------------------------------------------
    -- | Command line options for snaplet applications.
    appOpts :: AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    appOpts defaults = map (fmapOpt $ fmap (flip setOther mempty))
        [ Option ['e'] ["environment"]
                 (ReqArg setter "ENVIRONMENT")
                 $ "runtime environment to use" ++ defaultC appEnvironment
        ]
      where
        setter s = Just $ mempty { appEnvironment = Just s}
        defaultC f = maybe "" ((", default " ++) . show) $ f defaults

    ------------------------------------------------------------------------------
    -- | Calls snap-server's extendedCommandLineConfig to add snaplet options to
    -- the built-in server command line options.
    commandLineAppConfig :: MonadSnap m
                         => Config m AppConfig
                         -> IO (Config m AppConfig)
    commandLineAppConfig defaults =
        extendedCommandLineConfig (appOpts appDefaults ++ optDescrs defaults)
                                  mappend defaults
      where
        appDefaults = fromMaybe mempty $ getOther defaults