{-# LANGUAGE ScopedTypeVariables #-}
module Network.PGI
  (
    serve
  , Route
  , Handler
  ) where

import Prelude hiding (catch)

import TNET

import Control.Applicative ((<$>))
import Control.Exception (catch, SomeException)
import Control.Monad (forever)
import Data.Attoparsec.Enumerator
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Enumerator (($$), run)
import Data.Enumerator.Binary (enumHandle)
import Data.Maybe (isJust)
import System.Exit
import System.IO

data PGIRequest = PGIRequest {
  pRequest   :: Maybe TValue,
  pRequestID :: Maybe String,
  pCommand   :: Maybe String,
  pRoute     :: Maybe String
  }
  deriving (Eq, Show)

instance TNET PGIRequest where
  toTNET _ = undefined
  fromTNET tval = let
    request   = tval .: "request"
    requestID = B8.unpack <$> tval .: "request_id"
    command   = B8.unpack <$> tval .: "command"
    route     = tval .: "route"
    in Just $ PGIRequest request requestID command route

type Route = String
type Handler = TValue -> IO TValue

serve :: [(Route, Handler)] -> IO ()
serve handlers = do
  hSetBuffering stdin NoBuffering
  serveLoop handlers

serveLoop :: [(Route, Handler)] -> IO ()
serveLoop handlers = forever $ do
  raw_request <- run (enumHandle 1 stdin $$ iterParser tnetParser)
  case raw_request of
    Left e -> exitSuccess
    Right raw -> do let request = fromTNET raw :: Maybe PGIRequest
                    case request of
                      Nothing -> errorTNET "Could not parse request"
                      Just req  ->
                        case pCommand req of
                          Just command -> handleCommand command
                          Nothing      -> if validRequest req
                                          then handleRequest handlers req
                                          else errorTNET "Invalid Request"

handleCommand :: String -> IO ()
handleCommand "init" = outputTNET okResponse
  where okResponse = dict [ "result" .= "ok" ]
handleCommand c      = errorTNET $ "Unsupported command: " ++ c

outputTNET :: TValue -> IO ()
outputTNET t = B.putStr (encode t) >> hFlush stdout

errorTNET :: String -> IO ()
errorTNET e = outputTNET errorMsg
  where errorMsg = dict ["dev_error" .= dict [ "message" .= e, "trace" .= "" ]]

validRequest :: PGIRequest -> Bool
validRequest req = and requiredFields
  where requiredFields = [isJust $ pRequest req, isJust $ pRoute req]

handleRequest :: [(Route, Handler)] -> PGIRequest -> IO ()
handleRequest handlers request =
  case lookup route handlers of
    Nothing -> errorTNET $ "Route not found: " ++ route
    Just handler ->
      catch (handler appRequest >>= outputTNETResponse)
            (\(e :: SomeException) -> errorTNET $ show e)
  where
    Just route = pRoute request
    Just appRequest = pRequest request

    outputTNETResponse r = outputTNET $
      dict [ "response" .= r ]