@@ -62,7 +62,7 @@ import Debug.Trace (trace)
6262import Text.TeXMath (readMathML, writeTeX)
6363import Data.Default (Default (..), def)
6464import Control.Monad.Reader (Reader,ask, asks, local, runReader)
65−
65+import Network.URI (isURI)
6666import Text.Pandoc.Error
6767
6868import Text.Parsec.Error
@@ -74,7 +74,8 @@ readHtml :: ReaderOptions -- ^ Reader options
7474 -> Either PandocError Pandoc
7575readHtml opts inp =
7676 mapLeft (ParseFailure . getError) . flip runReader def $
77− runParserT parseDoc (HTMLState def{ stateOptions = opts } []) "source" tags
77+ runParserT parseDoc (HTMLState def{ stateOptions = opts } [] Nothing)
78+ "source" tags
7879 where tags = stripPrefixes . canonicalizeTags $
7980 parseTagsOptions parseOptions{ optTagPosition = True } inp
8081 parseDoc = do
@@ -98,7 +99,8 @@ replaceNotes' x = return x
9899data HTMLState =
99100 HTMLState
100101 { parserState :: ParserState,
101− noteTable :: [(String, Blocks)]
102+ noteTable :: [(String, Blocks)],
103+ baseHref :: Maybe String
102104 }
103105
104106data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext
@@ -120,7 +122,7 @@ pBody :: TagParser Blocks
120122pBody = pInTags "body" block
121123
122124pHead :: TagParser Blocks
123−pHead = pInTags "head" $ pTitle <|> pMetaTag <|> (mempty <$ pAnyTag)
125+pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag)
124126 where pTitle = pInTags "title" inline >>= setTitle . trimInlines
125127 setTitle t = mempty <$ (updateState $ B.setMeta "title" t)
126128 pMetaTag = do
@@ -132,6 +134,17 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> (mempty <$ pAnyTag)
132134 let content = fromAttrib "content" mt
133135 updateState $ B.setMeta name (B.text content)
134136 return mempty
137+ pBaseTag = do
138+ bt <- pSatisfy (~== TagOpen "base" [])
139+ let baseH = fromAttrib "href" bt
140+ if null baseH
141+ then return mempty
142+ else do
143+ let baseH' = case reverse baseH of
144+ '/':_ -> baseH
145+ _ -> baseH ++ "/"
146+ updateState $ \st -> st{ baseHref = Just baseH' }
147+ return mempty
135148
136149block :: TagParser Blocks
137150block = do
@@ -566,7 +579,11 @@ pAnchor = try $ do
566579pRelLink :: TagParser Inlines
567580pRelLink = try $ do
568581 tag <- pSatisfy (tagOpenLit "a" (isJust . lookup "href"))
569− let url = fromAttrib "href" tag
582+ mbBaseHref <- baseHref <$> getState
583+ let url' = fromAttrib "href" tag
584+ let url = case (isURI url', mbBaseHref) of
585+ (False, Just h) -> h ++ url'
586+ _ -> url'
570587 let title = fromAttrib "title" tag
571588 let uid = fromAttrib "id" tag
572589 let spanC = case uid of
@@ -578,7 +595,11 @@ pRelLink = try $ do
578595pImage :: TagParser Inlines
579596pImage = do
580597 tag <- pSelfClosing (=="img") (isJust . lookup "src")
581− let url = fromAttrib "src" tag
598+ mbBaseHref <- baseHref <$> getState
599+ let url' = fromAttrib "src" tag
600+ let url = case (isURI url', mbBaseHref) of
601+ (False, Just h) -> h ++ url'
602+ _ -> url'
582603 let title = fromAttrib "title" tag
583604 let alt = fromAttrib "alt" tag
584605 return $ B.image (escapeURI url) title (B.text alt)
@@ -945,7 +966,7 @@ instance HasReaderOptions HTMLState where
945966 extractReaderOptions = extractReaderOptions . parserState
946967
947968instance Default HTMLState where
948− def = HTMLState def []
969+ def = HTMLState def [] Nothing
949970
950971instance HasMeta HTMLState where
951972 setMeta s b st = st {parserState = setMeta s b $ parserState st}