{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

-- |
-- Module    : Servant.XML
-- Copyright : (c) Colin Woodbury, 2018 - 2022
-- License   : BSD3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Servant support for XML.
--
-- Types with a `ToXml` instance will be automatically marshalled into XML and
-- successfully returned by Servant endpoints. Types with a `FromXml` instance
-- can be decoded from request bodies.
--
-- In implementing these typeclass instances, you can use the primitives found
-- in the /xmlbf/ library.

module Servant.XML where

import           Data.ByteString.Builder (toLazyByteString)
import           Data.ByteString.Lazy (toStrict)
import qualified Network.HTTP.Media as M
import           Servant.API
import           Xmlbf (FromXml(..), ToXml(..), encode, parse)
import           Xmlbf.Xeno (fromRawXml)

---

-- | The /application\/xml/ Content-Type. To be used in Servant endpoints like:
--
-- @
-- data Foo = ...
--
-- instance ToXml Foo where
--   toXml foo = ...
--
-- type API = ...
--   :\<|\> "foo" :> Get '[XML] Foo
--   :\<|\> "foo" :> "update" :> ReqBody '[XML] Foo :> PostAccepted '[JSON] ()
-- @
data XML

instance Accept XML where
  contentType :: Proxy XML -> MediaType
contentType Proxy XML
_ = ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"xml" MediaType -> (ByteString, ByteString) -> MediaType
M./: (ByteString
"charset", ByteString
"utf-8")

instance ToXml a => MimeRender XML a where
  mimeRender :: Proxy XML -> a -> ByteString
mimeRender Proxy XML
_ = Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> Builder
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToXml a => a -> [Node]
toXml

instance FromXml a => MimeUnrender XML a where
  mimeUnrender :: Proxy XML -> ByteString -> Either String a
mimeUnrender Proxy XML
_ ByteString
bs = ByteString -> Either String [Node]
fromRawXml (ByteString -> ByteString
toStrict ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Parser a -> [Node] -> Either String a
parse forall a (m :: * -> *). (FromXml a, Monad m) => ParserT m a
fromXml