servant-seo 0.1.0 → 0.1.1
raw patch · 8 files changed
+202/−194 lines, 8 filesdep ~servantPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: servant
API changes (from Hackage documentation)
Files
- CHANGELOG.md +12/−0
- ChangeLog.md +0/−7
- README.md +4/−0
- example/Example.hs +174/−0
- example/example.hs +0/−174
- servant-seo.cabal +5/−4
- src/Servant/Seo.hs +5/−7
- src/Servant/Seo/Sitemap.hs +2/−2
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog for servant-seo++## 0.1.1 -- 2020-07-12++- Fix frequency processing.+- Fix priority processing.++## 0.1.0 -- 2020-07-11++- /robots.txt deriving from API: Disallow, Sitemap, User-agent commands.+- /sitemap.xml deriving from API: Frequency, Priority optional tags included.+- sitemap index support.
− ChangeLog.md
@@ -1,7 +0,0 @@-# Changelog for servant-sitemap--## 0.1.0 -- 2020-07-11--- /robots.txt deriving from API: Disallow, Sitemap, User-agent commands.-- /sitemap.xml deriving from API: Frequency, Priority optional tags included.-- sitemap index support.
README.md view
@@ -1,5 +1,9 @@ # servant-seo +[](https://travis-ci.org/swamp-agr/servant-seo)++[](https://matrix.hackage.haskell.org/api/v2/packages/servant-seo/badge)+ ## Installation - Add `servant-seo` to project dependencies.
+ example/Example.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Main where++import Data.Aeson+import Data.Text (Text)+import qualified Data.Text as Text+import GHC.Generics (Generic)+import qualified Network.Wai.Handler.Warp as Warp+import Servant+import Servant.HTML.Blaze (HTML)+import Text.Blaze (ToMarkup)++import Servant.Seo.Combinators+import Servant.Seo.Sitemap+import Servant.Seo.UI++newtype NewsPage = NewsPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++newtype NewsUrl = NewsUrl Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)++newtype SearchResultPage = SearchResultPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++newtype AboutPage = AboutPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++newtype HomePage = HomePage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++newtype SearchPattern = SearchPattern Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData)++newtype SearchResultsPage = SearchResultsPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)++newtype BlogUrl = BlogUrl Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)++newtype BlogPage = BlogPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++newtype BlogComment = BlogComment Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, FromJSON)++data Login = Login+ { username :: !Text+ , password :: !Text+ }+ deriving (Eq, Show, Generic, FromJSON)++newtype AdminPage = AdminPage Text+ deriving stock (Eq, Show, Generic)+ deriving newtype (ToJSON, FromHttpApiData, ToMarkup)++-- *** User instances++instance ToSitemapPathPiece BlogUrl where+ getPathPiecesForIndexing _ _ = pure $ toUrl <$> ([0 .. 100000] :: [Int])+ where+ toUrl = BlogUrl . Text.pack . show++instance ToSitemapPathPiece NewsUrl where+ getPathPiecesForIndexing _ _ = pure $ toUrl <$> ([0 .. 100] :: [Int])+ where+ toUrl = NewsUrl . Text.pack . show++instance ToSitemapParamPart SearchPattern where+ getParamsForIndexing _ _ = pure $ SearchPattern . Text.pack <$> samples+ where+ samples = [ [ c1, c2 ] | c1 <- ['a' .. 'z'], c2 <- ['0' .. '9'] ]++-- ** Example API++type PublicAPI+ = Get '[HTML] HomePage+ :<|> ("blog" :> Frequency 'Always :> BlogAPI)+ :<|> ("news" :> Capture ":newsurl" NewsUrl :> Get '[HTML] NewsPage)+ :<|> ("search" :> QueryParam "q" SearchPattern :> Get '[HTML] SearchResultsPage)+ :<|> ("about" :> Priority '(1,0) :> Get '[HTML] AboutPage)+ :<|> "auth" :> ReqBody '[JSON] Login :> Post '[JSON] NoContent++type BlogAPI+ = Capture ":blogurl" BlogUrl :> Get '[HTML] BlogPage+ :<|> Capture ":blogurl" BlogUrl+ :> ReqBody '[JSON] BlogComment+ :> Post '[JSON, HTML] BlogPage++type ProtectedAPI = Disallow "admin" :> Get '[HTML] AdminPage++type StaticAPI = "cdn" :> Disallow "static" :> Raw++type API = StaticAPI :<|> ProtectedAPI :<|> PublicAPI++-- ** Example app++api :: Proxy API+api = Proxy++server :: Server API+server+ = serveStatic+ :<|> serveProtected+ :<|> servePublic++serveProtected :: Handler AdminPage+serveProtected = throwError err401++servePublic :: Server PublicAPI+servePublic+ = serveHome+ :<|> (serveBlog :<|> servePostBlogComment)+ :<|> serveNews+ :<|> serveSearch+ :<|> serveAbout+ :<|> serveAuth++serveHome :: Handler HomePage+serveHome = pure (HomePage "")++serveBlog :: BlogUrl -> Handler BlogPage+serveBlog _ = pure (BlogPage "")++servePostBlogComment :: BlogUrl -> BlogComment -> Handler BlogPage+servePostBlogComment _ _ = pure (BlogPage "")++serveSearch :: Maybe SearchPattern -> Handler SearchResultsPage+serveSearch _ = pure (SearchResultsPage "")++serveAbout :: Handler AboutPage+serveAbout = pure (AboutPage "")++serveAuth :: Login -> Handler NoContent+serveAuth _ = pure NoContent++serveNews :: NewsUrl -> Handler NewsPage+serveNews _ = pure (NewsPage "")++serveStatic :: Server StaticAPI+serveStatic = serveDirectoryWebApp "."++startServer :: IO ()+startServer = do+ Warp.runSettings Warp.defaultSettings+ $ serveWithSeo website api server+ where+ website = "https://example.com"++main :: IO ()+main = startServer
− example/example.hs
@@ -1,174 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-module Main where--import Data.Aeson-import Data.Text (Text)-import qualified Data.Text as Text-import GHC.Generics (Generic)-import qualified Network.Wai.Handler.Warp as Warp-import Servant-import Servant.HTML.Blaze (HTML)-import Text.Blaze (ToMarkup)--import Servant.Seo.Combinators-import Servant.Seo.Sitemap-import Servant.Seo.UI--newtype NewsPage = NewsPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)--newtype NewsUrl = NewsUrl Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)--newtype SearchResultPage = SearchResultPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)--newtype AboutPage = AboutPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)--newtype HomePage = HomePage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)--newtype SearchPattern = SearchPattern Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData)--newtype SearchResultsPage = SearchResultsPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)--newtype BlogUrl = BlogUrl Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, ToHttpApiData, FromHttpApiData, ToMarkup)--newtype BlogPage = BlogPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)--newtype BlogComment = BlogComment Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, FromJSON)--data Login = Login- { username :: !Text- , password :: !Text- }- deriving (Eq, Show, Generic, FromJSON)--newtype AdminPage = AdminPage Text- deriving stock (Eq, Show, Generic)- deriving newtype (ToJSON, FromHttpApiData, ToMarkup)---- *** User instances--instance ToSitemapPathPiece BlogUrl where- getPathPiecesForIndexing _ _ = pure $ toUrl <$> ([0 .. 100000] :: [Int])- where- toUrl = BlogUrl . Text.pack . show--instance ToSitemapPathPiece NewsUrl where- getPathPiecesForIndexing _ _ = pure $ toUrl <$> ([0 .. 100] :: [Int])- where- toUrl = NewsUrl . Text.pack . show--instance ToSitemapParamPart SearchPattern where- getParamsForIndexing _ _ = pure $ SearchPattern . Text.pack <$> samples- where- samples = [ [ c1, c2 ] | c1 <- ['a' .. 'z'], c2 <- ['0' .. '9'] ]---- ** Example API--type PublicAPI- = Get '[HTML] HomePage- :<|> ("blog" :> Frequency 'Always :> BlogAPI)- :<|> ("news" :> Capture ":newsurl" NewsUrl :> Get '[HTML] NewsPage)- :<|> ("search" :> QueryParam "q" SearchPattern :> Get '[HTML] SearchResultsPage)- :<|> ("about" :> Priority '(1,0) :> Get '[HTML] AboutPage)- :<|> "auth" :> ReqBody '[JSON] Login :> Post '[JSON] NoContent--type BlogAPI- = Capture ":blogurl" BlogUrl :> Get '[HTML] BlogPage- :<|> Capture ":blogurl" BlogUrl- :> ReqBody '[JSON] BlogComment- :> Post '[JSON, HTML] BlogPage--type ProtectedAPI = Disallow "admin" :> Get '[HTML] AdminPage--type StaticAPI = "cdn" :> Disallow "static" :> Raw--type API = StaticAPI :<|> ProtectedAPI :<|> PublicAPI---- ** Example app--api :: Proxy API-api = Proxy--server :: Server API-server- = serveStatic- :<|> serveProtected- :<|> servePublic--serveProtected :: Handler AdminPage-serveProtected = throwError err401--servePublic :: Server PublicAPI-servePublic- = serveHome- :<|> (serveBlog :<|> servePostBlogComment)- :<|> serveNews- :<|> serveSearch- :<|> serveAbout- :<|> serveAuth--serveHome :: Handler HomePage-serveHome = pure (HomePage "")--serveBlog :: BlogUrl -> Handler BlogPage-serveBlog _ = pure (BlogPage "")--servePostBlogComment :: BlogUrl -> BlogComment -> Handler BlogPage-servePostBlogComment _ _ = pure (BlogPage "")--serveSearch :: Maybe SearchPattern -> Handler SearchResultsPage-serveSearch _ = pure (SearchResultsPage "")--serveAbout :: Handler AboutPage-serveAbout = pure (AboutPage "")--serveAuth :: Login -> Handler NoContent-serveAuth _ = pure NoContent--serveNews :: NewsUrl -> Handler NewsPage-serveNews _ = pure (NewsPage "")--serveStatic :: Server StaticAPI-serveStatic = serveDirectoryWebApp "."--startServer :: IO ()-startServer = do- Warp.runSettings Warp.defaultSettings- $ serveWithSeo website api server- where- website = "https://example.com"--main :: IO ()-main = startServer
servant-seo.cabal view
@@ -1,7 +1,7 @@ cabal-version: 1.12 name: servant-seo-version: 0.1.0+version: 0.1.1 synopsis: Generate Robots.txt and Sitemap.xml specification for your servant API. description: Please see the README on GitHub at <https://github.com/swamp-agr/servant-seo#readme> homepage: https://github.com/swamp-agr/servant-seo#readme@@ -13,10 +13,11 @@ license: BSD3 license-file: LICENSE build-type: Custom+Tested-with: GHC ==8.6.5 || ==8.8.3 extra-source-files: README.md- ChangeLog.md- example/example.hs+ CHANGELOG.md+ example/Example.hs example/example.cabal source-repository head@@ -51,7 +52,7 @@ , containers , http-media , lens >= 4.18.1- , servant+ , servant >= 0.16 , servant-blaze , servant-server , text
src/Servant/Seo.hs view
@@ -135,12 +135,10 @@ -- >>> type AuthAPI = "auth" :> ReqBody '[JSON] Login :> Post '[JSON] NoContent -- >>> type PublicAPI = HomeAPI :<|> AboutAPI :<|> AuthAPI -- >>> type API = PublicAPI :<|> StaticAPI :<|> ProtectedAPI------ Use 'toSitemapInfo' to get the intermediate sitemap representation of API.--- -- >>> toSitemapInfo (Proxy :: Proxy API)--- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "about"], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing}], _sitemapInfoPresent = Just ()}+-- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [], _sitemapQueryParts = [], _sitemapFrequency = Just Monthly, _sitemapPriority = Just "1.0"},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "about"], _sitemapQueryParts = [], _sitemapFrequency = Just Yearly, _sitemapPriority = Just "0.1"}], _sitemapInfoPresent = Just ()} --+-- Use 'toSitemapInfo' to get the intermediate sitemap representation of API. -- 'toSitemapInfo' will automatically skip all HTTP non-GET requests or other content types like @JSON@, @XML@, @PlainText@ and etc. -- -- Only @Get '[HTML] a@ will be accepted.@@ -149,7 +147,7 @@ -- -- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy API) -- >>> BSL8.putStrLn sitemapResponse--- <?xml version="1.0" encoding="UTF-8"?><urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"><url><loc>https://example.com</loc></url><url><loc>https://example.com/about</loc></url></urlset>+-- <?xml version="1.0" encoding="UTF-8"?><urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"><url><loc>https://example.com</loc><changefreq>monthly</changefreq><priority>1.0</priority></url><url><loc>https://example.com/about</loc><changefreq>yearly</changefreq><priority>0.1</priority></url></urlset> -- -- Again, there is helper 'apiWithSitemap'. --@@ -171,10 +169,10 @@ -- -- >>> instance ToSitemapPathPiece NewsUrl where getPathPiecesForIndexing _ _ = pure $ (NewsUrl . Text.pack . show) <$> [0 .. 10] -- >>> toSitemapInfo (Proxy :: Proxy PublicAPI)--- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "about"], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "news",CaptureValues ["0","1","2","3","4","5","6","7","8","9","10"]], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing}], _sitemapInfoPresent = Just ()}+-- SitemapInfo {_sitemapInfoEntries = [SitemapEntry {_sitemapPathPieces = [], _sitemapQueryParts = [], _sitemapFrequency = Just Monthly, _sitemapPriority = Just "1.0"},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "about"], _sitemapQueryParts = [], _sitemapFrequency = Just Yearly, _sitemapPriority = Just "0.1"},SitemapEntry {_sitemapPathPieces = [UrlPathPiece "news",CaptureValues ["0","1","2","3","4","5","6","7","8","9","10"]], _sitemapQueryParts = [], _sitemapFrequency = Nothing, _sitemapPriority = Nothing}], _sitemapInfoPresent = Just ()} -- >>> Right sitemapResponse <- runHandler $ serveSitemap serverUrl (Proxy :: Proxy PublicAPI) -- >>> BSL8.putStrLn sitemapResponse--- <?xml version="1.0" encoding="UTF-8"?><urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"><url><loc>https://example.com</loc></url><url><loc>https://example.com/about</loc></url><url><loc>https://example.com/news/0</loc></url><url><loc>https://example.com/news/1</loc></url><url><loc>https://example.com/news/2</loc></url><url><loc>https://example.com/news/3</loc></url><url><loc>https://example.com/news/4</loc></url><url><loc>https://example.com/news/5</loc></url><url><loc>https://example.com/news/6</loc></url><url><loc>https://example.com/news/7</loc></url><url><loc>https://example.com/news/8</loc></url><url><loc>https://example.com/news/9</loc></url><url><loc>https://example.com/news/10</loc></url></urlset>+-- <?xml version="1.0" encoding="UTF-8"?><urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"><url><loc>https://example.com</loc><changefreq>monthly</changefreq><priority>1.0</priority></url><url><loc>https://example.com/about</loc><changefreq>yearly</changefreq><priority>0.1</priority></url><url><loc>https://example.com/news/0</loc></url><url><loc>https://example.com/news/1</loc></url><url><loc>https://example.com/news/2</loc></url><url><loc>https://example.com/news/3</loc></url><url><loc>https://example.com/news/4</loc></url><url><loc>https://example.com/news/5</loc></url><url><loc>https://example.com/news/6</loc></url><url><loc>https://example.com/news/7</loc></url><url><loc>https://example.com/news/8</loc></url><url><loc>https://example.com/news/9</loc></url><url><loc>https://example.com/news/10</loc></url></urlset> -- -- See 'ToSitemapPathPiece' for more details. --
src/Servant/Seo/Sitemap.hs view
@@ -291,7 +291,7 @@ -- FIXME: compare with previous values, choose frequent one. toSitemapInfo _ = do sitemap <- toSitemapInfo (Proxy :: Proxy api)- pure $ sitemap & sitemapInfoEntries . each %~ (sitemapFrequency . _Just .~ period')+ pure $ sitemap & sitemapInfoEntries . each %~ (sitemapFrequency .~ Just period') where period' = getPeriod (Proxy :: Proxy period) @@ -300,7 +300,7 @@ toSitemapInfo _ = do sitemap <- toSitemapInfo (Proxy :: Proxy api) -- FIXME: compare with previous values, choose greater one.- pure $ sitemap & sitemapInfoEntries . each %~ (sitemapPriority . _Just .~ priority')+ pure $ sitemap & sitemapInfoEntries . each %~ (sitemapPriority .~ Just priority') where n' = natVal (Proxy :: Proxy n) & fromInteger @Float m' = natVal (Proxy :: Proxy m) & fromInteger @Float