{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 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 Data.Digest.Pure.SHA (sha1, showDigest)
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, safeRead)
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)
import Data.Either (lefts, rights)
import Data.Maybe (isNothing)
import qualified Data.Map as M
import Control.Monad.State
-- import Debug.Trace

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:" forall a. Semigroup a => a -> a -> a
<> Text
mime' forall a. Semigroup a => a -> a -> a
<> 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:" forall a. Semigroup a => a -> a -> a
<> Text
mime' forall a. Semigroup a => a -> a -> a
<> Text
";base64," 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 (forall a. Eq a => a -> a -> Bool
== Char
';') Text
mime
                   then Text
mime 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 forall a. Eq a => a -> a -> Bool
== Text
"src" Bool -> Bool -> Bool
||
  Text
x forall a. Eq a => a -> a -> Bool
== Text
"data-src" Bool -> Bool -> Bool
||
  (Text
x forall a. Eq a => a -> a -> Bool
== Text
"href" Bool -> Bool -> Bool
&& Text
tagname forall a. Eq a => a -> a -> Bool
== Text
"link") Bool -> Bool -> Bool
||
  Text
x forall a. Eq a => a -> a -> Bool
== Text
"poster" Bool -> Bool -> Bool
||
  Text
x forall a. Eq a => a -> a -> Bool
== Text
"data-background-image"

data ConvertState =
  ConvertState
  { ConvertState -> Bool
isHtml5 :: Bool
  , ConvertState -> Map Text (Text, [(Text, Text)])
svgMap  :: M.Map T.Text (T.Text, [Attribute T.Text])
    -- map from hash to (id, svg attributes)
  } deriving (Int -> ConvertState -> String -> String
[ConvertState] -> String -> String
ConvertState -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ConvertState] -> String -> String
$cshowList :: [ConvertState] -> String -> String
show :: ConvertState -> String
$cshow :: ConvertState -> String
showsPrec :: Int -> ConvertState -> String -> String
$cshowsPrec :: Int -> ConvertState -> String -> String
Show)

convertTags :: PandocMonad m =>
               [Tag T.Text] -> StateT ConvertState m [Tag T.Text]
convertTags :: forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
convertTags (t :: Tag Text
t@TagOpen{}:[Tag Text]
ts)
  | forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"data-external" Tag Text
