{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Some next-gen helper functions for the scaffolding's configuration system.
module Yesod.Default.Config2
    ( -- * Locally defined
      configSettingsYml
    , getDevSettings
    , develMainHelper
    , makeYesodLogger
      -- * Re-exports from Data.Yaml.Config
    , applyCurrentEnv
    , getCurrentEnv
    , applyEnvValue
    , loadYamlSettings
    , loadYamlSettingsArgs
    , EnvUsage
    , ignoreEnv
    , useEnv
    , requireEnv
    , useCustomEnv
    , requireCustomEnv
      -- * For backwards compatibility
    , MergedValue (..)
    , loadAppSettings
    , loadAppSettingsArgs
    ) where


import Data.Yaml.Config

import Data.Semigroup
import Data.Aeson
import System.Environment (getEnvironment)
import Network.Wai (Application)
import Network.Wai.Handler.Warp
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Control.Concurrent (forkIO, threadDelay)
import System.Exit (exitSuccess)
import System.Directory (doesFileExist)
import Network.Wai.Logger (clockDateCacher)
import Yesod.Core.Types (Logger (Logger))
import System.Log.FastLogger (LoggerSet)

#if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.KeyMap as H
#else
import qualified Data.HashMap.Strict as H
#endif

#ifndef mingw32_HOST_OS
import System.Posix.Signals (installHandler, sigINT, Handler(Catch))
#endif

newtype MergedValue = MergedValue { MergedValue -> Value
getMergedValue :: Value }

instance Semigroup MergedValue where
    MergedValue Value
x <> :: MergedValue -> MergedValue -> MergedValue
<> MergedValue Value
y = Value -> MergedValue
MergedValue forall a b. (a -> b) -> a -> b
$ Value -> Value -> Value
mergeValues Value
x Value
y

-- | Left biased
mergeValues :: Value -> Value -> Value
mergeValues :: Value -> Value -> Value
mergeValues (Object Object
x) (Object Object
y) = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
H.unionWith Value -> Value -> Value
mergeValues Object
x Object
y
mergeValues Value
x Value
_ = Value
x

-- | Load the settings from the following three sources:
--
-- * Run time config files
--
-- * Run time environment variables
--
-- * The default compile time config file
loadAppSettings
    :: FromJSON settings
    => [FilePath] -- ^ run time config files to use, earlier files have precedence
    -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
    -> EnvUsage
    -> IO settings
loadAppSettings :: forall settings.
FromJSON settings =>
[[Char]] -> [Value] -> EnvUsage -> IO settings
loadAppSettings = forall settings.
FromJSON settings =>
[[Char]] -> [Value] -> EnvUsage -> IO settings
loadYamlSettings
{-# DEPRECATED loadAppSettings "Use loadYamlSettings" #-}

-- | Same as @loadAppSettings@, but get the list of runtime config files from
-- the command line arguments.
loadAppSettingsArgs
    :: FromJSON settings
    => [Value] -- ^ any other values to use, usually from compile time config. overridden by files
    -> EnvUsage -- ^ use environment variables
    -> IO settings
loadAppSettingsArgs :: forall settings.
FromJSON settings =>
[Value] -> EnvUsage -> IO settings
loadAppSettingsArgs = forall settings.
FromJSON settings =>
[Value] -> EnvUsage -> IO settings
loadYamlSettingsArgs
{-# DEPRECATED loadAppSettingsArgs "Use loadYamlSettingsArgs" #-}

-- | Location of the default config file.
configSettingsYml :: FilePath
configSettingsYml :: [Char]
configSettingsYml = [Char]
"config/settings.yml"

-- | Helper for getApplicationDev in the scaffolding. Looks up PORT and
-- DISPLAY_PORT and prints appropriate messages.
getDevSettings :: Settings -> IO Settings
getDevSettings :: Settings -> IO Settings
getDevSettings Settings
settings = do
    [([Char], [Char])]
env <- IO [([Char], [Char])]
getEnvironment
    let p :: Port
p = forall a. a -> Maybe a -> a
fromMaybe (Settings -> Port
getPort Settings
settings) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"PORT" [([Char], [Char])]
env forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMaybe
        pdisplay :: Port
pdisplay = forall a. a -> Maybe a -> a
fromMaybe Port
p forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"DISPLAY_PORT" [([Char], [Char])]
env forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => [Char] -> Maybe a
readMaybe
    [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Devel application launched: http://localhost:" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Port
pdisplay
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Port -> Settings -> Settings
setPort Port
p Settings
settings

-- | Helper for develMain in the scaffolding.
develMainHelper :: IO (Settings, Application) -> IO ()
develMainHelper :: IO (Settings, Application) -> IO ()
develMainHelper IO (Settings, Application)
getSettingsApp = do
#ifndef mingw32_HOST_OS
    Handler
_ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigINT (IO () -> Handler
Catch forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall a. Maybe a
Nothing
#endif

    [Char] -> IO ()
putStrLn [Char]
"Starting devel application"
    (Settings
settings, Application
app) <- IO (Settings, Application)
getSettingsApp
    ThreadId
_ <- IO () -> IO ThreadId
forkIO forall a b. (a -> b) -> a -> b
$ Settings -> Application -> IO ()
runSettings Settings
settings Application
app
    IO ()
loop
  where
    loop :: IO ()
    loop :: IO ()
loop = do
        Port -> IO ()
threadDelay Port
100000
        Bool
e <- [Char] -> IO Bool
doesFileExist [Char]
"yesod-devel/devel-terminate"
        if Bool
e then IO ()
terminateDevel else IO ()
loop

    terminateDevel :: IO ()
    terminateDevel :: IO ()
terminateDevel = forall a. IO a
exitSuccess

-- | Create a 'Logger' value (from yesod-core) out of a 'LoggerSet' (from
-- fast-logger).
makeYesodLogger :: LoggerSet -> IO Logger
makeYesodLogger :: LoggerSet -> IO Logger
makeYesodLogger LoggerSet
loggerSet' = do
    (DateCacheGetter
getter, IO ()
_) <- IO (DateCacheGetter, IO ())
clockDateCacher
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! LoggerSet -> DateCacheGetter -> Logger
Yesod.Core.Types.Logger LoggerSet
loggerSet' DateCacheGetter
getter