{-# LANGUAGE BlockArguments    #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Handlers (
                -- , submitImpl
                 statusImpl
                -- , relintImpl
                , stateImpl
                , AdminOverview(..)
                , MapService(..),relintImpl,realtimeImpl) where

import           Universum              hiding (view)

import           CheckDir               (DirResult (dirresultMaps))
import           CheckMap               (MapResult (..))
import           Control.Concurrent.STM (TQueue, dupTChan, readTChan,
                                         writeTQueue)
import           Data.Aeson             (ToJSON (..), (.=))
import qualified Data.Aeson             as A
import qualified Data.Aeson.Key         as A
import           Data.Coerce            (coerce)
import qualified Data.Map               as M
import           Lens.Micro.Platform    (view)
import           Network.WebSockets     (PendingConnection, acceptRequest,
                                         rejectRequest, sendTextData,
                                         withPingThread)
import           Servant                (Handler, err404, throwError)
import           Server                 (JobStatus (..), Org (orgUrl),
                                         RemoteRef (reponame), ServerState,
                                         Sha1, adjustedWebPath, getJobStatus,
                                         unState)
import           Worker                 (Job (Job))


-- | an info type wrapped around the server state, to carry serialisation instances.
newtype AdminOverview =
  AdminOverview { unAdminOverview :: ServerState }

newtype MapService =
  MapService { unMapService :: ServerState }

instance ToJSON MapService where
  toJSON (MapService state) =
    toJSON . map orgObject $ view unState state
     where
      orgObject (org, statuses) =
        A.object
        . mapMaybe worldObject
        $ M.elems statuses
       where
        worldObject (remote,  _current, result) = case result of
          Just (Linted res rev _) ->
            Just (A.fromText (reponame remote) .=
                    M.mapWithKey (mapInfo rev) (dirresultMaps res))
          _ -> Nothing
        mapInfo rev mappath MapResult { .. } = A.object
                [ "badges" .= mapresultBadges
                -- TODO: type-safe url library for adding the slash?
                , "jitsi" .= mapresultJitsis
                , "url" .= (orgUrl org <> adjustedWebPath rev org <> "/" <> toText mappath) ]



statusImpl :: MVar ServerState -> Text -> Sha1 -> Handler (Org True, RemoteRef, JobStatus, Maybe JobStatus)
statusImpl state orgslug sha1 = do
   status <- liftIO $ getJobStatus state orgslug sha1
   case status of
     Just stuff -> pure stuff
     Nothing    -> throwError err404

-- | since there are multiple apis that just get state information …
stateImpl
  :: forall s
  .  Coercible s ServerState
  => MVar ServerState
  -> Handler s
stateImpl state = readMVar state <&> coerce

relintImpl :: TQueue Job -> MVar ServerState -> Text -> Sha1 -> Handler Text
relintImpl queue state orgslug sha1 =
  liftIO $ getJobStatus state orgslug sha1 >>= \case
    Nothing -> pure "there isn't a job here to restart"
    Just (org, ref, _oldjob, _veryoldjob) -> do
      atomically $ writeTQueue queue (Job ref org)
      pure "hello"


realtimeImpl :: MVar ServerState -> Text -> Sha1 -> PendingConnection -> Handler ()
realtimeImpl state orgslug sha1 pending =
  liftIO (getJobStatus state orgslug sha1) >>= \case
    Just (_org, _ref, Linted _ _ (_, realtime), _) -> do
      conn <- liftIO $ acceptRequest pending
      incoming <- atomically $ dupTChan realtime
      liftIO $ withPingThread conn 30 pass $ forever $ do
        next <- atomically $ readTChan incoming
        sendTextData conn (A.encode next)
    _ -> liftIO $ rejectRequest pending "no!"