module Web.Site.Rules.Article (rules, items) where
import Data.ByteString.Lazy.Char8 (unpack)
import Hakyll
import Text.Pandoc.Builder (setMeta)
import Web.Site.Compilers
import Web.Site.Routes
rules :: Rules ()
rules :: Rules ()
rules = do
Pattern -> Rules () -> Rules ()
match (Pattern
articlePattern Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/**.hs") (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$
Routes -> Routes -> Routes
composeRoutes Routes
dropExtensions (Routes -> Routes) -> Routes -> Routes
forall a b. (a -> b) -> a -> b
$
String -> (String -> String) -> Routes
gsubRoute String
"/index$" (String -> String -> String
forall a b. a -> b -> a
const String
"/index.html")
Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
Compiler (Item String)
articleCompiler
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
"articles"
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/article.html" Context String
siteContext
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
siteContext
Pattern -> Rules () -> Rules ()
match Pattern
"article/**.hs" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$
Routes -> Routes -> Routes
composeRoutes Routes
dropExtensions (Routes -> Routes) -> Routes -> Routes
forall a b. (a -> b) -> a -> b
$
String -> (String -> String) -> Routes
gsubRoute String
"/index$" (String -> String -> String
forall a b. a -> b -> a
const String
"/index.html")
Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
[String] -> Compiler (Item ByteString)
haskellCompiler []
Compiler (Item ByteString)
-> (Item ByteString -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler (Item String)
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item String -> Compiler (Item String))
-> (Item ByteString -> Item String)
-> Item ByteString
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> String) -> Item ByteString -> Item String
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
unpack
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
"articles"
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/article.html" Context String
siteContext
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
siteContext
Pattern -> Rules () -> Rules ()
match Pattern
"article/index.markdown" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Routes
constRoute String
"articles"
Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
Compiler (Item String)
articleCompiler
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
siteContext
Pattern -> Rules () -> Rules ()
match Pattern
"article/archive.html" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Routes
constRoute String
"article/archive"
Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
[Item String]
articles <- [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots Pattern
articlePattern String
"articles"
let context :: Context String
context =
String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"articles" Context String
siteContext ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item String]
articles)
Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext
Compiler (Item String)
getResourceBody
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context String -> Item String -> Compiler (Item String)
applyAsTemplate Context String
context
Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
context
[Identifier] -> Rules () -> Rules ()
create [Identifier
"articles.xml"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
Routes -> Rules ()
route Routes
idRoute
Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
let itemContext :: Context String
itemContext = Context String
forall a. Context a
metadataField Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> String -> Context String
bodyField String
"description" Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext
[Item String]
articles <- ([Item String] -> [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Item String] -> [Item String]
forall a. Int -> [a] -> [a]
take Int
10) (Compiler [Item String] -> Compiler [Item String])
-> ([Item String] -> Compiler [Item String])
-> [Item String]
-> Compiler [Item String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots Pattern
articlePattern String
"articles"
FeedConfiguration
-> Context String -> [Item String] -> Compiler (Item String)
renderRss FeedConfiguration
updateFeedConfiguration Context String
itemContext [Item String]
articles
Pattern -> Rules () -> Rules ()
match Pattern
"article/bibliography/references.bib" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item Biblio) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item Biblio)
biblioCompiler
Pattern -> Rules () -> Rules ()
match Pattern
"article/bibliography/acm.csl" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item CSL) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CSL)
cslCompiler
articlePattern :: Pattern
articlePattern :: Pattern
articlePattern =
Pattern
"article/**"
Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/archive.html"
Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/index.markdown"
Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/bibliography/**"
Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/**.metadata"
items :: Pattern
items :: Pattern
items =
Pattern
articlePattern
Pattern -> Pattern -> Pattern
.||. Pattern
"article/index.markdown"
Pattern -> Pattern -> Pattern
.||. Pattern
"article/archive.html"
articleCompiler :: Compiler (Item String)
articleCompiler :: Compiler (Item String)
articleCompiler = do
let readerOptions :: ReaderOptions
readerOptions = ReaderOptions -> ReaderOptions
mathReaderWith ReaderOptions
defaultHakyllReaderOptions
WriterOptions
writerOptions <- WriterOptions -> Compiler WriterOptions
getTocOptionsWith (WriterOptions -> Compiler WriterOptions)
-> WriterOptions -> Compiler WriterOptions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WriterOptions
mathWriterWith WriterOptions
defaultHakyllWriterOptions
Item Biblio
bibFile <- Identifier -> Compiler (Item Biblio)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load Identifier
"article/bibliography/references.bib"
Item CSL
cslFile <- Identifier -> Compiler (Item CSL)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load Identifier
"article/bibliography/acm.csl"
Compiler (Item String)
getResourceBody
Compiler (Item String)
-> (Item String -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
readerOptions
Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item Pandoc -> Compiler (Item Pandoc)
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item Pandoc -> Compiler (Item Pandoc))
-> (Item Pandoc -> Item Pandoc)
-> Item Pandoc
-> Compiler (Item Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pandoc -> Pandoc) -> Item Pandoc -> Item Pandoc
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Bool -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Pandoc -> Pandoc
setMeta Text
"link-citations" Bool
True)
Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item CSL -> Item Biblio -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblio Item CSL
cslFile Item Biblio
bibFile
Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler (Item String)
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item String -> Compiler (Item String))
-> (Item Pandoc -> Item String)
-> Item Pandoc
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
writerOptions
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration =
FeedConfiguration
{ feedTitle :: String
feedTitle = String
"Articles by Yoo Chung",
feedDescription :: String
feedDescription = String
"Articles written by Yoo Chung and posted on their personal web site.",
feedAuthorName :: String
feedAuthorName = String
"Yoo Chung",
feedAuthorEmail :: String
feedAuthorEmail = String
"web@chungyc.org",
feedRoot :: String
feedRoot = String
"https://chungyc.org"
}