219 lines
7.0 KiB
Haskell
219 lines
7.0 KiB
Haskell
{-# 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
|