diff --git a/Types.hs b/Types.hs index 72f81c7..12088b6 100644 --- a/Types.hs +++ b/Types.hs @@ -43,6 +43,7 @@ data SiteState = , _assetDir :: FilePath -- ^ Directory for output , _defaultTemplate :: FilePath -- ^ Name of the default template , _redirectTemplate :: FilePath -- ^ Name of the template for redirect pages + , _tagTemplate :: FilePath -- ^ Name of the template for tag listing pages } deriving (Show) @@ -61,6 +62,7 @@ emptySiteState = , _assetDir = "assets" , _defaultTemplate = "default.html" , _redirectTemplate = "redirect.html" + , _tagTemplate = "tag.html" } -- | Monad for running the site generator. diff --git a/Utils.hs b/Utils.hs index f95351e..c220cb7 100644 --- a/Utils.hs +++ b/Utils.hs @@ -26,7 +26,7 @@ hasSuffix s = isJust . stripSuffix s second :: (a -> b) -> (c, a) -> (c, b) second f (a, b) = (a, f b) --- | A pandoc walker for printing the URLs. +-- | A pandoc walker for modifying the URLs. walkURLs :: (FilePath -> Site FilePath) -> Text.Pandoc.Definition.Pandoc -> Site Text.Pandoc.Definition.Pandoc walkURLs f = Text.Pandoc.Walk.walkM go where diff --git a/site.hs b/site.hs index 3e822f7..31ac7ec 100644 --- a/site.hs +++ b/site.hs @@ -22,7 +22,13 @@ import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories) import Lens.Micro import Lens.Micro.Aeson import Lens.Micro.Mtl -import System.FilePath ((), splitDirectories, splitPath, takeFileName, isAbsolute) +import System.FilePath + ( () + , isAbsolute + , splitDirectories + , splitPath + , takeFileName + ) import qualified Text.Mustache as Mu import Text.Pandoc.Class (runIOorExplode) import Text.Pandoc.Readers.Markdown (readMarkdown) @@ -72,7 +78,9 @@ pageTemplate pi = do pageTemplates :: Site [FilePath] pageTemplates = do rt <- use redirectTemplate - nub . (rt :) <$> (gets (^.. pages . traverse) >>= traverse pageTemplate) + tt <- use tagTemplate + nub . ([rt, tt] ++) <$> + (gets (^.. pages . traverse) >>= traverse pageTemplate) compileTemplate :: FilePath @@ -109,21 +117,28 @@ checkTarget fp = do -- | Process a single link pointing out from a page. processLink :: FilePath -> String -> Site String processLink base l = do - io $ putStrLn l if isAbsolute l - then - pure l - else (do - io $ putStrLn "rel" - pure $ '/':(basel)) -- TODO + then pure l + 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 + +checkedSubstitute t v = do + let (es, txt) = Mu.checkedSubstitute t v + io $ traverse_ (putStrLn . ("Error: " ++) . show) es + --null es `unless` error "template substitution problems" + pure txt -- | Render a page using the current template. installPage :: FilePath -> PageInfo -> Site () -installPage mount pi - = do +installPage mount pi = do tname <- pageTemplate pi templ <- use $ templates . to (M.! fromString tname) - file <- indexFilename mount + file <- pageFilename mount fixedUrlDoc <- walkURLs (processLink mount) $ pi ^. pageDoc checkTarget file io $ do @@ -132,7 +147,7 @@ installPage mount pi body <- runIOorExplode $ writeHtml5String htmlWriteOpts fixedUrlDoc let Y.Object meta' = pi ^. pageMeta meta = Y.Object $ KM.insert "body" (Y.String body) meta' - TIO.writeFile file $ Mu.substitute templ meta + checkedSubstitute templ meta >>= TIO.writeFile file installPageRedirects mount pi {- | Install a simple redirect handler page. -} @@ -145,8 +160,8 @@ installRedirect target from = do io $ do putStrLn $ "@ -> " ++ file ++ " -> " ++ target makeDirectories file - TIO.writeFile file . Mu.substitute templ $ - Y.object [("target", Y.String $ T.pack target)] + txt <- checkedSubstitute templ $ Y.object [("target", Y.String $ T.pack target)] + TIO.writeFile file txt -- | Install all redirects required by one page. installPageRedirects :: FilePath -> PageInfo -> Site () @@ -203,6 +218,7 @@ installAssets = use assetDir >>= (io . getRecursiveContents (pure . const False) >=> traverse_ installAsset) +-- | Get all tags from the pages of the site. sourceTags :: Site () sourceTags = do sgat <- @@ -217,13 +233,35 @@ invTags :: [(FilePath, [[String]])] -> [([String], [FilePath])] invTags x = map (fmap nub) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht] +-- | Get the destination for the tag page. +tagFilename :: FilePath -> Site FilePath +tagFilename tag = indexFilename $ "tag" tag + -- | Render a site for a given tag string. -renderTag :: [String] -> Site () -renderTag = undefined +renderTag :: [String] -> [FilePath] -> Site () +renderTag tag pages = do + tname <- use tagTemplate + templ <- use $ templates . to (M.! fromString tname) + let tagpath = foldr () mempty tag + file <- tagFilename tagpath + checkTarget file + 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 = undefined +renderTags = use (htags . to M.assocs) >>= traverse_ (uncurry renderTag) -- | Build the whole site. main = @@ -233,6 +271,9 @@ main = sourceTags sourceTemplates "templates" use pages >>= traverse (uncurry installPage) . M.assocs + renderTags + -- testing part begin installFile "external/mypage/img/awesome.png" + -- testing part end io $ putStrLn "OK" get >>= io . print diff --git a/templates/page.html b/templates/page.html deleted file mode 100644 index 38b50ce..0000000 --- a/templates/page.html +++ /dev/null @@ -1,3 +0,0 @@ -
- $body$ -
diff --git a/templates/tag.html b/templates/tag.html index 6f329cd..c706469 100644 --- a/templates/tag.html +++ b/templates/tag.html @@ -1,14 +1,13 @@ -
-

Tag

- -

Pages

- -
+ + +{{> head.html}} + +

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

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