44
backend/src/Servant/XML.hs
Normal file
44
backend/src/Servant/XML.hs
Normal file
@ -0,0 +1,44 @@
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language FlexibleInstances #-}
|
||||
{-# Language MultiParamTypeClasses #-}
|
||||
{-# Language TypeApplications #-}
|
||||
module Servant.XML
|
||||
( ToNode(..)
|
||||
, XML
|
||||
, OPDS
|
||||
, Text.Hamlet.XML.xml
|
||||
, iso8601 )
|
||||
where
|
||||
|
||||
import Text.XML
|
||||
import ClassyPrelude
|
||||
import Text.Hamlet.XML
|
||||
import Servant
|
||||
import Network.HTTP.Media.MediaType
|
||||
|
||||
data XML
|
||||
|
||||
data OPDS
|
||||
|
||||
instance (ToNode a) => MimeRender XML a where
|
||||
mimeRender _ a =
|
||||
let [NodeElement root] = toNode a
|
||||
in renderLBS def (Document (Prologue [] Nothing []) root [])
|
||||
|
||||
instance (ToNode a) => MimeRender OPDS a where
|
||||
mimeRender _ a = mimeRender (Proxy @XML) a
|
||||
|
||||
instance Accept XML where
|
||||
contentType _ = "application" // "xml" /: ("charset", "utf-8")
|
||||
|
||||
instance Accept OPDS where
|
||||
contentType _ = "application" // "atom+xml" /: ("charset", "utf-8") /: ("profile", "opds-catalog")
|
||||
|
||||
iso8601 :: UTCTime -> Text
|
||||
iso8601 = pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"
|
||||
|
||||
class ToNode a where
|
||||
toNode :: a -> [Node]
|
||||
|
||||
instance (ToNode a) => ToNode [a] where
|
||||
toNode = concatMap toNode
|
Reference in New Issue
Block a user