142 lines
4.6 KiB
Haskell
Executable File
142 lines
4.6 KiB
Haskell
Executable File
{-# LANGUAGE LambdaCase, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}
|
|
{-# LANGUAGE DuplicateRecordFields, ImportQualifiedPost #-}
|
|
|
|
module Main where
|
|
|
|
import GHC.Generics (Generic)
|
|
import Data.Aeson (FromJSON)
|
|
import Data.Binary (Binary)
|
|
import Control.Monad ((>=>))
|
|
import Data.Function ((&))
|
|
import Data.Text (Text)
|
|
import Data.List (intersperse)
|
|
import Data.Maybe (fromJust)
|
|
import Data.Yaml
|
|
import System.FilePath
|
|
import Lucid
|
|
import Control.Applicative ((<|>))
|
|
import Data.Aeson.KeyMap qualified as KeyMap
|
|
import Data.Text.Lazy qualified as LT
|
|
import Data.Functor
|
|
import Text.Pandoc.Options
|
|
import Text.Pandoc.Shared (isHeaderBlock)
|
|
import Text.Pandoc.Definition (Pandoc(Pandoc), Block(Header))
|
|
|
|
import Achille
|
|
import Achille.Writable (Writable)
|
|
import Achille.Writable qualified as Writable
|
|
import Achille.Internal.IO (AchilleIO)
|
|
import Achille.Task.Pandoc
|
|
|
|
import Template (Template, Context, parseTemplate)
|
|
import Template qualified
|
|
import Config (config, ropts, wopts, SiteConfig(title))
|
|
|
|
|
|
-- Bibliography info
|
|
|
|
data Author = Author
|
|
{ name :: Text
|
|
, url :: Maybe Text
|
|
, orcid :: Maybe Text
|
|
} deriving (Eq, Show, Generic, Binary)
|
|
|
|
instance FromJSON Author where
|
|
parseJSON o =
|
|
withObject "Author info"
|
|
(\v -> Author <$> v .: "name"
|
|
<*> v .:? "url"
|
|
<*> v .:? "orcid") o
|
|
<|> withText "Author name" (\n -> pure $ Author n Nothing Nothing) o
|
|
|
|
data Venue = Venue
|
|
{ name :: Text
|
|
, url :: Text
|
|
} deriving (Eq, Show, Generic, Binary, FromJSON)
|
|
|
|
data Publication = Publication
|
|
{ title :: Text
|
|
, slug :: Text
|
|
, authors :: [Author]
|
|
, file :: Maybe Text
|
|
, doi :: Maybe Text
|
|
, venue :: Venue
|
|
} deriving (Eq, Show, Generic, Binary, FromJSON)
|
|
|
|
parseYaml :: (AchilleIO m, FromJSON a) => FilePath -> Task m a
|
|
parseYaml p = do
|
|
res <- decodeEither' <$> readBS p
|
|
case res of
|
|
Left err -> fail (prettyPrintParseException err)
|
|
Right ok -> return ok
|
|
|
|
render :: Template -> Context -> Text -> LT.Text
|
|
render template ctx body =
|
|
KeyMap.insert "body" (String body) ctx
|
|
& Template.render template
|
|
|
|
|
|
-- writing Html to disk (efficiently)
|
|
instance AchilleIO m => Writable m (Html ()) where
|
|
write to = Writable.write to . renderBS
|
|
|
|
|
|
main = achille do
|
|
index <- readTemplate "index.html"
|
|
|
|
match_ "assets/*" $ copyFile
|
|
match_ "static/*" $ copyFileAs (makeRelative "static/")
|
|
match_ "papers/*" $ copyFile
|
|
|
|
pubs :: [Publication] <- matchFile "publications.yaml" parseYaml
|
|
|
|
watch pubs $ match_ "index.md" \src -> do
|
|
doc <- readPandocWith def {readerExtensions = pandocExtensions} src
|
|
|
|
let Pandoc _ blocks = doc
|
|
let headers = filter isHeaderBlock blocks
|
|
|
|
-- parsing rendered md as template
|
|
template :: Template <- renderPandoc doc <&> parseTemplate <&> fromJust
|
|
|
|
let ctx = KeyMap.insert "nav" (String (LT.toStrict $ renderText $ renderNav headers)) $
|
|
KeyMap.insert "publications" (String (LT.toStrict $ renderText $ renderPublications pubs)) KeyMap.empty
|
|
|
|
write (src -<.> "html") $ render index ctx (LT.toStrict $ Template.render template ctx)
|
|
|
|
where
|
|
renderNav :: [Block] -> Html ()
|
|
renderNav = ul_ . foldMap (\(Header _ (id, _, _) _) -> li_ $ a_ [href_ $ "#" <> id] (toHtmlRaw id))
|
|
|
|
readTemplate :: FilePath -> Task IO Template
|
|
readTemplate src = readText src <&> parseTemplate >>= \case
|
|
Just t -> return t
|
|
Nothing -> fail $ "Could not parse template: " ++ src
|
|
|
|
-- TODO: fix year
|
|
renderPublications :: [Publication] -> Html ()
|
|
renderPublications pubs = section_ [class_ "pubs"] do
|
|
ul_ [ data_ "year" "2022" ] $ foldMap renderPub pubs
|
|
|
|
where renderPub :: Publication -> Html ()
|
|
renderPub Publication {..} = li_ [id_ slug] do
|
|
p_ [class_ "title"] $ a_ [href_ ("#" <> slug)] $ toHtmlRaw title
|
|
p_ [class_ "authors"] $ renderAuthors (reverse (fmap renderAuthor authors))
|
|
let Venue vName vUrl = venue
|
|
p_ [class_ "venue"] $ a_ [href_ vUrl] $ toHtmlRaw vName
|
|
p_ [class_ "buttons"] do
|
|
maybe mempty (\url -> a_ [href_ ("/" <> url)] "PDF") file
|
|
maybe mempty (\doi -> a_ [href_ ("https://doi.org/" <> doi)] "DOI") doi
|
|
|
|
renderAuthor :: Author -> Html ()
|
|
renderAuthor (Author name url orcid) =
|
|
case url of
|
|
Nothing -> toHtmlRaw name
|
|
Just url -> a_ [href_ url] (toHtmlRaw name)
|
|
|
|
renderAuthors :: [Html ()] -> Html ()
|
|
renderAuthors [] = mempty
|
|
renderAuthors [one] = one
|
|
renderAuthors (last:others) =
|
|
mconcat (intersperse ", " (reverse others)) <> " and " <> last
|