diff options
author | John MacFarlane <jgm@berkeley.edu> | 2014-11-05 14:48:53 -0800 |
---|---|---|
committer | John MacFarlane <jgm@berkeley.edu> | 2014-11-05 14:48:53 -0800 |
commit | 1cd65344b2c9fd1f905c52dc729ae17d03464322 (patch) | |
tree | 0f7514217a0192e5eae593cabfd3bc91e8471c1f | |
parent | f3ac41937d732c3ff31b4cce47578dc9afd8836c (diff) | |
parent | e6cd8c907788c083adea5e00def8918b11553f2b (diff) | |
download | pandoc-1cd65344b2c9fd1f905c52dc729ae17d03464322.tar.gz |
Merge pull request #1742 from tarleb/org-fix-links
Org fix links
-rw-r--r-- | src/Text/Pandoc/Readers/Org.hs | 39 | ||||
-rw-r--r-- | tests/Tests/Readers/Org.hs | 12 |
2 files changed, 36 insertions, 15 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 1ddfeab87..4c34b7bd5 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -1099,7 +1099,7 @@ linkOrImage = explicitOrImageLink explicitOrImageLink :: OrgParser (F Inlines) explicitOrImageLink = try $ do char '[' - srcF <- applyCustomLinkFormat =<< linkTarget + srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget title <- enclosedRaw (char '[') (char ']') title' <- parseFromString (mconcat <$> many inline) title char ']' @@ -1132,6 +1132,9 @@ selfTarget = try $ char '[' *> linkTarget <* char ']' linkTarget :: OrgParser String linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]") +possiblyEmptyLinkTarget :: OrgParser String +possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]") + applyCustomLinkFormat :: String -> OrgParser (F String) applyCustomLinkFormat link = do let (linkType, rest) = break (== ':') link @@ -1139,27 +1142,33 @@ applyCustomLinkFormat link = do formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters return $ maybe link ($ drop 1 rest) formatter - linkToInlinesF :: String -> Inlines -> F Inlines -linkToInlinesF s@('#':_) = pure . B.link s "" -linkToInlinesF s - | isImageFilename s = const . pure $ B.image s "" "" - | isUri s = pure . B.link s "" - | isRelativeUrl s = pure . B.link s "" -linkToInlinesF s = \title -> do - anchorB <- (s `elem`) <$> asksF orgStateAnchorIds - if anchorB - then pure $ B.link ('#':s) "" title - else pure $ B.emph title - -isRelativeUrl :: String -> Bool -isRelativeUrl s = (':' `notElem` s) && ("./" `isPrefixOf` s) +linkToInlinesF s = + case s of + "" -> pure . B.link "" "" + ('#':_) -> pure . B.link s "" + _ | isImageFilename s -> const . pure $ B.image 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 :: String -> Bool +isRelativeFilePath s = (("./" `isPrefixOf` s) || ("../" `isPrefixOf` s)) && + (':' `notElem` s) isUri :: String -> Bool isUri s = let (scheme, path) = break (== ':') s in all (\c -> isAlphaNum c || c `elem` ".-") scheme && not (null path) +isAbsoluteFilePath :: String -> Bool +isAbsoluteFilePath = ('/' ==) . head + isImageFilename :: String -> Bool isImageFilename filename = any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions && diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 392388ec0..e59080bae 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -197,6 +197,18 @@ tests = "[[http://zeitlens.com/]]" =?> (para $ link "http://zeitlens.com/" "" "http://zeitlens.com/") + , "Absolute file link" =: + "[[/url][hi]]" =?> + (para $ link "file:///url" "" "hi") + + , "Link to file in parent directory" =: + "[[../file.txt][moin]]" =?> + (para $ link "../file.txt" "" "moin") + + , "Empty link (for gitit interop)" =: + "[[][New Link]]" =?> + (para $ link "" "" "New Link") + , "Image link" =: "[[sunset.png][dusk.svg]]" =?> (para $ link "sunset.png" "" (image "dusk.svg" "" "")) |