module Hagia where

import ClassyPrelude hiding (onException)

import qualified Database
import qualified Git
import qualified Log
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Middleware.RequestLogger as Wai
import qualified Yesod

import Adminka (adminka)
import Data.Default (def)
import Data.Function ((&))
import Database (runMigrationPool)
import Database.Persist.Sql (runMigration, runSqlPool)
import Database.Persist.Sqlite (withSqlitePool)
import Network.Wai.Handler.Warp (defaultSettings)
import Network.Wai.Middleware.Autohead (autohead)
import Routes (HagiaSite (..))
import Startup (HagiaOperation (Adminka, Server), ServerConfig (..), getConfig, verifyExistingRepos)
import System.OsPath (decodeUtf, osp)
import System.TimeManager (TimeoutThread (..))
import Yesod (Application)
import Yesod.Default.Config2 (develMainHelper, getDevSettings)

-- Closure to create the site instance. Will initialize DB connection
withHagiaSite :: ServerConfig -> (HagiaSite -> IO a) -> IO a
withHagiaSite config action = do
    database' <- pack <$> decodeUtf (database config)
    withSqlitePool database' 5 $ \dbPool -> do
        let ServerConfig{projectsRoot, baseUrl, gitExecutable} = config
        Log.info "Perform initial migrations"
        flip runMigrationPool dbPool $ runMigration Database.migrateAll

        -- Check for inconsistency with db and disk
        runSqlPool (verifyExistingRepos projectsRoot) dbPool >>= \case
            [] -> pure ()
            missing -> error $ "XXX found missing repositories: " <> show missing

        git <- Git.make (2 * 60 * 60) gitExecutable

        action
            HagiaSite
                { projectsRoot
                , dbPool
                , baseUrl
                , git
                }

toWaiApp :: HagiaSite -> IO Application
toWaiApp hagia = do
    -- make middlewares
    shouldLog <- Log.shouldLog Log.levelDebug
    logWare <-
        if shouldLog
            then
                Wai.mkRequestLogger
                    def
                        { Wai.destination = Wai.Handle stderr
                        , Wai.outputFormat = Wai.CustomOutputFormat Log.formatWarpRequest
                        }
            else pure id
    let middlewares = logWare . autohead

    app <- Yesod.toWaiAppPlain hagia
    pure $ middlewares app

runServer :: ServerConfig -> IO ()
runServer config@ServerConfig{host, port} = withHagiaSite config $ \hagiaSite -> do
    app <- toWaiApp hagiaSite
    let onException _req e = case fromException e of
            -- Warp spruiously throws it from time to time, it doesn't matter for operation
            Just TimeoutThread -> Log.debug "[warp] Thread killed by timeout manager"
            Nothing -> Log.error $ "[warp] Exception: " <> tshow e
    let warpSettings =
            Warp.defaultSettings
                & Warp.setPort port
                & Warp.setOnException onException
                & Warp.setHost host
    Log.info "Starting wai app"
    liftIO $ Warp.runSettings warpSettings app

main :: IO ()
main =
    getConfig >>= \case
        Server conf -> runServer conf
        Adminka command -> adminka command

replMain :: IO ()
replMain = runServer develConfig

develConfig :: ServerConfig
develConfig =
    ServerConfig
        { database = [osp|./hagia.sqlite3|]
        , projectsRoot = [osp|/Users/morj/Projects/hagia/test-data/hosted|]
        , host = "localhost"
        , port = 3000
        , baseUrl = "http://localhost:3000"
        , gitExecutable = [osp|git|]
        }

develMain :: IO ()
develMain = withHagiaSite develConfig $ \hagiaSite ->
    liftIO . develMainHelper $
        (,)
            <$> getDevSettings defaultSettings
            <*> toWaiApp hagiaSite