@@ -1239,37 +1239,37 @@ applyCustomLinkFormat link = do
12391239 formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters
12401240 return $ maybe link ($ drop 1 rest) formatter
12411241
1242−-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind
1243−-- of parsing.
1242+-- | Take a link and return a function which produces new inlines when given
1243+-- description inlines.
12441244linkToInlinesF :: String -> Inlines -> F Inlines
1245−linkToInlinesF s =
1245+linkToInlinesF linkStr =
1246+ case linkStr of
1247+ "" -> pure . B.link mempty "" -- wiki link (empty by convention)
1248+ ('#':_) -> pure . B.link linkStr "" -- document-local fraction
1249+ _ -> case cleanLinkString linkStr of
1250+ (Just cleanedLink) -> if isImageFilename cleanedLink
1251+ then const . pure $ B.image cleanedLink "" ""
1252+ else pure . B.link cleanedLink ""
1253+ Nothing -> internalLink linkStr -- other internal link
1254+
1255+-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if
1256+-- the string does not appear to be a link.
1257+cleanLinkString :: String -> Maybe String
1258+cleanLinkString s =
12461259 case s of
1247− "" -> pure . B.link "" ""
1248− ('#':_) -> pure . B.link s ""
1249− _ | isImageFilename s -> const . pure $ B.image s "" ""
1250− _ | isFileLink s -> pure . B.link (dropLinkType s) ""
1251− _ | isUri s -> pure . B.link s ""
1252− _ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""
1253− _ | isRelativeFilePath s -> pure . B.link s ""
1254− _ -> internalLink s
1255−
1256−isFileLink :: String -> Bool
1257−isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)
1258−
1259−dropLinkType :: String -> String
1260−dropLinkType = tail . snd . break (== ':')
1261−
1262−isRelativeFilePath :: String -> Bool
1263−isRelativeFilePath s = (("./" `isPrefixOf` s) || ("../" `isPrefixOf` s)) &&
1264− (':' `notElem` s)
1265−
1266−isUri :: String -> Bool
1267−isUri s = let (scheme, path) = break (== ':') s
1268− in all (\c -> isAlphaNum c || c `elem` (".-" :: String)) scheme
1269− && not (null path)
1270−
1271−isAbsoluteFilePath :: String -> Bool
1272−isAbsoluteFilePath = ('/' ==) . head
1260+ '/':_ -> Just $ "file://" ++ s -- absolute path
1261+ '.':'/':_ -> Just s -- relative path
1262+ '.':'.':'/':_ -> Just s -- relative path
1263+ -- Relative path or URL (file schema)
1264+ 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'
1265+ _ | isUrl s -> Just s -- URL
1266+ _ -> Nothing
1267+ where
1268+ isUrl :: String -> Bool
1269+ isUrl cs =
1270+ let (scheme, path) = break (== ':') cs
1271+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme
1272+ && not (null path)
12731273
12741274isImageFilename :: String -> Bool
12751275isImageFilename filename =