t forall a. Eq a => a -> a -> Bool
== Text
"1" = (Tag Text
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
convertTags (t :: Tag Text
t@(TagOpen Text
"style" [(Text, Text)]
_):[Tag Text]
ts) =
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall str. Tag str -> Bool
isTagText [Tag Text]
ts of
    ([Tag Text]
xs,[Tag Text]
rest) -> do
      [Tag Text]
xs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\case
                    TagText Text
s -> forall str. str -> Tag str
TagText forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
"" (Text -> ByteString
fromText Text
s)
                    Tag Text
tag -> forall (m :: * -> *) a. Monad m => a -> m a
return Tag Text
tag) [Tag Text]
xs
      ((Tag Text
tforall a. a -> [a] -> [a]
:[Tag Text]
xs') forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState 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 forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"src" Tag Text
t of
       Text
""  -> (Tag Text
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
       Text
src -> do
           let typeAttr :: Text
typeAttr = forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"type" Tag Text
t
           GetDataResult
res <- forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData Text
typeAttr Text
src
           [Tag Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
           case GetDataResult
res of
                AlreadyDataURI Text
dataUri -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script"
                     ((Text
"src",Text
dataUri) forall a. a -> [a] -> [a]
: [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x forall a. Eq a => a -> a -> Bool
/= Text
"src"]) forall a. a -> [a] -> [a]
:
                     forall str. str -> Tag str
TagClose Text
"script" 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) ->
                     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                       forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script" [(Text
"type", Text
typeAttr)|Bool -> Bool
not (Text -> Bool
T.null Text
typeAttr)]
                       forall a. a -> [a] -> [a]
: forall str. str -> Tag str
TagText (ByteString -> Text
toText ByteString
bs)
                       forall a. a -> [a] -> [a]
: forall str. str -> Tag str
TagClose Text
"script"
                       forall a. a -> [a] -> [a]
: [Tag Text]
rest
                  | Bool
otherwise ->
                       forall (m :: * -> *) a. Monad m => a -> m a
return  forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"script"
                         ((Text
"src",(Text, ByteString) -> Text
makeDataURI (Text
mime, ByteString
bs)) forall a. a -> [a] -> [a]
:
                          [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x forall a. Eq a => a -> a -> Bool
/= Text
"src"]) forall a. a -> [a] -> [a]
:
                        forall str. str -> Tag str
TagClose Text
"script" forall a. a -> [a] -> [a]
: [Tag Text]
rest
                CouldNotFetch PandocError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tag Text
tforall a. a -> [a] -> [a]
:Tag Text
tcforall a. a -> [a] -> [a]
:[Tag Text]
rest
convertTags (t :: Tag Text
t@(TagOpen Text
"link" [(Text, Text)]
as):[Tag Text]
ts) =
  case forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib Text
"href" Tag Text
t of
       Text
""  -> (Tag Text
tforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
       Text
src -> do
           GetDataResult
res <- forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData (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 <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"link"
                     ((Text
"href",Text
dataUri) forall a. a -> [a] -> [a]
: [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x forall a. Eq a => a -> a -> Bool
/= Text
"href"]) 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 (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 <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags forall a b. (a -> b) -> a -> b
$
                                 forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==forall str. str -> Tag str
TagClose Text
"link") [Tag Text]
ts
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                       forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"style" [(Text
"type", Text
"text/css")] -- see #5725
                       forall a. a -> [a] -> [a]
: forall str. str -> Tag str
TagText (ByteString -> Text
toText ByteString
bs)
                       forall a. a -> [a] -> [a]
: forall str. str -> Tag str
TagClose Text
"style"
                       forall a. a -> [a] -> [a]
: [Tag Text]
rest
                  | Bool
otherwise -> do
                      [Tag Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"link"
                       ((Text
"href",(Text, ByteString) -> Text
makeDataURI (Text
mime, ByteString
bs)) forall a. a -> [a] -> [a]
:
                         [(Text
x,Text
y) | (Text
x,Text
y) <- [(Text, Text)]
as, Text
x forall a. Eq a => a -> a -> Bool
/= Text
"href"]) forall a. a -> [a] -> [a]
: [Tag Text]
rest
                CouldNotFetch PandocError
_ -> do
                      [Tag Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Tag Text
tforall a. a -> [a] -> [a]
:[Tag Text]
rest
convertTags (t :: Tag Text
t@(TagOpen Text
tagname [(Text, Text)]
as):[Tag Text]
ts)
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> (Text, Text) -> Bool
isSourceAttribute Text
tagname) [(Text, Text)]
as
     = do
       [Either (Text, [Tag Text]) (Text, Text)]
as' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
(Text, Text) -> m (Either (Text, [Tag Text]) (Text, Text))
processAttribute [(Text, Text)]
as
       let attrs :: [(Text, Text)]
attrs = forall a b. [Either a b] -> [b]
rights [Either (Text, [Tag Text]) (Text, Text)]
as'
       let svgContents :: [(Text, [Tag Text])]
svgContents = forall a b. [Either a b] -> [a]
lefts [Either (Text, [Tag Text]) (Text, Text)]
as'
       [Tag Text]
rest <- forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
ts
       case [(Text, [Tag Text])]
svgContents of
         [] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tagname [(Text, Text)]
attrs forall a. a -> [a] -> [a]
: [Tag Text]
rest
         ((Text
hash, [Tag Text]
tags) : [(Text, [Tag Text])]
_) -> do
             -- drop "</img>" if present
             let rest' :: [Tag Text]
rest' = case [Tag Text]
rest of
                           TagClose Text
tn : [Tag Text]
xs | Text
tn forall a. Eq a => a -> a -> Bool
== Text
tagname ->  [Tag Text]
xs
                           [Tag Text]
_ -> [Tag Text]
rest
             Map Text (Text, [(Text, Text)])
svgmap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ConvertState -> Map Text (Text, [(Text, Text)])
svgMap
             case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
hash Map Text (Text, [(Text, Text)])
svgmap of
               Just (Text
svgid, [(Text, Text)]
svgattrs) -> do
                 let attrs' :: [(Text, Text)]
attrs' = [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
combineSvgAttrs [(Text, Text)]
svgattrs [(Text, Text)]
attrs
                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"svg" [(Text, Text)]
attrs' forall a. a -> [a] -> [a]
:
                          forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"use" [(Text
"href", Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
svgid)] forall a. a -> [a] -> [a]
:
                          forall str. str -> Tag str
TagClose Text
"use" forall a. a -> [a] -> [a]
:
                          forall str. str -> Tag str
TagClose Text
"svg" forall a. a -> [a] -> [a]
:
                          [Tag Text]
rest'
               Maybe (Text, [(Text, Text)])
Nothing ->
                  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. Eq str => str -> Tag str -> Bool
isTagOpenName Text
"svg") [Tag Text]
tags of
                    TagOpen Text
"svg" [(Text, Text)]
svgattrs : [Tag Text]
tags' -> do
                      let attrs' :: [(Text, Text)]
attrs' = [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
combineSvgAttrs [(Text, Text)]
svgattrs [(Text, Text)]
attrs
                      let svgid :: Text
svgid = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"id" [(Text, Text)]
attrs' of
                                     Just Text
id' -> Text
id'
                                     Maybe Text
Nothing -> Text
"svg_" forall a. Semigroup a => a -> a -> a
<> Text
hash
                      let attrs'' :: [(Text, Text)]
attrs'' = [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
attrs', Text
k forall a. Eq a => a -> a -> Bool
/= Text
"id"]
                      forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ConvertState
st ->
                        ConvertState
st{ svgMap :: Map Text (Text, [(Text, Text)])
svgMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
hash (Text
svgid, [(Text, Text)]
attrs'') (ConvertState -> Map Text (Text, [(Text, Text)])
svgMap ConvertState
st) }
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
"svg" [(Text, Text)]
attrs'' forall a. a -> [a] -> [a]
: [Tag Text]
tags' forall a. [a] -> [a] -> [a]
++ [Tag Text]
rest'
                    [Tag Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall str. str -> [Attribute str] -> Tag str
TagOpen Text
tagname [(Text, Text)]
attrs forall a. a -> [a] -> [a]
: [Tag Text]
rest
  where processAttribute :: (Text, Text) -> m (Either (Text, [Tag Text]) (Text, Text))
processAttribute (Text
x,Text
y) =
           if Text -> (Text, Text) -> Bool
isSourceAttribute Text
tagname (Text
x,Text
y)
              then do
                GetDataResult
res <- forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
x, Text
enc)
                  Fetched (Text
"image/svg+xml", ByteString
bs) -> do
                    -- we filter CR in the hash to ensure that Windows
                    -- and non-Windows tests agree:
                    let hash :: Text
hash = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
20 forall a b. (a -> b) -> a -> b
$ forall t. Digest t -> String
showDigest forall a b. (a -> b) -> a -> b
$
                                        ByteString -> Digest SHA1State
sha1 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.fromStrict
                                             forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
B.filter (forall a. Eq a => a -> a -> Bool
/=Char
'\r') ByteString
bs
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Text
hash, Text -> [Tag Text]
getSvgTags (ByteString -> Text
toText ByteString
bs))
                  Fetched (Text
mt,ByteString
bs) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
x, (Text, ByteString) -> Text
makeDataURI (Text
mt,ByteString
bs))
                  CouldNotFetch PandocError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
x, Text
y)
              else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
