packages feed

sitemap-gen (empty) → 0.1.0.0

raw patch · 7 files changed

+509/−0 lines, 7 filesdep +HUnitdep +basedep +bytestringsetup-changed

Dependencies added: HUnit, base, bytestring, raw-strings-qq, sitemap-gen, tasty, tasty-hunit, text, time, xmlgen

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# CHANGELOG++# v0.1.0.0++* Initial Release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Pavan Rikhi (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Pavan Rikhi nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,48 @@+# sitemap-gen++[![sitemap-gen Build Status](https://travis-ci.org/prikhi/sitemap-gen.svg?branch=master)](https://travis-ci.org/prikhi/sitemap-gen)+++`sitemap-gen` is a Haskell library for generating XML sitemaps and sitemap+index files.++It uses the [xmlgen][xmlgen] library to generate XML that conforms to the+[sitemaps.org][sitemap-schema] XML schema.++To use this library, build a `Sitemap` or `SitemapIndex` type and use the+respective `render...` functions to build the `ByteString` output:++```haskell+import Web.Sitemap.Gen (Sitemap(..), SitemapUrl(..), renderSitemap)++import qualified Data.ByteString as BS+import qualified Web.Sitemap.Gen as Sitemap++mySitemap :: BS.ByteString+mySitemap =+    let urls =+            [ SitemapUrl+                { sitemapLocation = "https://mydomain.com/my/url/"+                , sitemapLastModified = Nothing+                , sitemapChangeFrequency = Just Sitemap.Monthly+                , sitemapPriority = Just 0.9+                }+            , SitemapUrl+                { sitemapLocation = "https://mydomain.com/lower/priority/"+                , sitemapLastModified = Nothing+                , sitemapChangeFrequency = Just Sitemap.Yearly+                , sitemapPriority = Just 0.4+                }+            ]+    in+    renderSitemap $ Sitemap urls+```+++## License++BSD-3, exceptions possible.+++[xmlgen]: https://hackage.haskell.org/package/xmlgen+[sitemap-schema]: https://www.sitemaps.org/protocol.html#index
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ sitemap-gen.cabal view
@@ -0,0 +1,67 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 716f09635864c14167c214bde14ad690b83bc22197a791b6d89dd6f9fe46ccf5++name:           sitemap-gen+version:        0.1.0.0+synopsis:       Generate XML Sitemaps & Sitemap Indexes+description:    The @sitemap-gen@ package uses the @xmlgen@ package to generate XML+                sitemaps that are compliant with the sitemaps.org XML schema.+                .+                See the "Web.Sitemap.Gen" module and the+                <https://github.com/prikhi/sitemap-gen/blob/master/README.md README> file+                for documentation & usage details.+category:       Web+homepage:       https://github.com/prikhi/sitemap-gen#readme+bug-reports:    https://github.com/prikhi/sitemap-gen/issues+author:         Pavan Rikhi+maintainer:     pavan.rikhi@gmail.com+copyright:      2019 Pavan Rikhi+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/prikhi/sitemap-gen++library+  exposed-modules:+      Web.Sitemap.Gen+  other-modules:+      Paths_sitemap_gen+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , text >=1 && <2+    , time >=1.6 && <2+    , xmlgen >=0.6 && <1+  default-language: Haskell2010++test-suite sitemap-gen-tests+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_sitemap_gen+  hs-source-dirs:+      tests+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HUnit+    , base >=4.7 && <5+    , bytestring+    , raw-strings-qq+    , sitemap-gen+    , tasty+    , tasty-hunit+    , time+  default-language: Haskell2010
+ src/Web/Sitemap/Gen.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{-| The @Web.Sitemap.Gen@ module contains types & rendering functions+to generate XML compliant with the sitemaps.org specification.++For more information see https://www.sitemaps.org/protocol.html++-}+module Web.Sitemap.Gen+    ( -- * Sitemaps+      Sitemap(..)+    , renderSitemap+    , SitemapUrl(..)+    , renderSitemapUrl+    , ChangeFrequency(..)+    , renderChangeFrequency+      -- * Sitemap Indexes+    , SitemapIndex(..)+    , renderSitemapIndex+    , IndexEntry(..)+    , renderIndexEntry+      -- * Utilities+    , sitemapNamespace+    , formatSitemapTime+    , renderLastModified+    )+where++import           Data.Maybe                     ( catMaybes )+import           Data.Time                      ( UTCTime+                                                , formatTime+                                                , defaultTimeLocale+                                                )+import           GHC.Generics                   ( Generic )+import           Text.XML.Generator             ( Xml+                                                , Elem+                                                , XmlOutput+                                                , Namespace+                                                , xrender+                                                , doc+                                                , defaultDocInfo+                                                , xelemQ+                                                , namespace+                                                , xelems+                                                , xelemWithText+                                                , xtext+                                                , xelem+                                                )++import qualified Data.Text                     as T+++-- SITEMAPS+++-- | A 'Sitemap' contains multiple 'SitemapUrl' elements which describe+-- crawlable locations for search engines.+newtype Sitemap =+    Sitemap+        { sitemapUrls :: [SitemapUrl]+        } deriving (Show, Read, Eq, Generic)++-- | Render a Sitemap into a output format supported by the @xmlgen@ package.+--+-- In most cases you will want to generate a @ByteString@.+renderSitemap :: XmlOutput x => Sitemap -> x+renderSitemap sitemap =+    xrender+        $ doc defaultDocInfo+        $ xelemQ sitemapNamespace "urlset"+        $ xelems+        $ map renderSitemapUrl+        $ sitemapUrls sitemap++-- | A 'SitemapUrl' describes a single URL in a 'Sitemap'.+data SitemapUrl =+    SitemapUrl+        { sitemapLocation :: T.Text+        -- ^ The full URL of the page, including the protocol and+        -- domain name.+        , sitemapLastModified :: Maybe UTCTime+        -- ^ The time the page's content was last changed.+        , sitemapChangeFrequency :: Maybe ChangeFrequency+        -- ^ How often does the content at the URL change?+        , sitemapPriority :: Maybe Double+        -- ^ The relative priority of this URL compared to other URLs in+        -- the sitemap.+        } deriving (Show, Read, Eq, Generic)++-- | Render a 'SitemapUrl' as a @url@ XML element.+renderSitemapUrl :: SitemapUrl -> Xml Elem+renderSitemapUrl url = xelem "url" $ xelems $ catMaybes+    [ Just $ xelemWithText "loc" $ sitemapLocation url+    , renderLastModified <$> sitemapLastModified url+    , xelem "changefreq" . renderChangeFrequency <$> sitemapChangeFrequency url+    , xelemWithText "priority" . T.pack . show <$> sitemapPriority url+    ]++-- | Describes how often a SitemapUrl' is updated. This is considered+-- a hint for crawlers and may or may not be respected.+data ChangeFrequency+    = Always+    -- ^ The page changes every time it is visited.+    | Hourly+    | Daily+    | Weekly+    | Monthly+    | Yearly+    | Never+    -- ^ The page is archived and will never change from now on.+    deriving (Show, Read, Eq, Enum, Bounded, Generic)++-- | Build the XML text content for a 'ChangeFrequency'.+renderChangeFrequency :: ChangeFrequency -> Xml Elem+renderChangeFrequency = xtext . \case+    Always  -> "always"+    Hourly  -> "hourly"+    Daily   -> "daily"+    Weekly  -> "weekly"+    Monthly -> "monthly"+    Yearly  -> "yearly"+    Never   -> "never"+++-- INDEXES+++-- | A 'SitemapIndex' allows informing crawlers of multiple sitemap files+-- hosted on the same domain.+--+-- See https://www.sitemaps.org/protocol.html#index+newtype SitemapIndex =+    SitemapIndex+        { indexEntries :: [IndexEntry]+        } deriving (Show, Read, Eq, Generic)+++-- | Render a 'SitemapIndex' into an output format supported by the+-- @xmlgen@ package.+renderSitemapIndex :: XmlOutput x => SitemapIndex -> x+renderSitemapIndex index =+    xrender+        $ doc defaultDocInfo+        $ xelemQ sitemapNamespace "sitemapindex"+        $ xelems+        $ map renderIndexEntry+        $ indexEntries index++-- | A single sitemap entry for a sitemap index.+data IndexEntry =+    IndexEntry+        { indexLocation :: T.Text+        -- ^ The Full URL of a Sitemap, including the protocol.+        --+        -- E.g., @https://www.southernexposure.com/sitemap.xml@+        , indexLastModified :: Maybe UTCTime+        -- ^ The time the sitemap was last changed.+        } deriving (Show, Read, Eq, Generic)++-- | Render an 'IndexEntry' as a @sitemap@ element.+renderIndexEntry :: IndexEntry -> Xml Elem+renderIndexEntry entry = xelem "sitemap" $ xelems $ catMaybes+    [ Just $ xelemWithText "loc" $ indexLocation entry+    , renderLastModified <$> indexLastModified entry+    ]+++-- UTILS+++-- | An XML Namespace for the sitemaps.org @v0.9@ schema.+sitemapNamespace :: Namespace+sitemapNamespace = namespace "" "http://www.sitemaps.org/schemas/sitemap/0.9"++-- | Render the 'UTCTime' in @YYYY-MM-DDTHH:MM:SS+00:00@ format.+formatSitemapTime :: UTCTime -> T.Text+formatSitemapTime = T.pack . formatTime defaultTimeLocale "%FT%T+00:00"++-- | Render a 'UTCTime' in a @lastmod@ element.+renderLastModified :: UTCTime -> Xml Elem+renderLastModified = xelemWithText "lastmod" . formatSitemapTime
+ tests/Spec.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}+import           Data.Time+import           Test.Tasty+import           Test.Tasty.HUnit        hiding ( assert )+import           Text.RawString.QQ              ( r )++import           Web.Sitemap.Gen++import qualified Data.ByteString               as BS+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup+    "sitemap.org Examples"+    [ testCase "Single Url Sitemap"   singleUrlSitemap+    , testCase "Multiple Url Sitemap" multipleUrlSitemap+    , testCase "Sitemap Index"        sitemapIndex+    ]+++singleUrlSitemap :: Assertion+singleUrlSitemap =+    let+        rendered = renderSitemap $ Sitemap+            [ SitemapUrl+                  { sitemapLocation        = "http://www.example.com/"+                  , sitemapPriority        = Just 0.8+                  , sitemapChangeFrequency = Just Monthly+                  , sitemapLastModified    = Just $ UTCTime+                                                 (fromGregorian 2005 01 01)+                                                 0+                  }+            ]+    in  singleUrlSitemapFixture @=? rendered++++singleUrlSitemapFixture :: BS.ByteString+singleUrlSitemapFixture =+    [r|<?xml version="1.0" encoding="UTF-8" standalone="yes"?>+<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"+><url+><loc+>http://www.example.com/</loc+><lastmod+>2005-01-01T00:00:00+00:00</lastmod+><changefreq+>monthly</changefreq+><priority+>0.8</priority+></url+></urlset+>|]+++multipleUrlSitemap :: Assertion+multipleUrlSitemap =+    let+        urls =+            [ SitemapUrl "http://www.example.com/"+                         (Just $ UTCTime (fromGregorian 2005 01 01) 0)+                         (Just Monthly)+                         (Just 0.8)+            , SitemapUrl+                "http://www.example.com/catalog?item=12&desc=vacation_hawaii"+                Nothing+                (Just Weekly)+                Nothing+            , SitemapUrl+                "http://www.example.com/catalog?item=73&desc=vacation_new_zealand"+                (Just $ UTCTime (fromGregorian 2004 12 23) 0)+                (Just Weekly)+                Nothing+            , SitemapUrl+                "http://www.example.com/catalog?item=74&desc=vacation_newfoundland"+                (Just $ UTCTime (fromGregorian 2004 12 23) 64815)+                Nothing+                (Just 0.3)+            , SitemapUrl+                "http://www.example.com/catalog?item=83&desc=vacation_usa"+                (Just $ UTCTime (fromGregorian 2004 11 23) 0)+                Nothing+                Nothing+            ]+    in  multipleUrlSitemapFixture @=? renderSitemap (Sitemap urls)++multipleUrlSitemapFixture :: BS.ByteString+multipleUrlSitemapFixture =+    [r|<?xml version="1.0" encoding="UTF-8" standalone="yes"?>+<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"+><url+><loc+>http://www.example.com/</loc+><lastmod+>2005-01-01T00:00:00+00:00</lastmod+><changefreq+>monthly</changefreq+><priority+>0.8</priority+></url+><url+><loc+>http://www.example.com/catalog?item=12&amp;desc=vacation_hawaii</loc+><changefreq+>weekly</changefreq+></url+><url+><loc+>http://www.example.com/catalog?item=73&amp;desc=vacation_new_zealand</loc+><lastmod+>2004-12-23T00:00:00+00:00</lastmod+><changefreq+>weekly</changefreq+></url+><url+><loc+>http://www.example.com/catalog?item=74&amp;desc=vacation_newfoundland</loc+><lastmod+>2004-12-23T18:00:15+00:00</lastmod+><priority+>0.3</priority+></url+><url+><loc+>http://www.example.com/catalog?item=83&amp;desc=vacation_usa</loc+><lastmod+>2004-11-23T00:00:00+00:00</lastmod+></url+></urlset+>|]+++sitemapIndex :: Assertion+sitemapIndex =+    let sitemaps =+                [ IndexEntry+                    "http://www.example.com/sitemap1.xml.gz"+                    ( Just+                    $ UTCTime (fromGregorian 2004 10 01)+                    $ 18+                    * 60+                    * 60+                    + 23+                    * 60+                    + 17+                    )+                , IndexEntry "http://www.example.com/sitemap2.xml.gz"+                             (Just $ UTCTime (fromGregorian 2005 01 01) 0)+                ]+    in  sitemapIndexFixture @=? renderSitemapIndex (SitemapIndex sitemaps)+++sitemapIndexFixture :: BS.ByteString+sitemapIndexFixture =+    [r|<?xml version="1.0" encoding="UTF-8" standalone="yes"?>+<sitemapindex xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"+><sitemap+><loc+>http://www.example.com/sitemap1.xml.gz</loc+><lastmod+>2004-10-01T18:23:17+00:00</lastmod+></sitemap+><sitemap+><loc+>http://www.example.com/sitemap2.xml.gz</loc+><lastmod+>2005-01-01T00:00:00+00:00</lastmod+></sitemap+></sitemapindex+>|]