    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE OverloadedStrings  #-}
    {-# LANGUAGE TemplateHaskell    #-}
    module Yesod.Default.Main
        ( defaultMain
        , defaultMainLog
        , defaultRunner
        , defaultDevelApp
        , LogFunc
        ) where

    import Yesod.Default.Config
    import Network.Wai (Application)
    import Network.Wai.Handler.Warp
        (runSettings, defaultSettings, setPort, setHost, setOnException)
    import qualified Network.Wai.Handler.Warp as Warp
    import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
    import Network.Wai.Middleware.Gzip (gzip, GzipFiles (GzipCacheFolder), gzipFiles, def)
    import Network.Wai.Middleware.Autohead (autohead)
    import Network.Wai.Middleware.Jsonp (jsonp)
    import Control.Monad (when)
    import System.Environment (getEnvironment)
    import Data.Maybe (fromMaybe)
    import Text.Read (readMaybe)
    import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc)
    import System.Log.FastLogger (LogStr, toLogStr)
    import Language.Haskell.TH.Syntax (qLocation)

    #ifndef WINDOWS
    import qualified System.Posix.Signals as Signal
    import Control.Concurrent (forkIO, killThread)
    import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
    #endif

    -- | Run your app, taking environment and port settings from the
    --   commandline.
    --
    --   @'fromArgs'@ helps parse a custom configuration
    --
    --   > main :: IO ()
    --   > main = defaultMain (fromArgs parseExtra) makeApplication
    --
    defaultMain :: IO (AppConfig env extra)
                -> (AppConfig env extra -> IO Application)
                -> IO ()
    defaultMain :: forall env extra.
    IO (AppConfig env extra)
    -> (AppConfig env extra -> IO Application) -> IO ()
    defaultMain IO (AppConfig env extra)
    load AppConfig env extra -> IO Application
    getApp = do
        AppConfig env extra
    config <- IO (AppConfig env extra)
    load
        Application
    app <- AppConfig env extra -> IO Application
    getApp AppConfig env extra
    config
        Settings -> Application -> IO ()
    runSettings
            ( Port -> Settings -> Settings
    setPort (AppConfig env extra -> Port
    forall environment extra. AppConfig environment extra -> Port
    appPort AppConfig env extra
    config)
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ HostPreference -> Settings -> Settings
    setHost (AppConfig env extra -> HostPreference
    forall environment extra.
    AppConfig environment extra -> HostPreference
    appHost AppConfig env extra
    config)
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ Settings
    defaultSettings
            ) Application
    app

    type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()

    -- | Same as @defaultMain@, but gets a logging function back as well as an
    -- @Application@ to install Warp exception handlers.
    --
    -- Since 1.2.5
    defaultMainLog :: IO (AppConfig env extra)
                   -> (AppConfig env extra -> IO (Application, LogFunc))
                   -> IO ()
    defaultMainLog :: forall env extra.
    IO (AppConfig env extra)
    -> (AppConfig env extra -> IO (Application, LogFunc)) -> IO ()
    defaultMainLog IO (AppConfig env extra)
    load AppConfig env extra -> IO (Application, LogFunc)
    getApp = do
        AppConfig env extra
    config <- IO (AppConfig env extra)
    load
        (Application
    app, LogFunc
    logFunc) <- AppConfig env extra -> IO (Application, LogFunc)
    getApp AppConfig env extra
    config
        Settings -> Application -> IO ()
    runSettings
            ( Port -> Settings -> Settings
    setPort (AppConfig env extra -> Port
    forall environment extra. AppConfig environment extra -> Port
    appPort AppConfig env extra
    config)
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ HostPreference -> Settings -> Settings
    setHost (AppConfig env extra -> HostPreference
    forall environment extra.
    AppConfig environment extra -> HostPreference
    appHost AppConfig env extra
    config)
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ (Maybe Request -> SomeException -> IO ()) -> Settings -> Settings
    setOnException ((SomeException -> IO ()) -> Maybe Request -> SomeException -> IO ()
    forall a b. a -> b -> a
    const ((SomeException -> IO ())
     -> Maybe Request -> SomeException -> IO ())
    -> (SomeException -> IO ())
    -> Maybe Request
    -> SomeException
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \SomeException
    e -> Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SomeException -> Bool
    shouldLog' SomeException
    e) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LogFunc
    logFunc
                $(qLocation >>= liftLoc)
                LogSource
    "yesod"
                LogLevel
    LevelError
                ([Char] -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr ([Char] -> LogStr) -> [Char] -> LogStr
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Exception from Warp: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    e))
            (Settings -> Settings) -> Settings -> Settings
    forall a b. (a -> b) -> a -> b
    $ Settings
    defaultSettings
            ) Application
    app
      where
        shouldLog' :: SomeException -> Bool
    shouldLog' = SomeException -> Bool
    Warp.defaultShouldDisplayException

    -- | Run your application continuously, listening for SIGINT and exiting
    --   when received
    --
    --   > withYourSite :: AppConfig DefaultEnv -> Logger -> (Application -> IO a) -> IO ()
    --   > withYourSite conf logger f = do
    --   >     Settings.withConnectionPool conf $ \p -> do
    --   >         runConnectionPool (runMigration yourMigration) p
    --   >         defaultRunner f $ YourSite conf logger p
    defaultRunner :: (Application -> IO ()) -> Application -> IO ()
    defaultRunner :: (Application -> IO ()) -> Application -> IO ()
    defaultRunner Application -> IO ()
    f Application
    app = do
        -- clear the .static-cache so we don't have stale content
        Bool
    exists <- [Char] -> IO Bool
    doesDirectoryExist [Char]
    staticCache
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    exists (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    removeDirectoryRecursive [Char]
    staticCache
    #ifdef WINDOWS
        f (middlewares app)
    #else
        ThreadId
    tid <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ Application -> IO ()
    f (Application -> Application
    middlewares Application
    app) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        MVar ()
    flag <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
        Handler
    _ <- Signal -> Handler -> Maybe SignalSet -> IO Handler
    Signal.installHandler Signal
    Signal.sigINT (IO () -> Handler
    Signal.CatchOnce (IO () -> Handler) -> IO () -> Handler
    forall a b. (a -> b) -> a -> b
    $ do
            [Char] -> IO ()
    putStrLn [Char]
    "Caught an interrupt"
            ThreadId -> IO ()
    killThread ThreadId
    tid
            MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    flag ()) Maybe SignalSet
    forall a. Maybe a
    Nothing
        MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    flag
    #endif
      where
        middlewares :: Application -> Application
    middlewares = GzipSettings -> Application -> Application
    gzip GzipSettings
    gset (Application -> Application)
    -> (Application -> Application) -> Application -> Application
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Application -> Application
    jsonp (Application -> Application)
    -> (Application -> Application) -> Application -> Application
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Application -> Application
    autohead

        gset :: GzipSettings
    gset = GzipSettings
    forall a. Default a => a
    def { gzipFiles :: GzipFiles
    gzipFiles = [Char] -> GzipFiles
    GzipCacheFolder [Char]
    staticCache }
        staticCache :: [Char]
    staticCache = [Char]
    ".static-cache"

    -- | Run your development app using a custom environment type and loader
    --   function
    defaultDevelApp
        :: IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@
        -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@
        -> IO (Int, Application)
    defaultDevelApp :: forall env extra.
    IO (AppConfig env extra)
    -> (AppConfig env extra -> IO Application)
    -> IO (Port, Application)
    defaultDevelApp IO (AppConfig env extra)
    load AppConfig env extra -> IO Application
    getApp = do
        AppConfig env extra
    conf   <- IO (AppConfig env extra)
    load
        [([Char], [Char])]
    env <- IO [([Char], [Char])]
    getEnvironment
        let p :: Port
    p = Port -> Maybe Port -> Port
    forall a. a -> Maybe a -> a
    fromMaybe (AppConfig env extra -> Port
    forall environment extra. AppConfig environment extra -> Port
    appPort AppConfig env extra
    conf) (Maybe Port -> Port) -> Maybe Port -> Port
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [([Char], [Char])] -> Maybe [Char]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [Char]
    "PORT" [([Char], [Char])]
    env Maybe [Char] -> ([Char] -> Maybe Port) -> Maybe Port
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> Maybe Port
    forall a. Read a => [Char] -> Maybe a
    readMaybe
            pdisplay :: Port
    pdisplay = Port -> Maybe Port -> Port
    forall a. a -> Maybe a -> a
    fromMaybe Port
    p (Maybe Port -> Port) -> Maybe Port -> Port
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [([Char], [Char])] -> Maybe [Char]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [Char]
    "DISPLAY_PORT" [([Char], [Char])]
    env Maybe [Char] -> ([Char] -> Maybe Port) -> Maybe Port
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Char] -> Maybe Port
    forall a. Read a => [Char] -> Maybe a
    readMaybe
        [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Devel application launched: http://localhost:" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Port -> [Char]
    forall a. Show a => a -> [Char]
    show Port
    pdisplay
        Application
    app <- AppConfig env extra -> IO Application
    getApp AppConfig env extra
    conf
        (Port, Application) -> IO (Port, Application)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Port
    p, Application
    app)