Fix file: URI's containing weird characters.

2 files changed, 27 insertions, 10 deletions

diff --git a/hs/src/Html.hs b/hs/src/Html.hs
index bcc25b1..659db49 100644
--- a/hs/src/Html.hs
+++ b/hs/src/Html.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings
            , ScopedTypeVariables
+           , TupleSections
            , CPP
            #-}
 
@@ -16,6 +17,7 @@ import System.FilePath
     , hasExtension
     , dropExtension
     , takeBaseName
+    , isRelative
     )
 import Control.Lens (_2)
 import Control.Lens.Operators hiding ((<.>))
@@ -28,8 +30,8 @@ import Data.Default (def)
 import Data.List (partition)
 import qualified Data.Map as M
 import Data.Map (Map)
-import Data.Maybe (listToMaybe, fromMaybe, maybeToList)
-import Data.Set (Set)
+import Data.Maybe (listToMaybe, fromMaybe, mapMaybe)
+import Data.Set (Set, fromList)
 import qualified Data.Set as S
 import Data.Text (Text, pack)
 import qualified Data.Text.IO as T
@@ -37,6 +39,7 @@ import Data.Text.Lazy (toStrict)
 import Data.Text.Compat (PandocStr, conv, from)
 
 import Network.URI hiding (query)
+import Network.URI.Encode (encodeWith)
 
 import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist)
 import System.Environment.XDG.BaseDir
@@ -93,14 +96,23 @@ isWikiFile = isFiletype "wiki"
 mailRewriter :: String -> [Inline] -> URI -> ([Inline], PandocStr)
 mailRewriter mu4eURL body uri = (body, conv $ mu4eURL <> "?id=" <> uriPath uri)
 
-urlRewrites :: Configuration -> Map String ([Inline] -> URI -> ([Inline], PandocStr))
-urlRewrites conf = M.fromList $ maybeToList ((,) "mail" . mailRewriter <$> (conf ^. output . mu4eURL))
-                              -- TODO include descriptive text from
-                              -- original link
-                              ++ case (conf ^. output . manProvider) >>= flip M.lookup rewriters of
-                                    Just impl -> [("man", manRewriter impl)]
-                                    Nothing   -> []
+-- Pandoc converts local: uri's to file: uri's before we get to
+-- them. Assume that relative refs are internal references, and
+-- absolute references actual files.
+fileRewriter :: [Inline] -> URI -> ([Inline], PandocStr)
+fileRewriter inl uri = (inl,) . conv . show
+    $ if isRelative (uriPath uri)
+        then uri { uriScheme = "" }
+        else uri
 
+urlRewrites :: Configuration -> Map String ([Inline] -> URI -> ([Inline], PandocStr))
+urlRewrites conf = M.fromList $ mapMaybe sequence
+    [ ("mail",  mailRewriter <$> (conf ^. output . mu4eURL))
+    -- TODO include descriptive text from
+    -- original link
+    , ("man", manRewriter <$> ((conf ^. output . manProvider) >>= flip M.lookup rewriters))
+    , ("file", Just fileRewriter)
+    ]
 
 fixExtension url
     | hasExtension url = url
@@ -114,10 +126,14 @@ resolveInterwiki wikilinks wikiname uri =
         Nothing   -> error $ "Unknown Wiki name: " <> wikiname <> ""
 
 
+uriChars :: Set Char
+uriChars = fromList $ ":/?#"  -- Allows us to modifiy existing URL
+                    <> "-._~" -- URL safe
+                    <> ['A'..'Z'] <> ['a'..'z'] <> ['0'..'9']
 
 rebuildLinks :: Configuration -> Inline -> Inline
 rebuildLinks conf l@(Link attributes body (url, title@"wikilink"))
-    = case parseURI . from $ url of
+    = case parseURI . encodeWith (`elem` uriChars) . from $ url of
         Just uri -> case uriScheme uri of
                         ('w':'n':'.':wikiname') -> let wikiname = init wikiname'
                                                    in Link attributes
diff --git a/hs/vimwiki.cabal b/hs/vimwiki.cabal
index a4268b2..11f8eb7 100644
--- a/hs/vimwiki.cabal
+++ b/hs/vimwiki.cabal
@@ -51,5 +51,6 @@ executable Main
     pandoc-types         >= 1.22,
     text                 >= 1.2.2,
     unix                 >= 2.7.2,
+    uri-encode           >= 1.5.0,
     xdg-basedir          >= 0.2
   default-language:    Haskell2010