diff options
| author | Thomas Ulmer <thomasmulmer02@gmail.com> | 2026-06-03 16:36:21 -0700 |
|---|---|---|
| committer | Thomas Ulmer <thomasmulmer02@gmail.com> | 2026-06-03 16:36:21 -0700 |
| commit | b4c02352143c05fdbe35629bed63f6ad32cbd313 (patch) | |
| tree | 47b321624625ab348b218377d84a91f27f98c7d5 | |
| parent | 1ed4e153285f84b97ac959b3c353049a6dcf0e33 (diff) | |
| -rw-r--r-- | README.md | 7 | ||||
| -rw-r--r-- | src/Main.hs | 74 |
2 files changed, 30 insertions, 51 deletions
@@ -24,7 +24,7 @@ testbak/ ``` where `.frag` and `.html` are equivalent, and invoke loom: ``` -loom -r {root path} -o {output path} [-s {static path}] +loom -r {root path} -o {output path} -e {header template} -f {footer template} [-s {static path}] ``` Each fragment will generate a html page in the output directory in the same structure. The generated page will be composed of a header and footer with the text of the fragment placed in `<main>`. The header also conatins the title of the page, which can be specified by placing a line @@ -33,7 +33,9 @@ Each fragment will generate a html page in the output directory in the same stru ``` on the first line of the fragment file. The title cannot contain newlines or the vertical bar character. If unspecified it will default to the basename of the fragment file. -The header will also include a `<nav>` which produces a tree featuring the spine from the current page to the root, all descendants of the current page, and any sibling or sibling of an ancestor of the current page. The tree is sorted by file name, should you wish for the tree order and page title to differ. +The footer should be a simple html file concatenated to all pages. The header is a template where the string "%t" is replaced by the page title and "%n" by the nav bar contents (not including the nav tag itself). + +The generated `<nav>` produces a tree featuring the spine from the current page to the root, all descendants of the current page, and any sibling or sibling of an ancestor of the current page. The tree is sorted by file name, should you wish for the tree order and page title to differ. A static path, if specified, is simply recursively copied into the output directory after generation occurs. @@ -43,6 +45,5 @@ A static path, if specified, is simply recursively copied into the output direct - Requires a functional Haskell ecosystem ## Remaining work -- Support for header and footer as args/files like node. Mostly a matter of picking a placeholder token for the title and nav in the header - Better error messages - More safety checks. Particularly checking that every generated link is either an absolute path to an extant file or is a proper link out with https and all. diff --git a/src/Main.hs b/src/Main.hs index 2e80a6a..3499403 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -25,40 +25,6 @@ prettyName :: FilePath -> String {- XXX more -} prettyName f = takeBaseName $ dropExtension f -header :: T.Text -> T.Text -> T.Text -header title nav = T.unlines - [ T.pack "<!DOCTYPE html>" - , T.pack "<html>" - , T.pack " <head>" - , T.pack " <meta charset='UTF-8' />" - , T.concat [T.pack " <title>" , title , T.pack "</title>" ] - , T.pack " <link rel=\"stylesheet\" href=\"/css/style.css\" />" - , T.pack " <link rel=\"icon\" href=\"/favicon.ico\" type=\"image/x-icon\"/>" - , T.pack " </head>" - , T.pack " <body>" - , T.pack " <div class=\"stuck\">" - , T.pack " <header>" - , T.pack " <p>" - , T.pack " Professional Webring >>" - , T.pack " <a href=\"https://roscoeeh.github.io\">Prev - Roscoe</a>" - , T.pack " |" - , T.pack " <a href=\"https://elle-wen.github.io\">Next - Elle</a>" - , T.pack " </p>" - , T.pack " </header>" - , T.concat [ T.pack "<nav>" , nav , T.pack "</nav>" ] - , T.pack " </div>" - , T.pack " <main>" - ] - -footer :: T.Text -footer = T.pack $ unlines - [ "</main>" - , "<footer>" - , "</footer>" - , "</body>" - , "</html>" - ] - parse :: FilePath -> IO (T.Text, T.Text) {- XXX use T.hGetLine to try to delay the memory cost. @@ -149,13 +115,13 @@ fallbackIndexNav p ns = NavFile (fallbackIndexFrag p ns) (T.pack . takeFileName fallbackIndexFrag :: FilePath -> [Nav] -> T.Text fallbackIndexFrag _ _ = (T.pack "<p>Fallback index.</p>") -generate :: T.Text -> Nav -> T.Text +generate :: (T.Text -> T.Text -> T.Text, T.Text) -> T.Text -> Nav -> T.Text {- Generate the full text of a page. -} -generate nav (NavFile f t _) = +generate (header, footer) nav (NavFile f t _) = T.concat [ header t nav , f , footer ] -generate nav (NavDir _ (NavFile f t _) _) = +generate (header, footer) nav (NavDir _ (NavFile f t _) _) = T.concat [ header t nav , f , footer ] -generate _ _ = error "malformed NavDir" +generate _ _ _ = error "malformed NavDir" mkNavItem :: Nav -> T.Text {- Generate a listing for a file or a listing for a dir and optionally @@ -169,11 +135,11 @@ mkNavItem (NavFile _ t p) = ] mkNavItem (NavDir _ idxf _) = mkNavItem idxf -emit :: FilePath -> T.Text -> Nav -> T.Text -> IO () -emit outdir nav1 f@(NavFile _ _ p) nav2 = do - let contents = generate (T.append nav1 nav2) f +emit :: (T.Text -> T.Text -> T.Text, T.Text) -> FilePath -> T.Text -> Nav -> T.Text -> IO () +emit hf outdir nav1 f@(NavFile _ _ p) nav2 = do + let contents = generate hf (T.append nav1 nav2) f T.writeFile (outdir </> p -<.> "html") contents -emit outdir nav1 (NavDir cs i dp) nav2 = do +emit hf outdir nav1 (NavDir cs i dp) nav2 = do let newdir = outdir </> dp exists <- doesDirectoryExist newdir unless exists $ createDirectory newdir @@ -185,13 +151,13 @@ emit outdir nav1 (NavDir cs i dp) nav2 = do let posts = tails ncs let nbefore = map (\x -> T.append sharedBefore (T.concat x)) priors let nafter = map (\x -> T.append (T.concat x) sharedAfter ) posts - let actions = zipWith3 (emit outdir) (tail nbefore) cs (tail nafter) + let actions = zipWith3 (emit hf outdir) (tail nbefore) cs (tail nafter) _ <- sequence actions - emit outdir (head nbefore) i (head nafter) + emit hf outdir (head nbefore) i (head nafter) main :: IO () main = do - flags@(Flags r o s) <- canonicalizeFlags <$> handleArgs + flags@(Flags r o h f s) <- canonicalizeFlags <$> handleArgs unless (valid r r) $ die $ "R isn't valid. Maybe not absolute? " ++ r unless (isAbsolute o) $ @@ -200,17 +166,22 @@ main = do tree <- convert r r hPutStr stderr $ "\nFound tree:\n" ++ show tree let rNav = T.append (T.pack "<ul>") (mkNavItem tree) - emit o rNav tree (T.pack "</ul>") + headerTemplate <- withFile h ReadMode T.hGetContents + let headerFunc title nav = T.replace (T.pack "%t") title $ T.replace (T.pack "%n") nav headerTemplate + footer <- withFile f ReadMode T.hGetContents + emit (headerFunc,footer) o rNav tree (T.pack "</ul>") when (isJust s) $ case isAbsolute $ fromJust s of True -> copyInto (fromJust s) o False -> die $ "S input not absolute " ++ (fromJust s) - where canonicalizeFlags (Flags r o s) = - Flags (normalise r) (normalise o) (normalise <$> s) + where canonicalizeFlags (Flags r o h f s) = + Flags (normalise r) (normalise o) (normalise h) (normalise f) (normalise <$> s) data Flags = Flags { root :: FilePath , output :: FilePath + , header :: FilePath + , footer :: FilePath , static :: Maybe FilePath } deriving (Show) @@ -222,12 +193,16 @@ handleArgs = do let missing = Flags { root = error "-r root is required" , output = error "-o output is required" + , header = error "-e header.html is required" + , footer = error "-f footer.html is required" , static = Nothing } helper missing args where helper f [] = pure f helper f ("-r":a:rest) = helper (f { root = a }) rest helper f ("-o":a:rest) = helper (f { output = a }) rest + helper f ("-e":a:rest) = helper (f { header = a }) rest + helper f ("-f":a:rest) = helper (f { footer = a }) rest helper f ("-s":a:rest) = helper (f { static = Just a }) rest helper _ ("-h":_) = die usage helper _ (x:_) = die $ "Unknown or orphan flag: " ++ x ++ "\n" ++ usage @@ -238,6 +213,9 @@ usage = unlines , "\tloom -r {root path} -o {output path} [-s {static path}]" , "\t-r supplies a root to pull fragments from" , "\t-o supplies the output directory to place html in" + , "\t-e supplies a html template for the header of each page" + , "\t\t%t is replaced with the title, and %n with the nav contents." + , "\t-f supplies a html template for the footer. " , "\t-s (optional) supplies a directory to be copied into the output after generation" , "all paths must be absolute." , "any fragment may be given a name by having the first line be in the following format:" |