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 $ '/':(base>l)) -- 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 @@
-Tag
-
- $for(htags)$
-
- Pages
-
- $for(pages)$
-
-