  To work around a bug in GHC 8.0.1 :
-- See /#!topic/yesodweb/DlyXqFM7ZnY
# LANGUAGE NoDisambiguateRecordFields #
{-# LANGUAGE PackageImports #-}
# OPTIONS_GHC -fno - warn - orphans #
-- We disable the orphan instance warning because mkYesodDispatch defines an
-- orphan instance for the App type.
module Application
    ( getApplicationDev
    , appMain
    , develMain
    , makeFoundation
    -- * for DevelMain
    , getApplicationRepl
    , shutdownApp
    -- * for GHCI
    , handler
    ) where

import Import
import "monad-logger" Control.Monad.Logger (liftLoc)
import Language.Haskell.TH.Syntax (qLocation)
import Control.Concurrent (forkIO, threadDelay)
import Control.Parallel.Strategies (withStrategy)
import Network.Wai.Handler.Warp
  (Settings, defaultSettings, defaultShouldDisplayException, runSettings,
  setHost, setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger
  (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination,
  mkRequestLogger, outputFormat)
import System.Log.FastLogger
  (defaultBufSize, newStdoutLoggerSet, toLogStr)
import qualified Yesod.Core.Unsafe as Unsafe

-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Handler.Common
import Handler.Database
import Handler.Packages
import Handler.Search
import Handler.PackageBadges
import Handler.Help
import SearchIndex (emptySearchIndex, createSearchIndex, evalSearchIndex)

  This line actually creates our YesodDispatch instance . It is the second half
  of the call to mkYesodData which occurs in Foundation.hs . Please see the
-- comments there for more details.
mkYesodDispatch "App" resourcesApp

-- | This function allocates resources (such as a database connection pool),
-- performs initialization and return a foundation datatype value. This is also
-- the place to put your migrate statements to have automatic database
  migrations handled by Yesod .
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
    let mode = if isDevelopment then "development" else "production"
        appStatic = eStatic
    putStrLn $ "Starting in " <> mode <> " mode"
    appHttpManager <- newManager
    appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
    appSearchIndex <- newTVarIO emptySearchIndex
    let foundation = App{..}
    void (startRegenThread foundation)
    return foundation

    where
    every interval action =
        forkIO (forever (action >> threadDelay interval))

    startRegenThread foundation =
       let hour = 60 * 60 * 1000 * 1000 -- microseconds
       in every hour $ do
           let emptySessionMap = mempty :: SessionMap
           pkgs <- Unsafe.runFakeHandler
                      emptySessionMap
                      appLogger
                      foundation
                      getAllPackages

           traverse ( atomically
                    . writeTVar (appSearchIndex foundation)
                    . withStrategy evalSearchIndex
                    . createSearchIndex
                    ) pkgs

  | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
-- applyng some additional middlewares.
makeApplication :: App -> IO Application
makeApplication foundation = do
    logWare <- mkRequestLogger def
        { outputFormat =
            if appDetailedRequestLogging $ appSettings foundation
                then Detailed True
                else Apache
                        (if appIpFromHeader $ appSettings foundation
                            then FromFallback
                            else FromSocket)
        , destination = Logger $ loggerSet $ appLogger foundation
        }

    -- Create the WAI application and apply middlewares
    appPlain <- toWaiAppPlain foundation
    return $ logWare $ defaultMiddlewaresNoLogging appPlain

-- | Warp settings for the given foundation value.
warpSettings :: App -> Settings
warpSettings foundation =
      setPort (appPort $ appSettings foundation)
    $ setHost (appHost $ appSettings foundation)
    $ setOnException (\_req e ->
        when (defaultShouldDisplayException e) $ messageLoggerSource
            foundation
            (appLogger foundation)
            $(qLocation >>= liftLoc)
            "yesod"
            LevelError
            (toLogStr $ "Exception from Warp: " ++ show e))
      defaultSettings

  | For yesod devel , return the Warp settings and WAI Application .
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
    settings <- getAppSettings
    foundation <- makeFoundation settings
    wsettings <- getDevSettings $ warpSettings foundation
    app <- makeApplication foundation
    return (wsettings, app)

  | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev

-- | The @main@ function for an executable running this site.
appMain :: IO ()
appMain = do
    -- Get settings from environment
    settings <- getAppSettings

    -- Generate the foundation from the settings
    foundation <- makeFoundation settings

    -- Generate a WAI Application from the foundation
    app <- makeApplication foundation

    -- Run the application with Warp
    runSettings (warpSettings foundation) app


--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
--------------------------------------------------------------
getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
    settings <- getAppSettings
    foundation <- makeFoundation settings
    wsettings <- getDevSettings $ warpSettings foundation
    app1 <- makeApplication foundation
    return (getPort wsettings, foundation, app1)

shutdownApp :: App -> IO ()
shutdownApp _ = return ()


---------------------------------------------
-- Functions for use in development with GHCi
---------------------------------------------

-- | Run a handler
handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h

 See /#!topic/yesodweb/DlyXqFM7ZnY
# LANGUAGE PackageImports #
 We disable the orphan instance warning because mkYesodDispatch defines an
 orphan instance for the App type.
 * for DevelMain
 * for GHCI
 Import all relevant handler modules here.
 Don't forget to add new modules to your cabal file!
 comments there for more details.
 | This function allocates resources (such as a database connection pool),
 performs initialization and return a foundation datatype value. This is also
 the place to put your migrate statements to have automatic database
 microseconds
 applyng some additional middlewares.
 Create the WAI application and apply middlewares
 | Warp settings for the given foundation value.
 | The @main@ function for an executable running this site.
 Get settings from environment
 Generate the foundation from the settings
 Generate a WAI Application from the foundation
 Run the application with Warp
------------------------------------------------------------
 Functions for DevelMain.hs (a way to run the app from GHCi)
------------------------------------------------------------
-------------------------------------------
 Functions for use in development with GHCi
-------------------------------------------
 | Run a handler
  To work around a bug in GHC 8.0.1 :
# LANGUAGE NoDisambiguateRecordFields #
# OPTIONS_GHC -fno - warn - orphans #
module Application
    ( getApplicationDev
    , appMain
    , develMain
    , makeFoundation
    , getApplicationRepl
    , shutdownApp
    , handler
    ) where

import Import
import "monad-logger" Control.Monad.Logger (liftLoc)
import Language.Haskell.TH.Syntax (qLocation)
import Control.Concurrent (forkIO, threadDelay)
import Control.Parallel.Strategies (withStrategy)
import Network.Wai.Handler.Warp
  (Settings, defaultSettings, defaultShouldDisplayException, runSettings,
  setHost, setOnException, setPort, getPort)
import Network.Wai.Middleware.RequestLogger
  (Destination (Logger), IPAddrSource (..), OutputFormat (..), destination,
  mkRequestLogger, outputFormat)
import System.Log.FastLogger
  (defaultBufSize, newStdoutLoggerSet, toLogStr)
import qualified Yesod.Core.Unsafe as Unsafe

import Handler.Common
import Handler.Database
import Handler.Packages
import Handler.Search
import Handler.PackageBadges
import Handler.Help
import SearchIndex (emptySearchIndex, createSearchIndex, evalSearchIndex)

  This line actually creates our YesodDispatch instance . It is the second half
  of the call to mkYesodData which occurs in Foundation.hs . Please see the
mkYesodDispatch "App" resourcesApp

  migrations handled by Yesod .
makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
    let mode = if isDevelopment then "development" else "production"
        appStatic = eStatic
    putStrLn $ "Starting in " <> mode <> " mode"
    appHttpManager <- newManager
    appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
    appSearchIndex <- newTVarIO emptySearchIndex
    let foundation = App{..}
    void (startRegenThread foundation)
    return foundation

    where
    every interval action =
        forkIO (forever (action >> threadDelay interval))

    startRegenThread foundation =
       in every hour $ do
           let emptySessionMap = mempty :: SessionMap
           pkgs <- Unsafe.runFakeHandler
                      emptySessionMap
                      appLogger
                      foundation
                      getAllPackages

           traverse ( atomically
                    . writeTVar (appSearchIndex foundation)
                    . withStrategy evalSearchIndex
                    . createSearchIndex
                    ) pkgs

  | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
makeApplication :: App -> IO Application
makeApplication foundation = do
    logWare <- mkRequestLogger def
        { outputFormat =
            if appDetailedRequestLogging $ appSettings foundation
                then Detailed True
                else Apache
                        (if appIpFromHeader $ appSettings foundation
                            then FromFallback
                            else FromSocket)
        , destination = Logger $ loggerSet $ appLogger foundation
        }

    appPlain <- toWaiAppPlain foundation
    return $ logWare $ defaultMiddlewaresNoLogging appPlain

warpSettings :: App -> Settings
warpSettings foundation =
      setPort (appPort $ appSettings foundation)
    $ setHost (appHost $ appSettings foundation)
    $ setOnException (\_req e ->
        when (defaultShouldDisplayException e) $ messageLoggerSource
            foundation
            (appLogger foundation)
            $(qLocation >>= liftLoc)
            "yesod"
            LevelError
            (toLogStr $ "Exception from Warp: " ++ show e))
      defaultSettings

  | For yesod devel , return the Warp settings and WAI Application .
getApplicationDev :: IO (Settings, Application)
getApplicationDev = do
    settings <- getAppSettings
    foundation <- makeFoundation settings
    wsettings <- getDevSettings $ warpSettings foundation
    app <- makeApplication foundation
    return (wsettings, app)

  | main function for use by yesod devel
develMain :: IO ()
develMain = develMainHelper getApplicationDev

appMain :: IO ()
appMain = do
    settings <- getAppSettings

    foundation <- makeFoundation settings

    app <- makeApplication foundation

    runSettings (warpSettings foundation) app


getApplicationRepl :: IO (Int, App, Application)
getApplicationRepl = do
    settings <- getAppSettings
    foundation <- makeFoundation settings
    wsettings <- getDevSettings $ warpSettings foundation
    app1 <- makeApplication foundation
    return (getPort wsettings, foundation, app1)

shutdownApp :: App -> IO ()
shutdownApp _ = return ()



handler :: Handler a -> IO a
handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
