Merge pull request #1813 from tarleb/file-links

Org reader: properly handle links to `file:target`

2 files changed, 26 insertions, 7 deletions

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 579e38a38..440b6d144 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -1142,20 +1142,25 @@ applyCustomLinkFormat link = do
     formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters
     return $ maybe link ($ drop 1 rest) formatter
 
+-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind
+-- of parsing.
 linkToInlinesF :: String -> Inlines -> F Inlines
 linkToInlinesF s =
   case s of
     ""      -> pure . B.link "" ""
     ('#':_) -> pure . B.link s ""
     _ | isImageFilename s     -> const . pure $ B.image s "" ""
+    _ | isFileLink s          -> pure . B.link (dropLinkType s) ""
     _ | isUri s               -> pure . B.link s ""
-    _ | isRelativeFilePath s  -> pure . B.link s ""
     _ | isAbsoluteFilePath s  -> pure . B.link ("file://" ++ s) ""
-    _ -> \title -> do
-           anchorB <- (s `elem`) <$> asksF orgStateAnchorIds
-           if anchorB
-             then pure $ B.link ('#':s) "" title
-             else pure $ B.emph title
+    _ | isRelativeFilePath s  -> pure . B.link s ""
+    _                         -> internalLink s
+
+isFileLink :: String -> Bool
+isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)
+
+dropLinkType :: String -> String
+dropLinkType = tail . snd . break (== ':')
 
 isRelativeFilePath :: String -> Bool
 isRelativeFilePath s = (("./" `isPrefixOf` s) || ("../" `isPrefixOf` s)) &&
@@ -1178,6 +1183,13 @@ isImageFilename filename =
    imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
    protocols = [ "file", "http", "https" ]
 
+internalLink :: String -> Inlines -> F Inlines
+internalLink link title = do
+  anchorB <- (link `elem`) <$> asksF orgStateAnchorIds
+  if anchorB
+    then return $ B.link ('#':link) "" title
+    else return $ B.emph title
+
 -- | Parse an anchor like @<<anchor-id>>@ and return an empty span with
 -- @anchor-id@ set as id.  Legal anchors in org-mode are defined through
 -- @org-target-regexp@, which is fairly liberal.  Since no link is created if
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index d1f673514..39c40cd45 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -4,7 +4,6 @@ module Tests.Readers.Org (tests) where
 import Text.Pandoc.Definition
 import Test.Framework
 import Tests.Helpers
-import Tests.Arbitrary()
 import Text.Pandoc.Builder
 import Text.Pandoc
 import Data.List (intersperse)
@@ -227,6 +226,14 @@ tests =
                          , "for", "fnords."
                          ])
 
+      , "Absolute file link" =:
+          "[[file:///etc/passwd][passwd]]" =?>
+          (para $ link "file:///etc/passwd" "" "passwd")
+
+      , "File link" =:
+          "[[file:target][title]]" =?>
+          (para $ link "target" "" "title")
+
       , "Anchor" =:
           "<<anchor>> Link here later." =?>
           (para $ spanWith ("anchor", [], []) mempty <>