{-# LANGUAGE OverloadedStrings #-}
module Main where

-- TODO:
-- We need some logic to compile with different backends. Right now we only
-- support warp. But a (fast) cgi backend would be nice too.

-- TODO:
-- We need some way too configure things, like the port we run on.
-- see Network.Wai.Handler.Warp.Settings and Network.Wai.Handler.Warp.runSettings

import qualified Network.Wai as Wai
import WaiApp
import UnliftIO.Concurrent
import Backend.Backend
import Options.Applicative
import Data.Maybe(fromMaybe)
import Environment
import Colog.Message
import Colog

-- maybe we should use Control.Concurrent.ParallelIO but right
-- now we just rely that the backends fork and don't block
main :: IO ()
main = do
  options <- execParser commandLineParser
  serverState <- newMVar newServerState
  -- to make this more idiomatic we could define al lens. But for one modification?
  let env = defaultEnv {logAction = filterBySeverity (fromMaybe defaultLogLevel (logSeverity options)) msgSeverity (logAction defaultEnv) }
  runEnvM env $ do
    waiApp <-  waiApplication serverState
    let backs = zipWith (runBackend waiApp) (backendOptions options) backends
    waitFor' <- sequence backs
    let waitFor = concat waitFor'
    blockBackends waitFor

defaultLogLevel :: Severity
defaultLogLevel = Info
{-# INLINE defaultLogLevel #-}

blockBackends :: [MVar ()] -> EnvM ()
blockBackends = mapM_ takeMVar

data CommandLineOptions = CommandLineOptions {
  backendOptions :: [Either (Maybe String) Bool],
  logSeverity :: Maybe Severity
  }

backendsParser :: Parser [Either (Maybe String) Bool]
backendsParser = combineParser (fmap backendToParser backends)

severityParser :: Parser (Maybe Severity)
severityParser = optional $ option (auto :: ReadM Severity) (long "logLevel" <> help "Sets the LogLevel" <> metavar "LogLevel")

parser :: Parser CommandLineOptions
parser = CommandLineOptions
  <$> backendsParser
  <*> severityParser


runBackend :: Wai.Application -> Either (Maybe String) Bool -> Backend -> EnvM [MVar ()]
runBackend app (Left (Just conf))  (BackendWithConfig    b _ _) = b app conf
runBackend _   (Left Nothing)      (BackendWithConfig    _ _ _) = return []
runBackend app (Right True)        (BackendWithoutConfig b _ _) = b app
runBackend _   (Right False)       (BackendWithoutConfig _ _ _) = return []
runBackend _   _                   _                            = logError "Backend and parser type don't match! THIS IS A BUG" >> return []

commandLineParser :: ParserInfo CommandLineOptions
commandLineParser = info (parser <**> helper)
  (  fullDesc
  <> progDesc "a small tickLeiste Server to play Splittermond with your crew" )

backendToParser :: Backend -> BackendParserType
backendToParser (BackendWithConfig    _ name desc) = Left  $ optional (strOption (long name <> help desc <> metavar "ConfigFile"))
backendToParser (BackendWithoutConfig _ name desc) = Right $           switch    (long name <> help desc)

type BackendParserType = Either (Parser (Maybe String)) (Parser Bool)

combineParser :: [BackendParserType] -> Parser [Either (Maybe String) Bool]
combineParser = combineApplicativeList . fmap swapFunctorEither

-- TODO swap is a bad name, as the reversal of those operations is unclear
-- at best (and that means impossible, if you want it to do something sensible)
-- TODO this feels like the Left and the Right case could be handled
-- in one case, but I don't know how to write that
-- (except with ||| from the Arrow lib but that feels like a stupid dependency
-- for one line) But Maybe there is a better solution using Arrow altogether
-- (optparse has arrow instances)
swapFunctorEither :: Functor f => Either (f a) (f b) -> f (Either a b)
swapFunctorEither (Left  p) = fmap Left  p
swapFunctorEither (Right p) = fmap Right p

combineApplicativeList :: Applicative f => [f a] -> f [a]
combineApplicativeList = foldr ((<*>) . fmap (:)) (pure [])