diff --git a/site.hs b/site.hs index ab0af28..1a88da7 100644 --- a/site.hs +++ b/site.hs @@ -119,20 +119,24 @@ checkTarget fp = do then error $ "colliding renders for page: " ++ fp else targets %= S.insert fp +-- | Prepend the root path to the given link +rootUrl :: FilePath -> Site FilePath +rootUrl = pure . ('/' :) + -- | Process a single link pointing out from a page. processLink :: FilePath -> String -> Site String processLink base l = do if isAbsolute l - then pure l + then pure l -- TODO prepend the root url else (do io . putStrLn $ "rel:" ++ l pure $ '/' : (base l) -- TODO ) -- | Get a mount point of the page into the correct location. pageFilename :: FilePath -> Site FilePath -pageFilename p = indexFilename $ "page" p +pageFilename = indexFilename --- | Like `Mu.substitute` but writes and throws stuff on errors +-- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors checkedSubstitute :: Mu.Template -> Y.Value -> IO T.Text checkedSubstitute t v = do let (es, txt) = Mu.checkedSubstitute t v @@ -183,7 +187,7 @@ dataFilename :: String -> FilePath -> Site (FilePath, FilePath) dataFilename hash basename = do od <- use outputDir let (h1, h2) = splitAt 3 hash - loc = "data" h1 h2 basename + loc = "files" h1 h2 basename pure (od loc, loc) -- | Copy a source file to the destination, making the necessary directories in the process. @@ -247,31 +251,67 @@ invTags x = tagFilename :: FilePath -> Site FilePath tagFilename tag = indexFilename $ "tag" tag +-- | Fold the hierarchical tag bits to a slashed path. +tagPath :: [String] -> FilePath +tagPath = foldr () "" + +-- | Make a link to the tag page +tagLink :: [String] -> Site FilePath +tagLink = rootUrl . ("tag" ) . tagPath + +-- | Make metadata for printing out a single hierarchical tag (all levels clickable) +makeHTagMeta :: [String] -> Site Y.Value +makeHTagMeta tag = do + links <- zip (Y.Null:map fromString tag) . map fromString <$> traverse tagLink (inits tag) + pure . Y.array $ + map + (\(t, p) -> Y.object [("tag", t), ("href", p)]) + links + +-- | Make metadata for printing out a single tag as-is, without levels +makeHTagLinkMeta :: [String] -> Site Y.Value +makeHTagLinkMeta tag = do + link <- tagLink tag + pure $ + Y.object [("href", fromString link), ("tags", Y.array $ map fromString tag)] + +makePageLinkMeta :: FilePath -> Site Y.Value +makePageLinkMeta mount = do + link <- rootUrl mount + meta <- use $ pages . to (M.! mount) . pageMeta + pure $ Y.object [("href", fromString link), ("meta", meta)] + +-- | Create the complete metadata structure for the template that renders a given tag page +makeTagMeta :: [String] -> Site Y.Value +makeTagMeta tag = do + taggedPages <- use $ htags . to (M.! tag) + subtags <- + gets + (^.. htags . to M.keys . each . filtered (not . null) . + filtered ((== tag) . init)) + htagMeta <- makeHTagMeta tag + subtagsMeta <- Y.array <$> traverse makeHTagLinkMeta subtags + pagesMeta <- Y.array <$> traverse makePageLinkMeta taggedPages + pure $ + Y.object + [("htag", htagMeta), ("subtags", subtagsMeta), ("pages", pagesMeta)] + -- | Render a site for a given tag string. -renderTag :: [String] -> [FilePath] -> Site () -renderTag tag pages = do +renderTag :: [String] -> Site () +renderTag tag = do tname <- use tagTemplate templ <- use $ templates . to (M.! fromString tname) - let tagpath = foldr () mempty tag - file <- tagFilename tagpath + file <- tagFilename (tagPath tag) checkTarget file + meta <- makeTagMeta tag io $ do putStrLn $ "# -> " ++ file makeDirectories file - let str = fromString - arr = Y.array - meta = - Y.Object $ - KM.fromList - [ ("tagpath", str tagpath) - , ("tag", arr $ map str tag) - , ("pages", arr $ map str pages) - ] checkedSubstitute templ meta >>= TIO.writeFile file -- | Render all tag sites. renderTags :: Site () -renderTags = use (htags . to M.assocs) >>= traverse_ (uncurry renderTag) +renderTags = use (htags . to M.keys) >>= traverse_ renderTag -- | Build the whole site. main = diff --git a/templates/head.html b/templates/head.html index 1bc1509..c267616 100644 --- a/templates/head.html +++ b/templates/head.html @@ -1 +1,9 @@ -{{title}} + + + + {{?title}}{{title}}{{/title}} + {{?htag}} + All cards {{#htag}} » {{tag}}{{/htag}} + {{/htag}} + + diff --git a/templates/tag.html b/templates/tag.html index c706469..ccb3e84 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -2,12 +2,32 @@ {{> head.html}} -

{{?tag}}Tag: {{tagpath}}{{/tag}}{{^tag}}All pages{{/tag}}

-Path: (root){{#tag}} / #{{.}}{{/tag}} -