{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveGeneric #-}
module JSON(getJSON, okJSON, errJSON) where

import Happstack.Lite
import Happstack.Server.Types (unBody, takeRequestBody)
import Happstack.Server (askRq, resp)

import Data.Aeson
import Data.Text (Text)
import GHC.Generics
import Data.ByteString.Lazy (ByteString)

import Control.Monad.IO.Class (liftIO)

getBody :: ServerPart ByteString
getBody = do
    req  <- askRq
    body <- liftIO $ takeRequestBody req
    case body of
        Just rqbody -> return . unBody $ rqbody
        Nothing     -> return ""

getJSON :: FromJSON x => ServerPart (Maybe x)
getJSON = decode <$> getBody

okJSON :: ToJSON x => x -> ServerPart Response
okJSON x = do
    setHeaderM "Content-Type" "application/json"
    ok $ toResponse $ encode x

data WDError' = WDError' {
    value :: WDError
  } deriving Generic
instance ToJSON WDError'
data WDError = WDError {
    error :: Text,
    message :: String,
    stacktrace :: Text -- Noop
  } deriving Generic
instance ToJSON WDError

errJSON :: Int -> Text -> String -> ServerPart Response
errJSON code name message = do
    setHeaderM "Content-Type" "application/json"
    resp code $ toResponse $ encode $ WDError' $ WDError name message ""