Made code configurable.

1 files changed, 40 insertions, 35 deletions

diff --git a/hs/Html.hs b/hs/Html.hs
index 68eee37..a28efa5 100644
--- a/hs/Html.hs
+++ b/hs/Html.hs
@@ -115,17 +115,17 @@ data Configuration = Configuration
     , outputDir :: FilePath
     -- Are we in a subdirectory from the web root?
     -- /tmp/wiki
-    , webPath :: String
+    , webPath :: Text
     -- http://localhost:8090/
-    , mu4eURL :: String
+    , mu4eURL :: Text
     -- http://wiki.gandalf.adrift.space/search
-    , xapianOmega :: String
+    , xapianOmega :: Text
     }
 
 type UrlRewriter = [Inline] -> URI -> ([Inline], Text)
 
-mailRewriter :: UrlRewriter
-mailRewriter body uri = (body, pack $ "http://localhost:8090/" <> "?id=" <> (uriPath uri))
+mailRewriter :: Configuration -> UrlRewriter
+mailRewriter conf body uri = (body, (mu4eURL conf) <> "?id=" <> (pack $ uriPath uri))
 
 -- Comparison of online man pages:
 -- https://gist.github.com/rixx/6cb5fa38f694009ad0bd50c275bb61f2
@@ -149,10 +149,10 @@ manRewriter _ uri
           section'  = pack . tail <$> nullToMaybe (uriFragment uri)
           language' = pack . tail <$> nullToMaybe (uriQuery uri)
 
-urlRewrites :: M.Map String UrlRewriter
-urlRewrites = M.fromList [ ("mail", mailRewriter)
-                         , ("man", manRewriter)
-                         ]
+urlRewrites :: Configuration -> M.Map String UrlRewriter
+urlRewrites conf = M.fromList [ ("mail", mailRewriter conf)
+                              , ("man", manRewriter)
+                              ]
 
 
 -- -- TODO don't do this for inter-page links
@@ -162,10 +162,10 @@ fixExtension url
     | hasExtension url = url
     | otherwise = url <.> "html"
 
-rebuildLinks :: Inline -> Inline
-rebuildLinks l@(Link attributes body (url, title@"wikilink"))
+rebuildLinks :: Configuration -> Inline -> Inline
+rebuildLinks conf l@(Link attributes body (url, title@"wikilink"))
     = case parseURI . unpack $ url of
-        Just uri -> case M.lookup (init . uriScheme $ uri) urlRewrites of
+        Just uri -> case M.lookup (init . uriScheme $ uri) (urlRewrites conf) of
                         Just proc -> (proc body uri) & (\(body, url) -> Link attributes body (url, title))
                         Nothing   -> l -- Link attributes body (url <> ".html", title)
         Nothing -> case break (== '#') (unpack url) of
@@ -173,7 +173,7 @@ rebuildLinks l@(Link attributes body (url, title@"wikilink"))
                 (page, "")        -> Link attributes body (pack $ fixExtension page, title)
                 (page, '#':local) -> Link attributes body (pack $ fixExtension page <> "#" <> local, title)
                 _                 -> l
-rebuildLinks l = l
+rebuildLinks _ l = l
 
 -- Link ("",[],[]) [Str "#M\246te 7"] ("#M\246te 7","wikilink")
 -- Link ("",[],[]) [Str "https://styrdokument.liu.se/Regelsamling/Fil/1513619"] ("https://styrdokument.liu.se/Regelsamling/Fil/1513619","")
@@ -196,14 +196,14 @@ buildCheckboxes' (Plain (Str "[-]" : Space : xs))
     = Plain [ checkbox "checked", Strikeout xs ]
 buildCheckboxes' l = l
 
-applyFilters :: Pandoc -> Pandoc
-applyFilters pandoc = pandoc
-                    & walk rebuildLinks
-                    & walk buildCheckboxes
-                    & walk buildCheckboxes'
+applyFilters :: Configuration -> Pandoc -> Pandoc
+applyFilters conf pandoc = pandoc
+                         & walk (rebuildLinks conf)
+                         & walk buildCheckboxes
+                         & walk buildCheckboxes'
 
-handleSourceText :: PandocMonad m => Text -> m Pandoc
-handleSourceText text = do
+handleSourceText :: PandocMonad m => Configuration -> Text -> m Pandoc
+handleSourceText conf text = do
     pandoc <- readVimwiki def text
 
     --runIO $ print . show $ pandoc
@@ -217,7 +217,7 @@ handleSourceText text = do
     let pandoc = Pandoc meta blocks
 
     let pandoc' = pandoc
-                & applyFilters
+                & (applyFilters conf)
                 -- & setTitle (str "Some form of title")
                 -- & setAuthors [ str "Hugo Hörnquist" ]
                 -- & setDate (str "2022-01-26")
@@ -237,8 +237,8 @@ handleSourceText text = do
 -- Text.Pandoc.Shared (schemes)
 -- Link (_,_,_) _ (_, "wikilink")
 
