{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE TupleSections     #-}
{- |
   Module      : Text.Pandoc.SelfContained
   Copyright   : Copyright (C) 2011-2023 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Functions for converting an HTML file into one that can be viewed
offline, by incorporating linked images, CSS, and scripts into
the HTML using data URIs.
-}
module Text.Pandoc.SelfContained ( makeDataURI, makeSelfContained ) where
import Codec.Compression.GZip as Gzip
import Control.Applicative ((<|>))
import Control.Monad.Trans (lift)
import Data.ByteString (ByteString)
import Data.ByteString.Base64 (encodeBase64)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import Data.Char (isAlphaNum, isAscii)
import Network.URI (escapeURIString)
import System.FilePath (takeDirectory, takeExtension, (</>))
import Text.HTML.TagSoup
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), fetchItem,
                                      getInputFiles, report, setInputFiles)
import Text.Pandoc.Logging
import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.MIME (MimeType)
import Text.Pandoc.Shared (renderTags', trim, tshow)
import Text.Pandoc.URI (isURI)
import Text.Pandoc.UTF8 (toString, toText, fromText)
import Text.Pandoc.Parsing (ParsecT, runParserT)
import qualified Text.Pandoc.Parsing as P
import Control.Monad.Except (throwError, catchError)

isOk :: Char -> Bool
isOk :: Char -> Bool
isOk Char
c = Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c

makeDataURI :: (MimeType, ByteString) -> T.Text
makeDataURI :: (Text, ByteString) -> Text
makeDataURI (Text
mime, ByteString
raw) =
  if Bool
textual
     then Text
"data:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mime' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isOk (ByteString -> String
toString ByteString
raw))
     else Text
"data:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mime' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";base64," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
encodeBase64 ByteString
raw
  where textual :: Bool
textual = Text
"text/" Text -> Text -> Bool
`T.isPrefixOf` Text
mime
        mime' :: Text
mime' = if Bool
textual Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
';') Text
mime
                   then Text
mime Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";charset=utf-8"
                   else Text
mime  -- mime type already has charset

isSourceAttribute :: T.Text -> (T.Text, T.Text) -> Bool
isSourceAttribute :: Text -> (Text, Text) -> Bool
isSourceAttribute Text
tagname (Text
x,Text
_) =
  Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"src" Bool -> Bool -> Bool
||
  Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"data-src" Bool -> Bool -> Bool
||
  (Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"href" Bool -> Bool -> Bool
&& Text
tagname Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"link") Bool -> Bool -> Bool
||
  Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"poster" Bool -> Bool -> Bool
||
  Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"data-background-image"

