Initial commit

site/cabal.project

@@ -0,0 +1,9 @@
+packages: .
+
+source-repository-package
+  type: git
+  location: https://gitlab.com/tojnar.cz/hakyll-contrib-tojnar
+  tag: master
+
+package hakyll-contrib-tojnar
+  flags: -gd

site/mala-zahradka-pro-radost-cz.cabal

@@ -0,0 +1,24 @@
+cabal-version: 3.4
+name: mala-zahradka-pro-radost-cz
+version: 0.0.1
+
+executable site
+  main-is: site.hs
+  hs-source-dirs: src
+  build-depends:
+    base >= 4.8 && < 5,
+    containers >= 0.5 && < 0.7,
+    directory >= 1.3 && < 1.4,
+    extra >= 1.7 && < 1.8,
+    hakyll >= 4.9 && < 4.16,
+    hakyll-contrib-tojnar >= 0.2.1 && < 0.3.0,
+    filepath >= 1.4 && < 1.5,
+    pandoc >= 2.0 && < 2.18,
+    process >= 1.6 && < 1.7,
+    time >= 1.9 && < 1.12,
+  ghc-options:
+    -- Required for watch on Windows.
+    -threaded
+
+    -Wall
+    -fno-warn-tabs

site/src/site.hs

@@ -0,0 +1,218 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+
+import Control.Monad ((<=<))
+import Data.Function ((&))
+import Data.List.Extra (dropSuffix)
+import Data.Maybe (fromMaybe)
+import Data.Time.Format (TimeLocale (..), defaultTimeLocale)
+import qualified GHC.IO.Encoding as E
+import Hakyll
+import Hakyll.Contrib.Tojnar.CleanUrls (cleanRoute, cleanUrlField)
+import Hakyll.Contrib.Tojnar.ExternalMetadata (externalMetadataField)
+import Hakyll.Contrib.Tojnar.Gallery (figureGroups, implicitFigures)
+import Hakyll.Contrib.Tojnar.LinkResolver (resolveLinksTargets, saveUrl)
+import Hakyll.Contrib.Tojnar.Menu (menuField)
+import Hakyll.Contrib.Tojnar.Thumbnail (ThumbnailGenerator, ThumbnailStyle, ThumbSize, makeThumbnails, sizeDims)
+import System.Directory (canonicalizePath, createDirectoryIfMissing)
+import System.FilePath (splitDirectories, takeDirectory)
+import System.Process (callProcess)
+import Text.Pandoc.Extensions (Extension (..), disableExtension)
+import Text.Pandoc.Options (readerExtensions)
+
+postPattern :: Pattern
+postPattern = "content/novinky/*.md"
+
+pagesPattern :: Pattern
+pagesPattern = fromRegex "^content/(.+/)?[^@/][^/]+\\.md$"
+
+menuPattern :: Pattern
+menuPattern = fromRegex "^content/(.+/)?@menu\\.md$"
+
+contentSnapshot :: Snapshot
+contentSnapshot = "content"
+
+config :: Configuration
+config = defaultConfiguration {
+	destinationDirectory = "public",
+	previewHost = "0.0.0.0"
+}
+
+feedConfiguration :: String -> String -> String -> FeedConfiguration
+feedConfiguration rootUri title description =
+	FeedConfiguration {
+		feedTitle = title,
+		feedDescription = description,
+		feedAuthorName = "",
+		feedAuthorEmail = "",
+		feedRoot = rootUri
+	}
+
+
+main :: IO ()
+main = do
+	E.setLocaleEncoding E.utf8
+
+	hakyllWith config $ do
+		match "static/styles/*" $ do
+			route stripStaticDirectory
+			compile compressCssCompiler
+
+		match ("static/scripts/*" .||. "static/images/*") $ do
+			route stripStaticDirectory
+			compile copyFileCompiler
+
+		-- Match pages that are not posts.
+		match (pagesPattern .&&. complement postPattern) $ do
+			route $ stripContentDirectory `composeRoutes` cleanRoute
+			compile $ do
+				saveUrl pageContext
+				markdownCompiler
+					>>= loadAndApplyTemplate "templates/layout.html" pageContext
+
+		-- Match news posts.
+		match postPattern $ do
+			route $ stripContentDirectory `composeRoutes` cleanRoute `composeRoutes` rmDateRoute
+			compile $ do
+				saveUrl postContext
+				markdownCompiler
+					>>= saveSnapshot contentSnapshot
+					>>= loadAndApplyTemplate "templates/post.html" postContext
+					>>= loadAndApplyTemplate "templates/layout.html" postContext
+
+		-- Create news page.
+		create ["content/novinky/index.html"] $ do
+			route stripContentDirectory
+			compile $ do
+				let metadataFile = fromFilePath "content/metadata.yaml"
+				newsTitle <- fromMaybe "" <$> getMetadataField metadataFile "newsTitle"
+
+				posts <- recentFirst =<< loadAllSnapshots (postPattern .&&. hasNoVersion) contentSnapshot
+
+				let indexContext =
+					listField "posts" postContext (return posts)
+					<> bodyField "body"
+					<> metadataField
+					<> missingField
+				let context =
+					constField "title" newsTitle
+					<> pageContext
+
+				makeItem ""
+					>>= loadAndApplyTemplate "templates/posts.html" indexContext
+					>>= loadAndApplyTemplate "templates/layout.html" context
+
+		-- Create ATOM feed for news.
+		create ["content/feed.atom"] $ do
+			route stripContentDirectory
+			compile $ do
+				let metadataFile = fromFilePath "content/metadata.yaml"
+				title <- fromMaybe "" <$> getMetadataField metadataFile "feedTitle"
+				description <- fromMaybe "" <$> getMetadataField metadataFile "feedDescription"
+				rootUri <- fromMaybe "" <$> getMetadataField metadataFile "rootUri"
+
+				let feedCtx =
+					postContext
+					<> bodyField "description"
+
+				posts <- fmap (take 10) . recentFirst =<< loadAllSnapshots (postPattern .&&. hasNoVersion) contentSnapshot
+				renderAtom (feedConfiguration rootUri title description) feedCtx posts
+
+		match menuPattern $ do
+			compile markdownCompiler
+
+		match (fromRegex "^content/" .&&. complement (fromRegex "\\.md$")) $ do
+			route $ stripContentDirectory `composeRoutes` idRoute
+			compile copyFileCompiler
+
+		match "templates/*" $ compile templateCompiler
+
+
+-- | Take out the yyyy-mm-dd part from the post URL
+rmDateRoute :: Routes
+-- gsubRoute uses / as directory separator even on Windows.
+rmDateRoute = gsubRoute "/[0-9]{4}-[0-9]{2}-[0-9]{2}-" (const "/")
+
+stripContentDirectory :: Routes
+-- gsubRoute uses / as directory separator even on Windows.
+stripContentDirectory = gsubRoute "content/" (const "")
+
+stripStaticDirectory :: Routes
+-- gsubRoute uses / as directory separator even on Windows.
+stripStaticDirectory = gsubRoute "static/" (const "")
+
+
+pageContext :: Context String
+pageContext =
+	cleanUrlField
+	<> externalMetadataField
+	<> menuField
+	<> defaultContext
+
+-- | Defines a context for posts
+postContext :: Context String
+postContext = do
+	postSlugField
+	<> localizedDateField "date"
+	<> dateField "isodate" "%Y-%m-%d"
+	<> pageContext
+
+-- | Field extracting a “slug” from post item’s route.
+postSlugField :: Context a
+postSlugField = field "slug" $ \item -> do
+	url <- fromMaybe "" <$> getRoute (itemIdentifier item)
+	return (routeToSlug url)
+	where
+		-- | Extract the post’s slug (the directory name).
+		-- >>> mrouteToSlug "novinky/spusteni-webu/index.html"
+		-- "spusteni-webu"
+		routeToSlug :: FilePath -> String
+		routeToSlug = last . dropSuffix ["index.html"] . splitDirectories
+
+localizedDateField :: String -> Context a
+localizedDateField fieldName =
+	dateFieldWith timeLocaleCs fieldName (dateFmt timeLocaleCs)
+
+timeLocaleCs :: TimeLocale
+timeLocaleCs =
+	defaultTimeLocale {
+		months = [
+			("ledna", "led"),
+			("února", "úno"),
+			("března", "bře"),
+			("dubna", "dub"),
+			("května", "kvě"),
+			("června", "čer"),
+			("července", "čec"),
+			("srpna", "srp"),
+			("září", "zář"),
+			("října", "říj"),
+			("listopadu", "lis"),
+			("prosince", "pro")
+		],
+		dateFmt = "%e. %B %Y"
+	}
+
+
+markdownCompiler :: Compiler (Item String)
+markdownCompiler = pandocCompilerWithTransformM readOpts writeOpts filters
+	where
+		enabledReaderExtensions =
+			readerExtensions defaultHakyllReaderOptions
+			& disableExtension Ext_markdown_in_html_blocks
+			& disableExtension Ext_implicit_figures
+		readOpts = defaultHakyllReaderOptions { readerExtensions = enabledReaderExtensions }
+		writeOpts = defaultHakyllWriterOptions
+		filters = resolveLinksTargets <=< (makeThumbnails thumbnailer . implicitFigures . figureGroups)
+
+thumbnailer :: ThumbnailGenerator
+thumbnailer style source destinations =
+	mapM_ (\(size, destination) -> generateThumbnail style size source destination) destinations
+
+generateThumbnail :: ThumbnailStyle -> ThumbSize -> FilePath -> FilePath -> IO ()
+generateThumbnail style size source destination = do
+	let (width, height) = sizeDims style size
+	createDirectoryIfMissing True (takeDirectory destination)
+	destination' <- canonicalizePath destination
+	callProcess "vipsthumbnail" [source, "--size", show width ++ "x" ++ show height, "-o", destination']
+	putStrLn $ "  generated thumbnail " ++ destination