diff options
Diffstat (limited to 'hs/src/Html.hs')
-rw-r--r-- | hs/src/Html.hs | 36 |
1 files changed, 26 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 |