diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for Shakebook +## (v0.7.3.0) + +* Add `Shakebook.Sitemap` module using [sitemap-gen](https://hackage.haskell.org/package/sitemap-gen). +* Relax bounds on `aeson`. + ## (v0.7.2.0) * Upgrade to [aeson-with](https://hackage.haskell.org/package/aeson-with) v0.1.1.0. diff --git a/shakebook.cabal b/shakebook.cabal --- a/shakebook.cabal +++ b/shakebook.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.1. +-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack -- --- hash: 0ed9b385c04cfae22cd6f8586c6fd4b3659a7a6697ffaba9679d0823ca37c3a9 +-- hash: 8329d59b395ffc986184520fdaba6387a2cc9eea83117581a5d9fe2a8cf8144f name: shakebook -version: 0.7.2.0 +version: 0.7.3.0 synopsis: Shake-based technical documentation generator; HTML & PDF description: Shakebook is a documentation generator aimed at covering all the bases for mathematical, technical and scientific diagrams and typesetting. Shakebook provides combinators for taking markdown files and combining them into documents, but allowing the user to control how. Shakebook provides general combinators for templating single pages, cofree comonads for representing tables of contents, and zipper comonads for representing pagers. category: Web @@ -29,14 +29,15 @@ Shakebook.Feed Shakebook.Mustache Shakebook.Pandoc + Shakebook.Sitemap other-modules: Paths_shakebook hs-source-dirs: src default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -fno-warn-orphans -Wredundant-constraints build-depends: - aeson >=1.5.2.0 + aeson , aeson-with >=0.1.1.0 , base >=4.7 && <5 , comonad @@ -53,6 +54,7 @@ , path-extensions >=0.0.1.0 , rio , shake-plus >=0.1.7.0 + , sitemap-gen , slick >=1.0.1.1 , split , text-time @@ -67,9 +69,9 @@ hs-source-dirs: test default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -fno-warn-orphans -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - aeson >=1.5.2.0 + aeson , aeson-with >=0.1.1.0 , base >=4.7 && <5 , comonad @@ -87,6 +89,7 @@ , rio , shake-plus >=0.1.7.0 , shakebook + , sitemap-gen , slick >=1.0.1.1 , split , tasty diff --git a/src/Shakebook.hs b/src/Shakebook.hs --- a/src/Shakebook.hs +++ b/src/Shakebook.hs @@ -10,6 +10,7 @@ , module Shakebook.Feed , module Shakebook.Mustache , module Shakebook.Pandoc +, module Shakebook.Sitemap , module Text.Pandoc.Highlighting ) where @@ -24,4 +25,5 @@ import Shakebook.Feed import Shakebook.Mustache import Shakebook.Pandoc +import Shakebook.Sitemap import Text.Pandoc.Highlighting diff --git a/src/Shakebook/Conventions.hs b/src/Shakebook/Conventions.hs --- a/src/Shakebook/Conventions.hs +++ b/src/Shakebook/Conventions.hs @@ -4,6 +4,7 @@ module Shakebook.Conventions ( -- * Lenses viewImage +, viewModified , viewPostTime , viewPostTimeRaw , viewTags @@ -13,6 +14,7 @@ , withBaseUrl , withFullUrl , withHighlighting +, withModified , withNext , withPages , withPrettyDate @@ -80,6 +82,10 @@ viewImage :: ToJSON a => a -> Text viewImage = view' (key "image" . _String) +-- | View the "modified" field of a JSON value. +viewModified :: ToJSON a => a -> UTCTime +viewModified = parseISODateTime . view' (key "modified" . _String) + -- | View the "date" field of a JSON Value as a UTCTime. viewPostTime :: ToJSON a => a -> UTCTime viewPostTime = parseISODateTime . view' (key "date" . _String) @@ -116,6 +122,10 @@ withHighlighting :: Style -> Value -> Value withHighlighting = withStringField "highlighting-css" . T.pack . styleToCss +-- | Add "modified" field from input UTCTime. +withModified :: UTCTime -> Value -> Value +withModified = withStringField "modified" . T.pack . formatTime defaultTimeLocale (iso8601DateFormat Nothing) + -- | Add "next" field from input Value. withNext :: ToJSON a => a -> Value -> Value withNext = withValue "next" @@ -201,6 +211,8 @@ genLinkData :: Text -> Text -> Value genLinkData x u = object ["id" A..= String x, "url" A..= String u] +deriving instance Ord Value + -- | Indexable Post Type newtype Post = Post { unPost :: Value } deriving (Show, Eq, Ord, Data, Typeable, ToJSON) @@ -222,10 +234,10 @@ deriving (Show, Eq, Ord, Data, Typeable) instance Indexable '[Tag, Posted, YearMonth, SrcFile] Post where - indices = ixList (ixFun (fmap Tag . viewTags . unPost)) - (ixFun (pure . Posted . viewPostTime . unPost)) - (ixFun (pure . YearMonth . (\(a,b,_) -> (a,b)) . toGregorian . utctDay . viewPostTime . unPost)) - (ixFun (pure . SrcFile . viewSrcPath . unPost)) + indices = ixList (ixFun (fmap Tag . viewTags)) + (ixFun (pure . Posted . viewPostTime)) + (ixFun (pure . YearMonth . (\(a,b,_) -> (a,b)) . toGregorian . utctDay . viewPostTime)) + (ixFun (pure . SrcFile . viewSrcPath)) -- | Take a Value loading function and a filepattern and return an indexable set of Posts. postIndex :: MonadAction m @@ -253,8 +265,8 @@ , "toc2" A..= Array (V.fromList $ map (uncurry toc2) $ groupDescBy xs)] ] where toc2 _ [] = object [] - toc2 (YearMonth (_, _)) t@(x : _) = object [ "title" A..= String (f (viewPostTime . unPost $ x)) - , "url" A..= String (g (viewPostTime . unPost $ x)) + toc2 (YearMonth (_, _)) t@(x : _) = object [ "title" A..= String (f (viewPostTime x)) + , "url" A..= String (g (viewPostTime x)) , "toc3" A..= Array (V.fromList $ sortOn (Down . viewPostTime) (unPost <$> t)) ] -- | Create a toc navbar object for a docs section, with layers "toc1", "toc2" and "toc3". diff --git a/src/Shakebook/Sitemap.hs b/src/Shakebook/Sitemap.hs new file mode 100644 --- /dev/null +++ b/src/Shakebook/Sitemap.hs @@ -0,0 +1,20 @@ +module Shakebook.Sitemap where + +import Data.Aeson +import Development.Shake.Plus +import RIO +import qualified RIO.ByteString.Lazy as LBS +import Shakebook.Conventions +import Shakebook.Pandoc +import Web.Sitemap.Gen + +asSitemapUrl :: Text -> Value -> SitemapUrl +asSitemapUrl baseUrl x = SitemapUrl { + sitemapLocation = baseUrl <> viewUrl x + , sitemapLastModified = Just (viewPostTime x) + , sitemapChangeFrequency = Nothing + , sitemapPriority = Nothing } + +buildSitemap :: MonadAction m => Text -> [Value] -> Path Rel File -> m () +buildSitemap baseUrl xs out = do + LBS.writeFile (toFilePath out) $ renderSitemap $ Sitemap $ fmap (asSitemapUrl baseUrl) xs diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -21,8 +21,8 @@ outputFolder :: Path Rel Dir outputFolder = $(mkRelDir "test/public") ---baseUrl :: Text ---baseUrl = "http://blanky.test" +baseUrl :: Text +baseUrl = "http://blanky.test" siteTitle :: Text siteTitle = "Blanky Site" @@ -162,6 +162,10 @@ o' ["css//*", "js//*", "webfonts//*", "images//*"] |%^> \out -> copyFileChangedWithin (blinkLocalDir sourceFolder out) out + o' "sitemap.xml" %^> \out -> do + xs <- postsZ myPosts + buildSitemap baseUrl (unzipper $ unPost <$> xs) (fromWithin out) + let simplePipeline f = getDirectoryFiles sourceFolder >=> mapM f >=> needIn outputFolder verbatimPipeline = simplePipeline return @@ -199,6 +203,8 @@ logInfo $ "Cleaning files in " <> displayShow outputFolder removeFilesAfter outputFolder ["//*"] + phony "sitemap" $ needIn outputFolder [$(mkRelFile "sitemap.xml")] + tests :: [FilePath] -> TestTree tests xs = testGroup "Rendering Tests" $ map ( \x -> goldenVsFile x x @@ -208,10 +214,10 @@ main :: IO () main = do - xs <- findByExtension [".html"] "test/golden" + xs <- findByExtension [".html", ".xml"] "test/golden" logOptions' <- logOptionsHandle stdout True (lf, dlf) <- newLogFunc (setLogMinLevel LevelInfo logOptions') shake shakeOptions $ want ["clean"] >> runShakePlus lf rules - shake shakeOptions $ want ["index", "docs", "posts", "post-index", "by-tag-index", "by-month-index"] >> runShakePlus lf rules + shake shakeOptions $ want ["index", "docs", "posts", "post-index", "by-tag-index", "by-month-index", "sitemap"] >> runShakePlus lf rules defaultMain $ tests xs dlf