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") (meta, icon,) <$> getCurrentDir 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)