{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

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

import           Universum

import           Control.Concurrent.MVar (withMVar)
import           Data.Aeson              (ToJSON (..), (.=))
import qualified Data.Aeson              as A
import qualified Data.Map                as M
import           Servant                 (Handler, err404, throwError)
import           Server                  (JobStatus (..), ServerState, Sha1,
                                          getJobStatus, unState)

-- | annoying (and afaik unused), but has to be here for type system reasons
-- instance MonadFail Handler where
--   fail _ = throwError err500

-- -- | someone submitted a map; lint it (synchronously for now)
-- submitImpl :: Config True -> MVar ServerState -> RemoteRef -> App UUID
-- submitImpl config state ref = do
--   jobid <- liftIO UUID.nextRandom
--   -- TODO: these two should really be atomic
--   liftIO $ setJobStatus state ref Pending
--   liftIO $ setRegistry state jobid ref
--   cliconfig <- getCliConfig
--   -- we'll just forget the thread id for now and trust this terminates …
--   _ <- checkRef config cliconfig state ref
--   -- the submission itself can't really fail or return anything useful
--   pure jobid

-- relintImpl :: Config True -> MVar ServerState -> UUID -> App NoContent
-- relintImpl config state uuid = do
--   mref <- liftIO $ withMVar state (pure . M.lookup uuid . view registry)
--   case mref of
--     Nothing -> lift $ throwError err404
--     Just ref -> do
--       cliconfig <- getCliConfig
--       _ <- checkRef config cliconfig state ref
--       pure NoContent

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

newtype MapService =
  MapService { unMapService :: ServerState }

instance ToJSON AdminOverview where
  toJSON (AdminOverview state) =
    toJSON $ view unState state <&> \org -> flip map org $ \(ref, status) ->
      A.object [ "remote" .= ref
               , "status" .= status
               ]

statusImpl :: MVar ServerState -> Text -> Sha1 -> Handler JobStatus
statusImpl state orgslug sha1 = do
   status <- liftIO $ getJobStatus state orgslug sha1
   case status of
     Just res -> pure $ snd res
     Nothing  -> throwError err404


adminOverviewImpl :: MVar ServerState -> Handler AdminOverview
adminOverviewImpl state = do
  state <- readMVar state
  pure (AdminOverview state)