Fix backlinks.

3 files changed, 25 insertions, 11 deletions

diff --git a/hs/src/Html.hs b/hs/src/Html.hs
index 2decb24..d856dcd 100644
--- a/hs/src/Html.hs
+++ b/hs/src/Html.hs
@@ -49,6 +49,7 @@ import System.Environment.XDG.BaseDir
   , getSystemDataDirs
   )
 
+import Text.Blaze (stringValue)
 import Text.Blaze.Html5 (Html, toHtml, (!), textValue, docTypeHtml)
 import qualified Text.Blaze.Html5 as H
 import Text.Blaze.Html5.Attributes (href, role, rel, content, name, charset)
@@ -241,6 +242,10 @@ headerContent :: Block -> Maybe PandocStr
 headerContent (Header _ _ inlines) = Just $ stringify inlines
 headerContent _ = Nothing
 
+buildLink :: String -> String -> Html
+buildLink disp url = H.a ! A.href (stringValue url)
+                         $ toHtml disp
+
 
 handlePart :: Configuration -> FilePath -> Map Text (Set FilePath) -> FilePath -> [FilePath] -> PandocIO ()
 handlePart conf outdir backlinks wiki_root parts = do
@@ -255,9 +260,13 @@ handlePart conf outdir backlinks wiki_root parts = do
 
     text <- liftIO $ T.readFile inTarget
 
-    bl <- case M.lookup (pack . dropExtension $ item_path) backlinks of
+    bl <- case M.lookup (pack . ("/" <>) . dropExtension $ item_path) backlinks of
       Just links -> return $ (H.h2 . H.string  $ "Backlinks")
-                             <> (H.ul . mconcat $ H.li . toHtml <$> S.toList links)
+                             <> (H.ul ! A.class_ "backlinks"
+                                      $ mconcat $ H.li
+                                                . uncurry buildLink
+                                                . fmap ((<> ".html") . ((conf^.output.webPath) <>) )
+                                                . dup <$> S.toList links)
       Nothing -> return $ H.b "No backlinks"
 
     pandoc <- handleSourceText conf text
@@ -365,12 +374,8 @@ main = do
     let relative_paths = tail . snd <$> wikiFiles
     forwardLinks <- runIOorExplode $ mapM (findLinks $ conf ^. data' . inputDir) 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
-
     runIOorExplode $ do
         mlang <- toLang $ Just "sv-SE"
         mapM_ setTranslations mlang
diff --git a/hs/src/Links.hs b/hs/src/Links.hs
index ecef78b..c8f0222 100644
--- a/hs/src/Links.hs
+++ b/hs/src/Links.hs
@@ -16,11 +16,15 @@ import qualified Data.Map as M
 import Data.Set (Set)
 import qualified Data.Set as S
 
-import Data.Text (Text)
+import Data.Text (Text, pack, unpack)
 import Data.Text.Compat (PandocStr, conv, from)
 import qualified Data.Text.IO as T
 
-import System.FilePath (joinPath, (</>))
+import System.FilePath
+    ( joinPath
+    , dropExtension
+    , takeDirectory
+    , (</>))
 
 import Text.Pandoc (PandocIO, readVimwiki)
 import Text.Pandoc.Definition (Pandoc, Inline (Link))
@@ -28,10 +32,10 @@ import Text.Pandoc.Walk (query)
 
 
 -- Find all wikilinks in the given document
-extractLinks :: Pandoc -> [PandocStr]
+extractLinks :: Pandoc -> [Text]
 extractLinks = query extractLink
   where extractLink :: Inline -> [PandocStr]
-        extractLink (Link _ _ (target, "wikilink")) = [conv target]
+        extractLink (Link _ _ (target, "wikilink")) = [from . conv $ target]
         extractLink _ = []
 
 
@@ -43,7 +47,11 @@ findLinks wiki_root parts = do
 
     pandoc <- readVimwiki def text
 
-    return (item_path, from <$> extractLinks pandoc)
+    let links = extractLinks pandoc
+    -- TODO item paths with .. in them
+    let absolute_links = pack . ((takeDirectory $ "/" <> item_path) </>) . unpack <$> links
+
+    return ("/" <> dropExtension item_path, absolute_links)
 
     -- let htmlString = toStrict . renderHtml $ html
     -- liftIO $ T.writeFile outTarget htmlString
diff --git a/hs/vimwiki.cabal b/hs/vimwiki.cabal
index 11f8eb7..1d6ebc3 100644
--- a/hs/vimwiki.cabal
+++ b/hs/vimwiki.cabal
@@ -39,6 +39,7 @@ executable Main
   build-depends:
     base                 >= 4.8,
     blaze-html           >= 0.9,
+    blaze-markup         >= 0.8.2.7,
     containers           >= 0.5,
     data-default         >= 0.7,
     directory            >= 1.3.6,