-breadcrumbLinks :: [FilePath] -> [String]
-breadcrumbLinks parts = f <$> (accumulate $ "/tmp/wiki" : parts)
+breadcrumbLinks :: Configuration -> [FilePath] -> [String]
+breadcrumbLinks conf parts = f <$> (accumulate $ (unpack $ webPath conf) : parts)
     where f parts = joinBy "/" parts -<.> "html"
 
 buildBreadcrumbs :: [String] -> [Html]
@@ -249,26 +249,27 @@ buildBreadcrumbs links = f <$> links
                         $ H.string (takeBaseName link)
 
 
-htmlWrap :: String -> [FilePath] -> Html -> Html -> Html -> Html
-htmlWrap title parts backlinks toc main = docTypeHtml $ do
+htmlWrap :: Configuration -> String -> [FilePath] -> Html -> Html -> Html -> Html
+htmlWrap conf title parts backlinks toc main = docTypeHtml $ do
   H.head $ do
     H.meta ! charset "utf-8"
     H.meta ! name "generator" ! content "pandoc"
     H.meta ! name "viewport" ! content "width=device-width, initial-scale=1.0, user-scalable=yes"
-    H.link ! rel "stylesheet" ! (href $ "/tmp/wiki" <> "/style.css")
+    H.link ! rel "stylesheet" ! (href . textValue $ webPath conf <> "/style.css")
     H.title $ H.string $ title <> " — Vimwiki"
   H.body $ do
     H.header $ do
         H.nav ! A.id "breadcrumb" $ do
-            let bc = (buildBreadcrumbs . breadcrumbLinks $ init parts)
+            let bc = (buildBreadcrumbs . breadcrumbLinks conf $ init parts)
             -- TODO replace /tmp/wiki with wiki-base
-            let all = mconcat [ [ H.a ! href ("/tmp/wiki" <> "/index.html") $ "⌂" ]
+            let all = mconcat [ [ H.a ! (href . textValue $ webPath conf <> "/index.html") 
+                                      $ "⌂" ]
                               , tail bc
                               , [ H.span $ H.string . takeBaseName . last $ parts ] ]
             mconcat $ intersperse (H.string "»") all
         H.nav ! A.id "search" $ do
             H.form ! A.method "GET"
-                   ! A.action "http://xapian.gandalf.adrift.space" 
+                   ! A.action (textValue . xapianOmega $ conf)
                    $ do
                      H.input ! A.type_ "search" ! A.name "P" ! A.placeholder "Sök..."
                      H.input ! A.type_ "submit" ! A.value "Sök"
@@ -293,8 +294,8 @@ headerContent _ = Nothing
 
 
 
-handlePart :: FilePath -> M.Map Text (Set FilePath) -> FilePath -> [FilePath] -> PandocIO ()
-handlePart outdir backlinks wiki_root parts = do
+handlePart :: Configuration -> FilePath -> M.Map Text (Set FilePath) -> FilePath -> [FilePath] -> PandocIO ()
+handlePart conf outdir backlinks wiki_root parts = do
     let item_path = joinPath parts
     let inTarget  = wiki_root   </> item_path
     let outTarget = outdir </> item_path -<.> "html"
@@ -307,7 +308,7 @@ handlePart outdir backlinks wiki_root parts = do
                              <> (H.ul . mconcat $ (H.li . toHtml) <$> (S.toList links))
       Nothing -> return $ H.b "No backlinks"
 
-    pandoc <- handleSourceText text
+    pandoc <- handleSourceText conf text
     let Pandoc meta blocks = pandoc
     toc <- writeHtml5 def $ Pandoc meta $ [toTableOfContents def blocks]
     -- writeHtml5 htmlAttr pandoc
@@ -323,7 +324,7 @@ handlePart outdir backlinks wiki_root parts = do
                           ]
 
     -- liftIO $ print log
-    let htmlString = toStrict . renderHtml . htmlWrap (unpack title) parts bl toc $ html
+    let htmlString = toStrict . renderHtml . htmlWrap conf (unpack title) parts bl toc $ html
     liftIO $ T.writeFile outTarget htmlString
 
 
@@ -343,7 +344,8 @@ main = do
 
     let conf = Configuration { inputDir = indir
                              , outputDir = outdir
-                             , webPath = "/tmp/wiki"
+                             -- , webPath = "/tmp/wiki"
+                             , webPath = ""
                              , mu4eURL = "http://localhost:8090"
                              , xapianOmega = "http://wiki.gandalf.adrift.space/search"
                              }
@@ -351,6 +353,9 @@ main = do
     -- What each page links to
     -- forwardLinks :: [(FilePath, [String])]
     forwardLinks <- runIOorExplode $ mapM (findLinks indir) relative_paths
+    -- TODO backlinks should look at basename of filename, for both
+    -- link and target.
+    -- http://wiki.gandalf.adrift.space/Lysator/Styrelse/wi_1233359070.html
     let backlinks = M.unions $ uncurry buildBacklinkSet <$> forwardLinks
 
     --print backlinks
@@ -361,5 +366,5 @@ main = do
             Nothing -> return ()
             Just l -> setTranslations l
 
-        mapM_ (handlePart outdir backlinks indir) relative_paths
+        mapM_ (handlePart conf outdir backlinks indir) relative_paths
     -- mapM_ (putStrLn . show) wiki_files