{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Yam.Servant where

import           Yam.App
import           Yam.Job
import           Yam.Logger.WaiLogger

import           Control.Exception                 (SomeException, catch)
import           Control.Lens                      hiding (Context)
import           Data.Aeson
import           Data.Default
import           Data.Swagger                      hiding
    ( Header
    , HeaderName
    , port
    )
import           Network.Wai
import           Network.Wai.Handler.Warp
import           Network.Wai.Middleware.AddHeaders (addHeaders)
import           Servant
import           Servant.Swagger
import           Servant.Swagger.UI
import           Servant.Utils.Enter

type App = AppM Handler

exceptionHandler ::(MonadIO m) => (Text -> m ())
                               -> (m ResponseReceived -> IO ResponseReceived)
                               -> SomeException
                               -> Application
exceptionHandler = undefined

-- add Correlation-Id and exception convert
middleWare :: YamContext -> Middleware
middleWare context app req resH = do
  reqId   <- randomHex 8
  let go a = addHeaders [("X-Correlation-Id",cs reqId)] a req resH
      run  = runAppM context
  run $ withLoggerName (reqId <> " corn")
      $ liftIO
      $ go app `catch` (go . exceptionHandler errorLn run)

type API api = (Proxy api, YamContext -> Server api)
type MkApplication = YamContext -> Application
type ApiToApplication = forall s. (HasServer s '[YamContext], HasSwagger s) => API s -> MkApplication
type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"

emptyApi :: API EmptyAPI
emptyApi = (Proxy, undefined)

emptyApplication :: MkApplication
emptyApplication = mkServe emptyApi

mkServe :: (HasServer api '[YamContext], HasSwagger api) => API api -> YamContext -> Application
mkServe ps c req resH = do
  enabled   <- evalPropOrDefault True     c "swagger.enable"
  swaggertp <- evalPropOrDefault Jensoleg c "swagger.type"
  if enabled
    then go (swagger swaggertp ps) c req resH
    else go ps                     c req resH
  where go :: (HasServer api '[YamContext]) => API api -> YamContext -> Application
        go (p,s)    c = serveWithContext p (c :. EmptyContext) $ s c

toAPI :: (Enter (ServerT api App) App Handler (Server api)) => ServerT api App -> API api
toAPI api = let s c = runReaderTNat c :: ReaderT YamContext Handler :~> Handler
            in (Proxy :: Proxy api, \c -> enter (s c) api)

addApi :: (HasServer api '[YamContext], HasSwagger api, HasServer new '[YamContext], HasSwagger new)
       => API api -> Bool -> API new -> ApiToApplication -> MkApplication
addApi a ok b f c | ok = f (a `ap` b) c
                  | otherwise = f a c
                  where ap :: API a -> API b -> API (a :<|> b)
                        ap (_,a) (_,b) = (Proxy, \c -> a c:<|>b c)

data SwaggerServiceType = Default | Jensoleg

instance FromJSON SwaggerServiceType where
  parseJSON v = go <$> parseJSON v
    where go :: Text -> SwaggerServiceType
          go "default" = Default
          go _         = Jensoleg

swagger :: (HasServer api '[YamContext], HasSwagger api) => SwaggerServiceType -> API api -> API (SwaggerAPI :<|> api)
swagger tp (proxy, api) = (Proxy, \c -> go tp (swaggerDocument proxy) :<|> api c)
  where go Jensoleg = jensolegSwaggerSchemaUIServer
        go _        = swaggerSchemaUIServer

swaggerDocument :: HasSwagger api => Proxy api -> Swagger
swaggerDocument proxy = toSwagger proxy
                & info.title       .~ "Yam Servant API"
                & info.version     .~ "2018.1"
                & info.contact     ?~ Contact (Just "Daniel YU") Nothing (Just "i@icymint.me")
                & info.description ?~ "This is an API for Corn Project"

applicationInfo :: HasServer api '[YamContext] => Proxy api -> YamContext -> Text
applicationInfo proxy = layoutWithContext proxy . (:. EmptyContext)

data Config = Config
  { port :: Int
  , mode :: RunMode
  } deriving Show

instance FromJSON Config where
  parseJSON v = runProp v $ do
      scPort   <- getPropOrDefault (port def) "port"
      scMode   <- getPropOrDefault (mode def) "mode"
      return $ Config scPort scMode

instance Default Config where
  def = Config 8888 Development

startMain :: (YamContext -> IO YamContext)
          -> [DataSourceProvider (AppM IO) ()]
          -> AppM IO ()
          -> [YamJob]
          -> (YamContext -> Application)
          -> IO ()
startMain initialize providers migrateSql jobs application = do
  context <- defaultContext >>= initialize
  runAppM context $ do
    mds  <- getProp "datasource"
    ds2nd<- getProp "datasource.secondary"
    conf <- getPropOrDefault def ""
    initDB providers mds ds2nd $ do
      mapM_ registerJob jobs
      lockExtenstion
      context <- ask
      logger  <- toWaiLogger
      let pt       = port (conf :: Config)
          settings = setPort pt
                   $ setLogger logger defaultSettings
      liftIO  $ runSettings settings
              $ middleWare  context
              $ application context
  where initDB :: [DataSourceProvider (AppM IO) ()] -> Maybe DataSource -> Maybe DataSource -> AppM IO () -> AppM IO ()
        initDB _ Nothing  _   action = action
        initDB p (Just v) ds2 action = initDataSource p v ds2 action