x,Text
y)

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

-- we want to drop spaces, <?xml>, and comments before <svg>
-- and anything after </svg>:
getSvgTags :: T.Text -> [Tag T.Text]
getSvgTags :: Text -> [Tag Text]
getSvgTags Text
t =
  case forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. Eq str => str -> Tag str -> Bool
isTagCloseName Text
"svg") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. Eq str => str -> Tag str -> Bool
isTagOpenName Text
"svg") forall a b. (a -> b) -> a -> b
$ forall str. StringLike str => str -> [Tag str]
parseTags Text
t of
    [] -> []
    [Tag Text]
xs -> [Tag Text]
xs forall a. [a] -> [a] -> [a]
++ [forall str. str -> Tag str
TagClose Text
"svg"]

combineSvgAttrs :: [(T.Text, T.Text)] -> [(T.Text, T.Text)] -> [(T.Text, T.Text)]
combineSvgAttrs :: [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
combineSvgAttrs [(Text, Text)]
svgAttrs [(Text, Text)]
imgAttrs =
  case (Maybe (Double, Double, Double, Double)
mbViewBox, Maybe Int
mbHeight, Maybe Int
mbWidth) of
    (Maybe (Double, Double, Double, Double)
Nothing, Just Int
h, Just Int
w) -> -- calculate viewBox
      [(Text, Text)]
combinedAttrs forall a. [a] -> [a] -> [a]
++ [(Text
"viewBox", [Text] -> Text
T.unwords [Text
"0", Text
"0", forall a. Show a => a -> Text
tshow Int
w, forall a. Show a => a -> Text
tshow Int
h])]
    (Just (Double
_minx,Double
_miny,Double
w,Double
h), Maybe Int
Nothing, Maybe Int
Nothing) ->
        [(Text, Text)]
combinedAttrs forall a. [a] -> [a] -> [a]
++
        [ (Text
"width", Text -> Text
dropPointZero (forall a. Show a => a -> Text
tshow Double
w)) |
            forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
combinedAttrs) ] forall a. [a] -> [a] -> [a]
++
        [ (Text
"height", Text -> Text
dropPointZero (forall a. Show a => a -> Text
tshow Double
h)) |
            forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
combinedAttrs) ]
    (Maybe (Double, Double, Double, Double), Maybe Int, Maybe Int)
