109 lines
3.5 KiB
Haskell
Executable File
109 lines
3.5 KiB
Haskell
Executable File
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)
|