convertTags :: PandocMonad m => [Tag T.Text] -> m [Tag T.Text]
convertTags :: forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [] = [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
convertTags (t :: Tag Text
t@TagOpen{}:[Tag Text]
ts)
  | Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"data-external" Tag Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"1" = (Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> m [Tag Text] -> m [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
convertTags (t :: Tag Text
t@(TagOpen Text
"style" [(Text, Text)]
_):[Tag Text]
ts) =
  case (Tag Text -> Bool) -> [Tag Text] -> ([Tag Text], [Tag Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Tag Text -> Bool
forall str. Tag str -> Bool
isTagText [Tag Text]
ts of
    ([Tag Text]
xs,[Tag Text]
rest) -> do
      [Tag Text]
xs' <- (Tag Text -> m (Tag Text)) -> [Tag Text] -> m [Tag Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
                    TagText Text
s -> Text -> Tag Text
forall str. str -> Tag str
TagText (Text -> Tag Text)
-> (ByteString -> Text) -> ByteString -> Tag Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
toText (ByteString -> Tag Text) -> m ByteString -> m (Tag Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
"" (Text -> ByteString
fromText Text
s)
                    Tag Text
tag -> Tag Text -> m (Tag Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
tag) [Tag Text]
xs
      ((Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:[Tag Text]
xs') [Tag Text] -> [Tag Text] -> [Tag Text]
forall a. [a] -> [a] -> [a]
++) ([Tag Text] -> [Tag Text]) -> m [Tag Text] -> m [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
rest
convertTags (t :: Tag Text
t@(TagOpen Text
"script" [(Text, Text)]
as):tc :: Tag Text
tc@(TagClose Text
"script"):[Tag Text]
ts) =
  case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
t of
       Text
""  -> (Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> m [Tag Text] -> m [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
       Text
src -> do
           let typeAttr :: Text
typeAttr = Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t
           GetDataResult
res <- Text -> Text -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData Text
typeAttr Text
src
           [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
           case GetDataResult
res of
                AlreadyDataURI Text
dataUri -> [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script"
                     ((Text
"src",Text
dataUri) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"src"]) Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:
                     Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"script" Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
                Fetched (Text
mime, ByteString
bs)
                  | (Text
"text/javascript" Text -> Text -> Bool
`T.isPrefixOf` Text
mime Bool -> Bool -> Bool
||
                     Text
"application/javascript" Text -> Text -> Bool
`T.isPrefixOf` Text
mime Bool -> Bool -> Bool
||
                     Text
"application/x-javascript" Text -> Text -> Bool
`T.isPrefixOf` Text
mime) Bool -> Bool -> Bool
&&
                     Bool -> Bool
not (ByteString
"</script" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
bs) ->
                     [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$
                       Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script" [(Text
"type", Text
typeAttr)|Bool -> Bool
not (Text -> Bool
T.null Text
typeAttr)]
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> Tag Text
forall str. str -> Tag str
TagText (ByteString -> Text
toText ByteString
bs)
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"script"
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
                  | Bool
otherwise ->
                       [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return  ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script"
                         ((Text
"src",(Text, ByteString) -> Text
makeDataURI (Text
mime, ByteString
bs)) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
                          [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"src"]) Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:
                        Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"script" Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
                CouldNotFetch PandocError
_ -> [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:Tag Text
tcTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:[Tag Text]
rest
convertTags (t :: Tag Text
t@(TagOpen Text
"link" [(Text, Text)]
as):[Tag Text]
ts) =
  case Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"href" Tag Text
t of
       Text
""  -> (Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> m [Tag Text] -> m [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
       Text
src -> do
           GetDataResult
res <- Text -> Text -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData (Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t) Text
src
           case GetDataResult
res of
                AlreadyDataURI Text
dataUri -> do
                  [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
                  [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"link"
                     ((Text
"href",Text
dataUri) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"href"]) Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:
                     [Tag Text]
rest
                Fetched (Text
mime, ByteString
bs)
                  | Text
"text/css" Text -> Text -> Bool
`T.isPrefixOf` Text
mime
                    Bool -> Bool -> Bool
&& Text -> Bool
T.null (Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"media" Tag Text
t)
                    Bool -> Bool -> Bool
&& Bool -> Bool
not (ByteString
"</" ByteString -> ByteString -> Bool
`B.isInfixOf` ByteString
bs) -> do
                      [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$
                                 (Tag Text -> Bool) -> [Tag Text] -> [Tag Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Tag Text -> Tag Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"link") [Tag Text]
ts
                      [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$
                       Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"style" [(Text
"type", Text
"text/css")] -- see #5725
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> Tag Text
forall str. str -> Tag str
TagText (ByteString -> Text
toText ByteString
bs)
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> Tag Text
forall str. str -> Tag str
TagClose Text
"style"
                       Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
                  | Bool
otherwise -> do
                      [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
                      [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"link"
                       ((Text
"href",(Text, ByteString) -> Text
makeDataURI (Text
mime, ByteString
bs)) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
                         [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"href"]) Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
                CouldNotFetch PandocError
_ -> do
                      [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
                      [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:[Tag Text]
rest
convertTags (t :: Tag Text
t@(TagOpen Text
tagname [(Text, Text)]
as):[Tag Text]
ts)
  | ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> (Text, Text) -> Bool
isSourceAttribute Text
tagname) [(Text, Text)]
as
     = do
       [(Text, Text)]
as' <- ((Text, Text) -> m (Text, Text))
-> [(Text, Text)] -> m [(Text, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Text) -> m (Text, Text)
forall {m :: * -> *}.
PandocMonad m =>
(Text, Text) -> m (Text, Text)
processAttribute [(Text, Text)]
as
       [Tag Text]
rest <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts
       [Tag Text] -> m [Tag Text]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tag Text] -> m [Tag Text]) -> [Tag Text] -> m [Tag Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tagname [(Text, Text)]
as' Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Tag Text]
rest
  where processAttribute :: (Text, Text) -> m (Text, Text)
processAttribute (Text
x,Text
y) =
           if Text -> (Text, Text) -> Bool
isSourceAttribute Text
tagname (Text
x,Text
y)
              then do
                GetDataResult
res <- Text -> Text -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData (Text -> Tag Text -> Text
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t) Text
y
                case GetDataResult
res of
                  AlreadyDataURI Text
enc -> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Text
enc)
                  Fetched (Text
mt,ByteString
bs) -> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, (Text, ByteString) -> Text
makeDataURI (Text
mt,ByteString
bs))
                  CouldNotFetch PandocError
_ -> (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x, Text
y)
              else (Text, Text) -> m (Text, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
x,Text
y)

convertTags (Tag Text
t:[Tag Text]
ts) = (Tag Text
tTag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:) ([Tag Text] -> [Tag Text]) -> m [Tag Text] -> m [Tag Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
ts

cssURLs :: PandocMonad m
        => FilePath -> ByteString -> m ByteString
cssURLs :: forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
d ByteString
orig = do
  Either ParseError ByteString
res <- ParsecT ByteString () m ByteString
-> () -> String -> ByteString -> m (Either ParseError ByteString)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
parseCSSUrls String
d) () String
"css" ByteString
orig
  case Either ParseError ByteString
res of
       Left ParseError
e    -> do
         LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotParseCSS (Text -> LogMessage) -> Text -> LogMessage
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
         ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
orig
       Right ByteString
bs  -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

parseCSSUrls :: PandocMonad m
             => FilePath -> ParsecT ByteString () m ByteString
parseCSSUrls :: forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
parseCSSUrls String
d = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ParsecT ByteString () m [ByteString]
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m [ByteString]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many
  (ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSWhite ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSComment ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSImport String
d ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSUrl String
d ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSOther)

pCSSImport :: PandocMonad m
           => FilePath -> ParsecT ByteString () m ByteString
pCSSImport :: forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSImport String
d = ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
 -> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT ByteString () m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"@import"
  ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Either ByteString (Text, ByteString)
res <- (ParsecT ByteString () m (Text, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pQuoted ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT ByteString () m (Text, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pUrl) ParsecT ByteString () m (Text, ByteString)
-> ((Text, ByteString)
    -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b.
ParsecT ByteString () m a
-> (a -> ParsecT ByteString () m b) -> ParsecT ByteString () m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall (m :: * -> *).
PandocMonad m =>
String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
handleCSSUrl String
d
  ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
';'
  ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  case Either ByteString (Text, ByteString)
res of
       Left ByteString
b       -> ByteString -> ParsecT ByteString () m ByteString
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ParsecT ByteString () m ByteString)
-> ByteString -> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
"@import " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b
       Right (Text
_, ByteString
b) -> ByteString -> ParsecT ByteString () m ByteString
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b

-- Note: some whitespace in CSS is significant, so we can't collapse it!
pCSSWhite :: PandocMonad m => ParsecT ByteString () m ByteString
pCSSWhite :: forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSWhite = Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.space ParsecT ByteString () m ByteString
-> ParsecT ByteString () m () -> ParsecT ByteString () m ByteString
forall a b.
ParsecT ByteString () m a
-> ParsecT ByteString () m b -> ParsecT ByteString () m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces

pCSSComment :: PandocMonad m => ParsecT ByteString () m ByteString
pCSSComment :: forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSComment = ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
 -> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT ByteString () m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"/*"
  ParsecT ByteString () m Char
-> ParsecT ByteString () m String -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (ParsecT ByteString () m String -> ParsecT ByteString () m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (String -> ParsecT ByteString () m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"*/"))
  ByteString -> ParsecT ByteString () m ByteString
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty

pCSSOther :: PandocMonad m => ParsecT ByteString () m ByteString
pCSSOther :: forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSOther =
  (String -> ByteString
B.pack (String -> ByteString)
-> ParsecT ByteString () m String
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (String -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
P.noneOf String
"u/ \n\r\t")) ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
'u') ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a.
ParsecT ByteString () m a
-> ParsecT ByteString () m a -> ParsecT ByteString () m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> ByteString
B.singleton (Char -> ByteString)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
'/')

pCSSUrl :: PandocMonad m
        => FilePath -> ParsecT ByteString () m ByteString
pCSSUrl :: forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSUrl String
d = ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m ByteString
 -> ParsecT ByteString () m ByteString)
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ do
  Either ByteString (Text, ByteString)
res <- ParsecT ByteString () m (Text, ByteString)
forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pUrl ParsecT ByteString () m (Text, ByteString)
-> ((Text, ByteString)
    -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b.
ParsecT ByteString () m a
-> (a -> ParsecT ByteString () m b) -> ParsecT ByteString () m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall (m :: * -> *).
PandocMonad m =>
String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
handleCSSUrl String
d
  case Either ByteString (Text, ByteString)
res of
       Left ByteString
b -> ByteString -> ParsecT ByteString () m ByteString
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b
       Right (Text
mt,ByteString
b) -> do
         let enc :: Text
enc = (Text, ByteString) -> Text
makeDataURI (Text
mt, ByteString
b)
         ByteString -> ParsecT ByteString () m ByteString
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ParsecT ByteString () m ByteString)
-> ByteString -> ParsecT ByteString () m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"url(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
enc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

pQuoted :: PandocMonad m
        => ParsecT ByteString () m (T.Text, ByteString)
pQuoted :: forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pQuoted = ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m (Text, ByteString)
 -> ParsecT ByteString () m (Text, ByteString))
-> ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
forall a b. (a -> b) -> a -> b
$ do
  Char
quote <- String -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
P.oneOf String
"\"'"
  Text
url <- String -> Text
T.pack (String -> Text)
-> ParsecT ByteString () m String -> ParsecT ByteString () m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
quote)
  let fallback :: ByteString
fallback = Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
quote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
trim Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
quote
  (Text, ByteString) -> ParsecT ByteString () m (Text, ByteString)
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
url, ByteString
fallback)

pUrl :: PandocMonad m
     => ParsecT ByteString () m (T.Text, ByteString)
pUrl :: forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pUrl = ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (ParsecT ByteString () m (Text, ByteString)
 -> ParsecT ByteString () m (Text, ByteString))
-> ParsecT ByteString () m (Text, ByteString)
-> ParsecT ByteString () m (Text, ByteString)
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT ByteString () m String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"url("
  ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Maybe Char
quote <- Maybe Char
-> ParsecT ByteString () m (Maybe Char)
-> ParsecT ByteString () m (Maybe Char)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option Maybe Char
forall a. Maybe a
Nothing (Char -> Maybe Char
forall a. a -> Maybe a
Just (Char -> Maybe Char)
-> ParsecT ByteString () m Char
-> ParsecT ByteString () m (Maybe Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m Char
P.oneOf String
"\"'")
  Text
url <- String -> Text
T.pack (String -> Text)
-> ParsecT ByteString () m String -> ParsecT ByteString () m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () m Char
-> ParsecT ByteString () m Char -> ParsecT ByteString () m String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
P.manyTill ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (ParsecT ByteString () m Char
-> (Char -> ParsecT ByteString () m Char)
-> Maybe Char
-> ParsecT ByteString () m Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParsecT ByteString () m Char -> ParsecT ByteString () m Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
')')) Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Maybe Char
quote)
  ParsecT ByteString () m ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Char -> ParsecT ByteString () m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
')'
  let fallback :: ByteString
fallback = Text -> ByteString
fromText (Text
"url(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton Maybe Char
quote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
trim Text
url Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                            Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton Maybe Char
quote Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  (Text, ByteString) -> ParsecT ByteString () m (Text, ByteString)
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
url, ByteString
fallback)

handleCSSUrl :: PandocMonad m
             => FilePath -> (T.Text, ByteString)
             -> ParsecT ByteString () m
                  (Either ByteString (MimeType, ByteString))
handleCSSUrl :: forall (m :: * -> *).
PandocMonad m =>
String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
handleCSSUrl String
d (Text
url, ByteString
fallback) =
  case (Char -> Bool) -> String -> String
escapeURIString (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'|') (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
url) of
      Char
'#':String
_ -> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Text, ByteString)
 -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (Text, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback
      Char
'd':Char
'a':Char
't':Char
'a':Char
':':String
_ -> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Text, ByteString)
 -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (Text, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback
      String
u ->  do let url' :: Text
url' = if Text -> Bool
isURI (String -> Text
T.pack String
u) then String -> Text
T.pack String
u else String -> Text
T.pack (String
d String -> String -> String
</> String
u)
               GetDataResult
res <- m GetDataResult -> ParsecT ByteString () m GetDataResult
forall (m :: * -> *) a. Monad m => m a -> ParsecT ByteString () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GetDataResult -> ParsecT ByteString () m GetDataResult)
-> m GetDataResult -> ParsecT ByteString () m GetDataResult
forall a b. (a -> b) -> a -> b
$ Text -> Text -> m GetDataResult
forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData Text
"" Text
url'
               case GetDataResult
res of
                    AlreadyDataURI Text
uri -> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Text, ByteString)
 -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (Text, ByteString)
forall a b. a -> Either a b
Left (Text -> ByteString
fromText (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"url(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
uri Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
                    Fetched (Text
mt', ByteString
raw) -> do
                      -- note that the downloaded CSS may
                      -- itself contain url(...).
                      (Text
mt, ByteString
b) <- if Text
"text/css" Text -> Text -> Bool
`T.isPrefixOf` Text
mt'
                                    -- see #5725: in HTML5, content type
                                    -- isn't allowed on style type attribute
                                    then (Text
"text/css",) (ByteString -> (Text, ByteString))
-> ParsecT ByteString () m ByteString
-> ParsecT ByteString () m (Text, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString -> ParsecT ByteString () m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
d ByteString
raw
                                    else (Text, ByteString) -> ParsecT ByteString () m (Text, ByteString)
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt', ByteString
raw)
                      Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Text, ByteString)
 -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Either ByteString (Text, ByteString)
forall a b. b -> Either a b
Right (Text
mt, ByteString
b)
                    CouldNotFetch PandocError
_ -> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a. a -> ParsecT ByteString () m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString (Text, ByteString)
 -> ParsecT ByteString () m (Either ByteString (Text, ByteString)))
-> Either ByteString (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString (Text, ByteString)
forall a b. a -> Either a b
Left ByteString
fallback

data GetDataResult =
    AlreadyDataURI T.Text
  | CouldNotFetch PandocError
  | Fetched (MimeType, ByteString)
  deriving (Int -> GetDataResult -> String -> String
[GetDataResult] -> String -> String
GetDataResult -> String
(Int -> GetDataResult -> String -> String)
-> (GetDataResult -> String)
-> ([GetDataResult] -> String -> String)
-> Show GetDataResult
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GetDataResult -> String -> String
showsPrec :: Int -> GetDataResult -> String -> String
$cshow :: GetDataResult -> String
show :: GetDataResult -> String
$cshowList :: [GetDataResult] -> String -> String
showList :: [GetDataResult] -> String -> String
Show)

getData :: PandocMonad m
        => MimeType -> T.Text
        -> m GetDataResult
getData :: forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData Text
mimetype Text
src
  | Text
"data:" Text -> Text -> Bool
`T.isPrefixOf` Text
src = GetDataResult -> m GetDataResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ Text -> GetDataResult
AlreadyDataURI Text
src -- already data: uri
  | Bool
otherwise = m GetDataResult
-> (PandocError -> m GetDataResult) -> m GetDataResult
forall a. m a -> (PandocError -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m GetDataResult
fetcher PandocError -> m GetDataResult
forall {m :: * -> *}.
PandocMonad m =>
PandocError -> m GetDataResult
handler
 where
   fetcher :: m GetDataResult
fetcher = do
      let ext :: Text
ext = Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
      (ByteString
raw, Maybe Text
respMime) <- Text -> m (ByteString, Maybe Text)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
      let raw' :: ByteString
raw' = if Text
ext Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
".gz", Text
".svgz"]
                 then [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Gzip.decompress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
raw]
                 else ByteString
raw
      let mime :: Text
mime = case (Text
mimetype, Maybe Text
respMime) of
                  (Text
"",Maybe Text
Nothing) -> Text
"application/octet-stream"
                  (Text
x, Maybe Text
Nothing) -> Text
x
                  (Text
_, Just Text
x ) -> Text
x
      ByteString
result <- if Text
"text/css" Text -> Text -> Bool
`T.isPrefixOf` Text
mime
                then do
                  [String]
oldInputs <- m [String]
forall (m :: * -> *). PandocMonad m => m [String]
getInputFiles
                  [String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [Text -> String
T.unpack Text
src]
                  ByteString
res <- String -> ByteString -> m ByteString
forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs (String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src) ByteString
raw'
                  [String] -> m ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [String]
oldInputs
                  ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
               else ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw'
      GetDataResult -> m GetDataResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> GetDataResult
Fetched (Text
mime, ByteString
result)
   handler :: PandocError -> m GetDataResult
handler PandocError
e = case PandocError
e of
                 PandocResourceNotFound Text
r -> do
                   LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
r Text
""
                   GetDataResult -> m GetDataResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
                 PandocHttpError Text
u HttpException
er -> do
                   LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
u (HttpException -> Text
forall a. Show a => a -> Text
tshow HttpException
er)
                   GetDataResult -> m GetDataResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (GetDataResult -> m GetDataResult)
-> GetDataResult -> m GetDataResult
forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
                 PandocError
_ -> PandocError -> m GetDataResult
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PandocError
e




-- | Convert HTML into self-contained HTML, incorporating images,
-- scripts, and CSS using data: URIs.
makeSelfContained :: PandocMonad m => T.Text -> m T.Text
makeSelfContained :: forall (m :: * -> *). PandocMonad m => Text -> m Text
makeSelfContained Text
inp = do
  let tags :: [Tag Text]
tags = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags Text
inp
  [Tag Text]
out' <- [Tag Text] -> m [Tag Text]
forall (m :: * -> *). PandocMonad m => [Tag Text] -> m [Tag Text]
convertTags [Tag Text]
tags
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text]
out'