content: {-# 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
  