{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}


-- | simple server offering linting "as a service"
module Main where

import           Universum

import           Cli.Extras                           (CliConfig,
                                                       mkDefaultCliConfig,
                                                       runCli)
import qualified Data.ByteString.Lazy.Char8           as C8
import           Data.UUID                            (UUID)
import           Handlers                             (App, adminOverviewImpl,
                                                        statusImpl,
                                                       )
import           HtmlOrphans                          ()
import           Network.Wai.Handler.Warp             (defaultSettings,
                                                       runSettings, setPort)
import           Network.Wai.Middleware.Gzip          (def)
import           Network.Wai.Middleware.RequestLogger (OutputFormat (..),
                                                       RequestLoggerSettings (..),
                                                       mkRequestLogger)
import           Servant                              (Application, Capture,
                                                       Get, Handler,
                                                       HasServer (ServerT),
                                                       JSON, NoContent, Post,
                                                       Raw, ReqBody,
                                                       ServerError (errBody),
                                                       err500, hoistServer,
                                                       serve, throwError,
                                                       type (:<|>) (..),
                                                       type (:>))
import           Servant.HTML.Lucid                   (HTML)
import           Servant.Server.StaticFiles           (serveDirectoryWebApp)
import           Server                               (AdminOverview,
                                                       Config (..), JobStatus,
                                                       RemoteRef (..),
                                                       ServerState,
                                                       defaultState, loadConfig, verbose, port, orgs, Org (orgEntrypoint, orgRepos))


-- | Main API type
type API format =
       -- "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] UUID
       "status" :> Capture "jobid" UUID :> Get '[format] JobStatus
  -- :<|> "relint" :> Capture "jobid" UUID :> Get '[format] NoContent
  :<|> "admin" :> "overview" :> Get '[format] AdminOverview

type Routes =
   "api" :> API JSON
  :<|> "status" :> Capture "jobid" UUID :> Get '[HTML] JobStatus
  :<|> "admin" :> "overview" :> Get '[HTML] AdminOverview
  :<|> Raw

-- | API's implementation
jsonAPI :: Config True -> MVar ServerState -> ServerT (API JSON) App
jsonAPI config state =
  -- submitImpl config state
       statusImpl state
  -- :<|> relintImpl config state
  :<|> adminOverviewImpl state

server :: Config True -> MVar ServerState -> ServerT Routes App
server config state =
  jsonAPI config state
  :<|> statusImpl state
  :<|> adminOverviewImpl state
  :<|> serveDirectoryWebApp "./static"

-- | make an application; convert any cli errors into a 500
app :: CliConfig -> Config True -> MVar ServerState -> Application
app cliconfig config =
  serve api . hoistServer api conv . server config
  where api = Proxy @Routes
        conv :: App a -> Handler a
        conv m = do
          res <- runCli cliconfig m
          case res of
            Right a  -> pure a
            Left err -> throwError (err500 { errBody = C8.pack (show err) })


main :: IO ()
main = do
  config <- loadConfig "./config.toml"
  state <- newMVar defaultState
  -- TODO: i really don't like all this cli logging stuff, replace it with
  -- fast-logger at some point …
  cliconfig <- liftIO $ mkDefaultCliConfig ["-v" | view verbose config]
  loggerMiddleware <- mkRequestLogger
    $ def { outputFormat = Detailed (view verbose config) }

  -- print (keys $ view orgs config)
  print (map orgEntrypoint $ view orgs config)
  print (map orgRepos $ view orgs config)

  let warpsettings =
       setPort (view port config)
       defaultSettings

  runSettings warpsettings
    . loggerMiddleware
    $ app cliconfig config state