Org reader: Refactor link-target processing

Cleanup of the code for link target handling.  Most notably, the
canonicalization of a link is handled by a separate function.

This fixes #2684.
This commit is contained in:
Albert Krewinkel 2016-01-31 19:44:45 +01:00
parent a02c26d9f4
commit 92e6ae47f6
2 changed files with 33 additions and 29 deletions

View file

@ -1239,37 +1239,37 @@ 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.
-- | Take a link and return a function which produces new inlines when given
-- description inlines.
linkToInlinesF :: String -> Inlines -> F Inlines
linkToInlinesF s =
linkToInlinesF linkStr =
case linkStr of
"" -> pure . B.link mempty "" -- wiki link (empty by convention)
('#':_) -> pure . B.link linkStr "" -- document-local fraction
_ -> case cleanLinkString linkStr of
(Just cleanedLink) -> if isImageFilename cleanedLink
then const . pure $ B.image cleanedLink "" ""
else pure . B.link cleanedLink ""
Nothing -> internalLink linkStr -- other internal link
-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if
-- the string does not appear to be a link.
cleanLinkString :: String -> Maybe String
cleanLinkString 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 ""
_ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""
_ | 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)) &&
(':' `notElem` s)
isUri :: String -> Bool
isUri s = let (scheme, path) = break (== ':') s
in all (\c -> isAlphaNum c || c `elem` (".-" :: String)) scheme
&& not (null path)
isAbsoluteFilePath :: String -> Bool
isAbsoluteFilePath = ('/' ==) . head
'/':_ -> Just $ "file://" ++ s -- absolute path
'.':'/':_ -> Just s -- relative path
'.':'.':'/':_ -> Just s -- relative path
-- Relative path or URL (file schema)
'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'
_ | isUrl s -> Just s -- URL
_ -> Nothing
where
isUrl :: String -> Bool
isUrl cs =
let (scheme, path) = break (== ':') cs
in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme
&& not (null path)
isImageFilename :: String -> Bool
isImageFilename filename =

View file

@ -190,6 +190,10 @@ tests =
"[[./sunset.jpg]]" =?>
(para $ image "./sunset.jpg" "" "")
, "Image with explicit file: prefix" =:
"[[file:sunrise.jpg]]" =?>
(para $ image "sunrise.jpg" "" "")
, "Explicit link" =:
"[[http://zeitlens.com/][pseudo-random /nonsense/]]" =?>
(para $ link "http://zeitlens.com/" ""