{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Yesod.Json
    ( -- * Convert from a JSON value
      defaultLayoutJson
    , jsonToRepJson
      -- * Convert to a JSON value
    , parseJsonBody
      -- * Produce JSON values
    , J.Value (..)
    , toObject
    , toArray
    ) where

import Yesod.Handler (GHandler, waiRequest)
import Yesod.Content
    ( ToContent (toContent), RepHtmlJson (RepHtmlJson), RepHtml (RepHtml)
    , RepJson (RepJson), Content (ContentBuilder)
    )
import Yesod.Core (defaultLayout, Yesod)
import Yesod.Widget (GWidget)
import qualified Data.Aeson as J
import qualified Data.Aeson.Encode as JE
import Data.Aeson.Encode (fromValue)
import Data.Conduit.Attoparsec (sinkParser)
import Data.Text (Text)
import Control.Monad.Trans.Class (lift)
import Data.HashMap.Strict (fromList)
import qualified Data.Vector as V
import Text.Julius (ToJavascript (..))
import Data.Text.Lazy.Builder (fromLazyText)
import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.Text.Lazy.Builder (toLazyText)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
import Data.Conduit (($$))
import Network.Wai (requestBody)

instance ToContent J.Value where
    toContent = flip ContentBuilder Nothing
              . Blaze.fromLazyText
              . toLazyText
              . fromValue

-- | Provide both an HTML and JSON representation for a piece of data, using
-- the default layout for the HTML output ('defaultLayout').
defaultLayoutJson :: Yesod master
                  => GWidget sub master ()
                  -> J.Value
                  -> GHandler sub master RepHtmlJson
defaultLayoutJson w json = do
    RepHtml html' <- defaultLayout w
    return $ RepHtmlJson html' $ toContent json

-- | Wraps the 'Content' generated by 'jsonToContent' in a 'RepJson'.
jsonToRepJson :: J.Value -> GHandler sub master RepJson
jsonToRepJson = return . RepJson . toContent

-- | Parse the request body as a JSON value.
--
-- /Since: 0.2.3/
parseJsonBody :: GHandler sub master J.Value
parseJsonBody = do
    req <- waiRequest
    lift $ requestBody req $$ sinkParser J.json'

instance ToJavascript J.Value where
    toJavascript = fromLazyText . decodeUtf8 . JE.encode

-- | Convert a list of pairs to an 'J.Object'.
toObject :: [(Text, J.Value)] -> J.Value
toObject = J.Object . fromList

-- | Convert a list of values to an 'J.Array'.
toArray :: [J.Value] -> J.Value
toArray = J.Array . V.fromList