    {-# 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 { AppConfig -> Maybe String
    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 :: AppConfig
    a <> :: AppConfig -> AppConfig -> AppConfig
    <> b :: AppConfig
    b = AppConfig :: Maybe String -> AppConfig
    AppConfig
            { appEnvironment :: Maybe String
    appEnvironment = (AppConfig -> Maybe String)
    -> AppConfig -> AppConfig -> Maybe String
    forall a a. (a -> Maybe a) -> a -> a -> Maybe a
    ov AppConfig -> Maybe String
    appEnvironment AppConfig
    a AppConfig
    b
            }
          where
            ov :: (a -> Maybe a) -> a -> a -> Maybe a
    ov f :: a -> Maybe a
    f x :: a
    x y :: a
    y = Last a -> Maybe a
    forall a. Last a -> Maybe a
    getLast (Last a -> Maybe a) -> Last a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $! (Last a -> Last a -> Last a
    forall a. Semigroup a => a -> a -> a
    (<>) (Last a -> Last a -> Last a) -> (a -> Last a) -> a -> a -> Last a
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Maybe a -> Last a
    forall a. Maybe a -> Last a
    Last (Maybe a -> Last a) -> (a -> Maybe a) -> a -> Last a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Maybe a
    f)) a
    x a
    y

    ------------------------------------------------------------------------------
    instance Monoid AppConfig where
        mempty :: AppConfig
    mempty = Maybe String -> AppConfig
    AppConfig Maybe String
    forall a. Maybe a
    Nothing
    #if !MIN_VERSION_base(4,11,0)
        mappend = (<>)
    #endif

    ------------------------------------------------------------------------------
    -- | Command line options for snaplet applications.
    appOpts :: AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    appOpts :: AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    appOpts defaults :: AppConfig
    defaults = (OptDescr (Maybe AppConfig)
     -> OptDescr (Maybe (Config m AppConfig)))
    -> [OptDescr (Maybe AppConfig)]
    -> [OptDescr (Maybe (Config m AppConfig))]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Maybe AppConfig -> Maybe (Config m AppConfig))
    -> OptDescr (Maybe AppConfig)
    -> OptDescr (Maybe (Config m AppConfig))
    forall a b. (a -> b) -> OptDescr a -> OptDescr b
    fmapOpt ((Maybe AppConfig -> Maybe (Config m AppConfig))
     -> OptDescr (Maybe AppConfig)
     -> OptDescr (Maybe (Config m AppConfig)))
    -> (Maybe AppConfig -> Maybe (Config m AppConfig))
    -> OptDescr (Maybe AppConfig)
    -> OptDescr (Maybe (Config m AppConfig))
    forall a b. (a -> b) -> a -> b
    $ (AppConfig -> Config m AppConfig)
    -> Maybe AppConfig -> Maybe (Config m AppConfig)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((AppConfig -> Config m AppConfig -> Config m AppConfig)
    -> Config m AppConfig -> AppConfig -> Config m AppConfig
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip AppConfig -> Config m AppConfig -> Config m AppConfig
    forall a (m :: * -> *). a -> Config m a -> Config m a
    setOther Config m AppConfig
    forall a. Monoid a => a
    mempty))
        [ String
    -> [String]
    -> ArgDescr (Maybe AppConfig)
    -> String
    -> OptDescr (Maybe AppConfig)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option ['e'] ["environment"]
                 ((String -> Maybe AppConfig) -> String -> ArgDescr (Maybe AppConfig)
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg String -> Maybe AppConfig
    setter "ENVIRONMENT")
                 (String -> OptDescr (Maybe AppConfig))
    -> String -> OptDescr (Maybe AppConfig)
    forall a b. (a -> b) -> a -> b
    $ "runtime environment to use" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (AppConfig -> Maybe String) -> String
    defaultC AppConfig -> Maybe String
    appEnvironment
        ]
      where
        setter :: String -> Maybe AppConfig
    setter s :: String
    s = AppConfig -> Maybe AppConfig
    forall a. a -> Maybe a
    Just (AppConfig -> Maybe AppConfig) -> AppConfig -> Maybe AppConfig
    forall a b. (a -> b) -> a -> b
    $ AppConfig
    forall a. Monoid a => a
    mempty { appEnvironment :: Maybe String
    appEnvironment = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    s}
        defaultC :: (AppConfig -> Maybe String) -> String
    defaultC f :: AppConfig -> Maybe String
    f = String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "" ((", default " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. Show a => a -> String
    show) (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ AppConfig -> Maybe String
    f AppConfig
    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 :: Config m AppConfig -> IO (Config m AppConfig)
    commandLineAppConfig defaults :: Config m AppConfig
    defaults =
        [OptDescr (Maybe (Config m AppConfig))]
    -> (AppConfig -> AppConfig -> AppConfig)
    -> Config m AppConfig
    -> IO (Config m AppConfig)
    forall (m :: * -> *) a.
    MonadSnap m =>
    [OptDescr (Maybe (Config m a))]
    -> (a -> a -> a) -> Config m a -> IO (Config m a)
    extendedCommandLineConfig (AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    forall (m :: * -> *).
    AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    appOpts AppConfig
    appDefaults [OptDescr (Maybe (Config m AppConfig))]
    -> [OptDescr (Maybe (Config m AppConfig))]
    -> [OptDescr (Maybe (Config m AppConfig))]
    forall a. [a] -> [a] -> [a]
    ++ Config m AppConfig -> [OptDescr (Maybe (Config m AppConfig))]
    forall (m :: * -> *) a.
    MonadSnap m =>
    Config m a -> [OptDescr (Maybe (Config m a))]
    optDescrs Config m AppConfig
    defaults)
                                  AppConfig -> AppConfig -> AppConfig
    forall a. Monoid a => a -> a -> a
    mappend Config m AppConfig
    defaults
      where
        appDefaults :: AppConfig
    appDefaults = AppConfig -> Maybe AppConfig -> AppConfig
    forall a. a -> Maybe a -> a
    fromMaybe AppConfig
    forall a. Monoid a => a
    mempty (Maybe AppConfig -> AppConfig) -> Maybe AppConfig -> AppConfig
    forall a b. (a -> b) -> a -> b
    $ Config m AppConfig -> Maybe AppConfig
    forall (m :: * -> *) a. Config m a -> Maybe a
    getOther Config m AppConfig
    defaults