acatalepsie/src/Projects.hs

module Projects (build) where

import Lucid
import Data.Char (digitToInt, isDigit)
import qualified Data.Map.Strict as Map
import Control.Monad (unless)

import Common
import Route
import Types
import Config
import Templates

data Project = Project
    { title    :: Text
    , subtitle :: Text
    , year     :: Text
    , labels   :: Map.Map Text Text
    } deriving (Generic, Eq, FromJSON, Binary)


build :: Task IO ()
build = do
    projects <- matchDir "projects/*/" buildProject

    watch projects $ match_ "./projects.rst" \src -> do
        intro <- compilePandocWith def wopts src
        write "projects.html" (renderIndex intro projects)


buildProject :: FilePath -> Task IO (Project, Text, FilePath)
buildProject src = do
    match "*" copyFile

    name     <- takeBaseName <$> getCurrentDir
    children <- buildChildren name

    icon     <- matchFile "logo.svg" readText

    watch children $ watch icon $ matchFile "index.*" \src -> do
        (meta, doc) <- readPandocMetadataWith ropts src

        renderPandocWith wopts doc
          <&> renderProject meta icon children
          >>= write (src -<.> "html")

        pure (meta, icon, "/projects" </> name <> "/")

    where
        buildChildren :: String -> Task IO [(Text, FilePath)]
        buildChildren name = match "pages/*" \filepath -> do
            let (key, file) = getKey $ takeFileName filepath
            (TitledPage title _, doc) <- readPandocMetadataWith ropts filepath
            renderPandocWith wopts doc
                <&> toHtmlRaw
                <&> outerWith (def { Config.title = title
                                   , Config.route = ProjectPageRoute title (ProjectRoute $ fromString name)
                                   })
                >>= write (filepath -<.> "html")
                <&> (title,)


renderProject :: Project -> Text -> [(Text, FilePath)] -> Text -> Html ()
renderProject Project{..} logo children content =
    outerWith def { Config.title       = title
                  , Config.description = subtitle
                  , Config.route       = ProjectRoute title
                  } do
        header_ [class_ "project"] do
            div_ (toHtmlRaw logo)
            div_ do
                h1_ (toHtml title)
                p_  (toHtml subtitle)
                ul_ $ forM_ (Map.toList labels) \(k, v) -> li_ do
                    toHtml k <> ": "
                    if k == "repo" then
                        a_ [href_ $ "https://github.com/" <> v]
                            $ toHtml v
                    else toHtml v
        unless (null children) $
            ol_ [class_ "pages"] $ forM_ children \(title, path) ->
                li_ $ a_ [href_ (fromString path)] (toHtml title)
        toHtmlRaw content


renderIndex :: Text -> [(Project, Text, FilePath)] -> Html ()
renderIndex intro projects =
    outerWith def { Config.title = "projects"
                  , Config.description = intro
                  } do
        toHtmlRaw intro
        ul_ [class_ "projects"] $ forM_ projects projectLink
    where
        projectLink :: (Project, Text, FilePath) -> Html ()
        projectLink (Project{..}, logo, path) =
            li_ $ a_ [href_ (fromString path)] do
                div_ $ toHtmlRaw logo
                div_ $ h2_ (toHtml title) >> p_  (toHtml subtitle)


getKey :: String -> (Int, String)
getKey xs = getKey' 0 xs
    where
        getKey' :: Int -> String -> (Int, String)
        getKey' k (x : xs) | isDigit x =
            getKey' (k * 10 +  digitToInt x) xs
        getKey' k ('-' : xs) = (k, xs)
        getKey' k xs         = (k, xs)