_ -> [(Text, Text)]
combinedAttrs
 where
  dropPointZero :: Text -> Text
dropPointZero Text
t = case Text -> Text -> Maybe Text
T.stripSuffix Text
".0" Text
t of
                       Maybe Text
Nothing -> Text
t
                       Just Text
t' -> Text
t'
  combinedAttrs :: [(Text, Text)]
combinedAttrs = [(Text, Text)]
imgAttrs forall a. [a] -> [a] -> [a]
++
    [(Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
svgAttrs
            , forall a. Maybe a -> Bool
isNothing (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
imgAttrs)
            , Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"xmlns", Text
"xmlns:xlink", Text
"version"]]
  parseViewBox :: Text -> Maybe (d, d, d, d)
parseViewBox Text
t =
    case forall a b. (a -> b) -> [a] -> [b]
map (forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addZero) forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
t of
      [Just d
llx, Just d
lly, Just d
urx, Just d
ury] -> forall a. a -> Maybe a
Just (d
llx, d
lly, d
urx, d
ury)
      [Maybe d]
_ -> forall a. Maybe a
Nothing
  addZero :: Text -> Text
addZero Text
t =
    if Text
"-." Text -> Text -> Bool
`T.isPrefixOf` Text
t
       then Text
"-0." forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
2 Text
t -- safeRead fails on -.33, needs -0.33
       else Text
t
  (Maybe (Double, Double, Double, Double)
mbViewBox :: Maybe (Double, Double, Double, Double)) =
        forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"viewBox" [(Text, Text)]
svgAttrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {d}. Read d => Text -> Maybe (d, d, d, d)
parseViewBox
  (Maybe Int
mbHeight :: Maybe Int) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"height" [(Text, Text)]
combinedAttrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
  (Maybe Int
mbWidth :: Maybe Int) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"width" [(Text, Text)]
combinedAttrs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead

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 <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (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
         forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> LogMessage
CouldNotParseCSS forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError
e
         forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
orig
       Right ByteString
bs  -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many
  (forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSWhite forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m ByteString
pCSSComment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSImport String
d forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
String -> ParsecT ByteString () m ByteString
pCSSUrl String
d forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"@import"
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Either ByteString (Text, ByteString)
res <- (forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pQuoted forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pUrl) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
PandocMonad m =>
String
-> (Text, ByteString)
-> ParsecT ByteString () m (Either ByteString (Text, ByteString))
handleCSSUrl String
d
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
';'
  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       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
"@import " forall a. Semigroup a => a -> a -> a
<> ByteString
b
       Right (Text
_, ByteString
b) -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string 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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"*/"))
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (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")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> ByteString
B.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char Char
'u') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Char -> ByteString
B.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
  Either ByteString (Text, ByteString)
