module Servant.JS.Fiat
  ( JS ) where

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text            as Text
import qualified Data.Text.Encoding   as Text
import           Data.Typeable
import qualified Network.HTTP.Media   as M
import           Servant.API

-- | Give me some text, and we'll pretend it's javascript.
--   I used this to render the routes as endpoint that's always up to date
data JS deriving Typeable
instance Accept JS where
    contentTypes :: Proxy JS -> NonEmpty MediaType
contentTypes Proxy JS
_ = MediaType -> NonEmpty MediaType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MediaType -> NonEmpty MediaType)
-> MediaType -> NonEmpty MediaType
forall a b. (a -> b) -> a -> b
$ ByteString
"application" ByteString -> ByteString -> MediaType
M.// ByteString
"javascript"

instance MimeRender JS LBS.ByteString where
    mimeRender :: Proxy JS -> ByteString -> ByteString
mimeRender Proxy JS
_ = ByteString -> ByteString
forall a. a -> a
id
instance MimeRender JS BS.ByteString where
    mimeRender :: Proxy JS -> ByteString -> ByteString
mimeRender Proxy JS
p = Proxy JS -> ByteString -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy JS
p (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict
instance MimeRender JS Text.Text where
    mimeRender :: Proxy JS -> Text -> ByteString
mimeRender Proxy JS
p = Proxy JS -> ByteString -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy JS
p (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8