diff --git a/external/mypage/text.md b/external/mypage/text.md new file mode 100644 index 0000000..14b321c --- /dev/null +++ b/external/mypage/text.md @@ -0,0 +1,23 @@ +--- +title: My Page +mount: ext/mypage +redirects: + - mypage + - old:mypage +tags: + - yyy + - topic1/xxx +--- + +# My Page + +something something + +``` +this that +``` + +## Something else + +more nonsense +haha diff --git a/pagedeploy.cabal b/pagedeploy.cabal index 50b861f..3417a34 100644 --- a/pagedeploy.cabal +++ b/pagedeploy.cabal @@ -8,5 +8,6 @@ executable site build-depends: base == 4.* , hakyll == 4.16.* , filepath + , extra ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 diff --git a/site.hs b/site.hs index 3d77430..174f229 100644 --- a/site.hs +++ b/site.hs @@ -2,29 +2,30 @@ import Hakyll -import Control.Monad ((>=>)) +import Control.Monad ((>=>), when) import Data.Foldable (traverse_) +import Data.List (inits, nub) +import Data.List.Extra (groupSort) import Data.Maybe (fromMaybe) -import System.FilePath ((), dropTrailingPathSeparator, normalise) +import System.FilePath + ( () + , dropTrailingPathSeparator + , joinPath + , normalise + , splitDirectories + ) import Debug.Trace +getMount' :: a -> (String -> a) -> Metadata -> a +getMount' a b = maybe a b . lookupString "mount" + getMount :: Metadata -> Routes -getMount = maybe idRoute constRoute . lookupString "mount" +getMount = getMount' idRoute constRoute indexInDir :: Routes -> Routes indexInDir = flip composeRoutes . customRoute $ ( "index.html") . toFilePath -extractRedirs :: Identifier -> Rules (Identifier, [Identifier]) -extractRedirs ident = do - md <- getMetadata ident - let to = fromMaybe ident $ fromFilePath <$> lookupString "mount" md - froms = - fromMaybe [] $ - map (fromFilePath . dropTrailingPathSeparator . normalise) <$> - lookupStringList "redirects" md - pure (to, froms) - makePage :: Rules () makePage = do route $ indexInDir (metadataRoute getMount) @@ -33,6 +34,16 @@ makePage = do loadAndApplyTemplate "templates/default.html" pageCtx >>= relativizeUrls +extractRedirs :: Identifier -> Rules (Identifier, [Identifier]) +extractRedirs ident = do + md <- getMetadata ident + let to = getMount' ident fromFilePath md + froms = + fromMaybe [] $ + map (fromFilePath . dropTrailingPathSeparator . normalise) <$> + lookupStringList "redirects" md + pure (to, froms) + makeRedirects :: Identifier -> [Identifier] -> Rules () makeRedirects to froms = create froms $ do @@ -42,6 +53,36 @@ makeRedirects to froms = spawnRedirects :: [Identifier] -> Rules () spawnRedirects = traverse_ (extractRedirs >=> uncurry makeRedirects) +extractHTagLinks :: Identifier -> Rules (Identifier, [[String]]) +extractHTagLinks ident = do + md <- getMetadata ident + let to = getMount' ident fromFilePath md + htags = maybe [] (map splitDirectories) $ lookupStringList "tags" md + when (null htags) . fail $ "Uncategorized: " ++ show ident + pure (to, htags) + +invTags :: [(Identifier, [[String]])] -> [([String], [String])] +invTags x = map (fmap (map ('/':) . nub . map toFilePath)) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht] + +makeTag :: [FilePath] -> [String] -> Rules () +makeTag htag pages = + create [fromFilePath $ joinPath ("tags" : htag)] $ do + route (indexInDir idRoute) + compile $ do + let ctx = + mconcat + [ constField "title" ("Pages tagged " ++ joinPath htag) + , listField "htags" (field "htag" (return . itemBody)) (traverse makeItem htag) + , listField "pages" (field "page" (return . itemBody)) (traverse makeItem pages) + , defaultContext + ] + makeItem "" >>= loadAndApplyTemplate "templates/tag.html" ctx >>= + loadAndApplyTemplate "templates/default.html" ctx >>= + relativizeUrls + +spawnTags = + traverse extractHTagLinks >=> pure . invTags >=> traverse_ (uncurry makeTag) + main :: IO () main = hakyll $ @@ -50,6 +91,8 @@ main = match "external/**/*.md" makePage {- Source and process the redirects -} getMatches "external/**/*.md" >>= spawnRedirects + {- Source and process the tags -} + getMatches "external/**/*.md" >>= spawnTags {- Compile the templates (no routing, cache-only) -} match "templates/*" $ compile templateBodyCompiler diff --git a/templates/default.html b/templates/default.html new file mode 100644 index 0000000..52c4b44 --- /dev/null +++ b/templates/default.html @@ -0,0 +1,12 @@ + + + + + + My Stuffs - $title$ + + +

$title$

+ $body$ + + diff --git a/templates/page.html b/templates/page.html new file mode 100644 index 0000000..38b50ce --- /dev/null +++ b/templates/page.html @@ -0,0 +1,3 @@ +
+ $body$ +
diff --git a/templates/tag.html b/templates/tag.html new file mode 100644 index 0000000..6f329cd --- /dev/null +++ b/templates/tag.html @@ -0,0 +1,14 @@ +
+

Tag

+ +

Pages

+ +