{-# LANGUAGE DataKinds #-}
module Colorless.Endpoint
  ( runColorless
  , runColorlessSingleton
  ) where

import qualified Data.Map as Map
import qualified Data.HashMap.Lazy as HML
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Except
import Control.Concurrent.Async.Lifted ()
import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import Data.Text (Text)
import Data.Map (Map)

import Colorless.Types
import Colorless.Server.Exchange
import Colorless.RuntimeThrower

runColorlessSingleton
  :: MonadIO m
  => Version
  -> (Request -> m (Either Response Response))
  -> Value
  -> m Value
runColorlessSingleton Version{major,minor} handleRequest = runColorless (Map.singleton major (minor, handleRequest))

runColorless
  :: MonadIO m
  => Map Major (Minor, Request -> m (Either Response Response))
  -> Value
  -> m Value
runColorless handleRequestMap v = do
  e <- runExceptT $ do
    colorlessVersion <- getColorlessVersion v
    assertColorlessVersionCompatiability colorlessVersion
    apiVersion <- getApiVersion v
    let apiMajor = major apiVersion
    case Map.lookup apiMajor handleRequestMap of
      Nothing -> case leastAndGreatest (Map.keys handleRequestMap) of
        Nothing -> runtimeThrow RuntimeError'NoImplementation
        Just (minMajor, maxMajor) ->
          if minMajor > apiMajor
            then runtimeThrow RuntimeError'ApiMajorVersionTooLow
            else if maxMajor < apiMajor
              then runtimeThrow RuntimeError'ApiMajorVersionTooHigh
              else runtimeThrow RuntimeError'NoImplementation
      Just (maxMinor, handleRequest) -> if minor apiVersion > maxMinor
        then runtimeThrow RuntimeError'ApiMinorVersionTooHigh
        else case parseRequest v of
          Nothing -> runtimeThrow RuntimeError'UnparsableFormat
          Just req -> toJSON <$> ExceptT (handleRequest req)
  return $ either toJSON id e

leastAndGreatest :: Ord a => [a] -> Maybe (a,a)
leastAndGreatest [] = Nothing
leastAndGreatest xs = Just (minimum xs, maximum xs)

assertColorlessVersionCompatiability :: RuntimeThrower m => Version -> m ()
assertColorlessVersionCompatiability Version{major,minor}
  | major > mustMajor = runtimeThrow RuntimeError'ColorlessMajorVersionTooHigh
  | major < mustMajor = runtimeThrow RuntimeError'ColorlessMajorVersionTooLow
  | minor > maxMinor = runtimeThrow RuntimeError'ColorlessMinorVersionTooHigh
  | otherwise = return ()
  where
    mustMajor = 0
    maxMinor = 0

getApiVersion :: RuntimeThrower m => Value -> m Version
getApiVersion = getVersion "version" RuntimeError'NoApiVersion

getColorlessVersion :: RuntimeThrower m => Value -> m Version
getColorlessVersion = getVersion "colorless" RuntimeError'NoColorlessVersion

getVersion :: RuntimeThrower m => Text -> RuntimeError -> Value -> m Version
getVersion name err (Object o) = case HML.lookup name o of
  Just x -> maybe (runtimeThrow err) return (parseMaybe parseJSON x)
  Nothing -> runtimeThrow err
getVersion _ err _ = runtimeThrow err

parseRequest :: Value -> Maybe Request
parseRequest = parseMaybe parseJSON