res <- forall (m :: * -> *).
PandocMonad m =>
ParsecT ByteString () m (Text, ByteString)
pUrl forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 -> 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)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> ByteString
fromText forall a b. (a -> b) -> a -> b
$ Text
"url(" forall a. Semigroup a => a -> a -> a
<> Text
enc 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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
  Char
quote <- 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (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 forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
quote forall a. Semigroup a => a -> a -> a
<> Text -> Text
trim Text
url forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
quote
  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 = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
P.string String
"url("
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  Maybe Char
quote <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
P.anyChar (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
P.lookAhead (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
P.char 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)
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
P.spaces
  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(" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton Maybe Char
quote forall a. Semigroup a => a -> a -> a
<> Text -> Text
trim Text
url forall a. Semigroup a => a -> a -> a
<>
                            forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton Maybe Char
quote forall a. Semigroup a => a -> a -> a
<> Text
")")
  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 (forall a. Eq a => a -> a -> Bool
/=Char
'|') (Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
trim Text
url) of
      Char
'#':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ByteString
fallback
      Char
'd':Char
'a':Char
't':Char
'a':Char
':':String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
Text -> Text -> m GetDataResult
getData Text
"" Text
url'
               case GetDataResult
res of
                    AlreadyDataURI Text
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Text -> ByteString
fromText forall a b. (a -> b) -> a -> b
$ Text
"url(" forall a. Semigroup a => a -> a -> a
<> Text
uri 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",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs String
d ByteString
raw
                                    else forall (m :: * -> *) a. Monad m => a -> m a
return (Text
mt', ByteString
raw)
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Text
mt, ByteString
b)
                    CouldNotFetch PandocError
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GetDataResult] -> String -> String
$cshowList :: [GetDataResult] -> String -> String
show :: GetDataResult -> String
$cshow :: GetDataResult -> String
showsPrec :: Int -> GetDataResult -> String -> String
$cshowsPrec :: Int -> 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> GetDataResult
AlreadyDataURI Text
src -- already data: uri
  | Bool
otherwise = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m GetDataResult
fetcher forall {m :: * -> *}.
PandocMonad m =>
PandocError -> m GetDataResult
handler
 where
   fetcher :: m GetDataResult
fetcher = do
      let ext :: Text
ext = Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String -> String
takeExtension forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src
      (ByteString
raw, Maybe Text
respMime) <- forall (m :: * -> *).
PandocMonad m =>
Text -> m (ByteString, Maybe Text)
fetchItem Text
src
      let raw' :: ByteString
raw' = if Text
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
".gz", Text
".svgz"]
                 then [ByteString] -> ByteString
B.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Gzip.decompress 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 <- forall (m :: * -> *). PandocMonad m => m [String]
getInputFiles
                  forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [Text -> String
T.unpack Text
src]
                  ByteString
res <- forall (m :: * -> *).
PandocMonad m =>
String -> ByteString -> m ByteString
cssURLs (String -> String
takeDirectory forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
src) ByteString
raw'
                  forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [String]
oldInputs
                  forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
res
               else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
raw'
      forall (m :: * -> *) a. Monad m => a -> m a
return 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
                   forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
r Text
""
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
                 PandocHttpError Text
u HttpException
er -> do
                   forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Text -> Text -> LogMessage
CouldNotFetchResource Text
u (forall a. Show a => a -> Text
tshow HttpException
er)
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PandocError -> GetDataResult
CouldNotFetch PandocError
e
                 PandocError
_ -> 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 = forall str. StringLike str => str -> [Tag str]
parseTags Text
inp
  let html5 :: Bool
html5 = case [Tag Text]
tags of
                  (TagOpen Text
"!DOCTYPE" [(Text
"html",Text
"")]:[Tag Text]
_) -> Bool
True
                  [Tag Text]
_ -> Bool
False
  let convertState :: ConvertState
convertState = ConvertState { isHtml5 :: Bool
isHtml5 = Bool
html5,
                                    svgMap :: Map Text (Text, [(Text, Text)])
svgMap = forall a. Monoid a => a
mempty }
  [Tag Text]
out' <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *).
PandocMonad m =>
[Tag Text] -> StateT ConvertState m [Tag Text]
convertTags [Tag Text]
tags) ConvertState
convertState
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Tag Text] -> Text
renderTags' [Tag Text]
out'