WIP

- Relates to #2

ebook-manager.cabal

@@ -1,6 +1,3 @@
--- Initial ebook-manager.cabal generated by cabal init.  For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
 name:                ebook-manager
 version:             0.1.0.0
 -- synopsis:

src/API/Catalogue.hs

@@ -98,7 +98,10 @@ class Monad m => VersionedCatalog m (v :: Nat) where
   getChannels :: SafeUser -> m (Catalog v)
 
 instance VersionedCatalog AppM 1 where
-  getChannels SafeUser{username} = do
+  getChannels = getChannelsV1
+
+getChannelsV1 :: SafeUser -> AppM (Catalog 1)
+getChannelsV1 SafeUser{username} = do
   updated <- liftIO getCurrentTime
   let self = Rel ("/api/current/" <> selfUrl)
       -- I'm not sure if this safe link approach is really useable with this
@@ -118,8 +121,10 @@ instance VersionedCatalog AppM 1 where
 
 type VersionedAPI (v :: Nat) = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI v
 
-type RootCatalog (v :: Nat) = "catalog" :> Get '[XML] (Catalog v)
-type ChannelCatalog (v :: Nat) = "catalog" :> "channel" :> Capture "channel_id" Channel.ChannelID :> Get '[XML] (Catalog v)
+type CatalogContent = '[XML, OPDS]
+
+type RootCatalog (v :: Nat) = "catalog" :> Get CatalogContent (Catalog v)
+type ChannelCatalog (v :: Nat) = "catalog" :> "channel" :> Capture "channel_id" Channel.ChannelID :> Get CatalogContent (Catalog v)
 type BaseAPI (v :: Nat) = RootCatalog v
                     :<|> ChannelCatalog v
 
@@ -127,6 +132,8 @@ handler :: forall v. VersionedCatalog AppM v => ServerT (VersionedAPI v) AppM
 handler auth = catalogRoot :<|> catalogChannels
   where
     catalogChannels :: Channel.ChannelID -> AppM (Catalog v)
+    -- Channel specific catalog returns tags inside the catalog
     catalogChannels _ = throwM err403{errBody="Not implemented"}
     catalogRoot :: AppM (Catalog v)
+    -- catalog root returns channels
     catalogRoot = flip requireLoggedIn auth getChannels

src/Servant/XML.hs

@@ -1,9 +1,11 @@
 {-# Language OverloadedStrings #-}
 {-# Language FlexibleInstances #-}
 {-# Language MultiParamTypeClasses #-}
+{-# Language TypeApplications #-}
 module Servant.XML
   ( ToNode(..)
   , XML
+  , OPDS
   , Text.Hamlet.XML.xml
   , iso8601 )
   where
@@ -16,14 +18,22 @@ 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"