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


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

import           Cli.Extras                 (mkDefaultCliConfig, runCli)
import           Control.Concurrent         (MVar, newMVar)
import           Control.Monad.IO.Class     (liftIO)
import qualified Data.ByteString.Lazy.Char8 as C8
import           Data.UUID                  (UUID)
import           Handlers                   (App, adminOverviewImpl, relintImpl,
                                             statusImpl, submitImpl)
import           HtmlOrphans                ()
import           Network.Wai.Handler.Warp   (run)
import           Servant                    (Application, Capture, Get, Handler,
                                             HasServer (ServerT), JSON,
                                             NoContent, Post, Proxy (Proxy),
                                             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 (..), State,
                                             defaultState, loadConfig)

{-
Needed:
 - admin overview (perhaps on seperate port?)
 - in json:
   - submit a repository link & ref name, get back job id
   - look up a lint status by job id
 - in html
   - look up a lint status, pretty-printed
   - front page with overview & links
   - possibly a "update & relint" button?
   - links to documentation
-}
-- | 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 State -> ServerT (API JSON) App
jsonAPI config state =
  submitImpl config state
  :<|> statusImpl state
  :<|> relintImpl config state
  :<|> adminOverviewImpl state

server :: Config True -> MVar State -> 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 :: Config True -> MVar State -> Application
app config =
  serve api . hoistServer api conv . server config
  where api = Proxy @Routes
        conv :: App a -> Handler a
        conv m = do
          config <- liftIO $ mkDefaultCliConfig ["-v"]
          res <- runCli config 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
  run (port config') (app config' state)