{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{- |
   Module      : Text.Pandoc.Shared
   Copyright   : Copyright (C) 2006-2022 John MacFarlane
   License     : GNU GPL, version 2 or above

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

Utility functions and definitions used by the various Pandoc modules.
-}
module Text.Pandoc.Shared (
                     -- * List processing
                     splitBy,
                     splitTextBy,
                     splitTextByIndices,
                     ordNub,
                     findM,
                     -- * Text processing
                     inquotes,
                     tshow,
                     elemText,
                     notElemText,
                     stripTrailingNewlines,
                     trim,
                     triml,
                     trimr,
                     trimMath,
                     stripFirstAndLast,
                     camelCaseToHyphenated,
                     camelCaseStrToHyphenated,
                     toRomanNumeral,
                     escapeURI,
                     tabFilter,
                     crFilter,
                     -- * Date/time
                     normalizeDate,
                     -- * Pandoc block and inline list processing
                     orderedListMarkers,
                     extractSpaces,
                     removeFormatting,
                     deNote,
                     deLink,
                     stringify,
                     capitalize,
                     compactify,
                     compactifyDL,
                     linesToPara,
                     makeSections,
                     uniqueIdent,
                     inlineListToIdentifier,
                     isHeaderBlock,
                     headerShift,
                     stripEmptyParagraphs,
                     onlySimpleTableCells,
                     isTightList,
                     taskListItemFromAscii,
                     taskListItemToAscii,
                     handleTaskListItem,
                     addMetaField,
                     makeMeta,
                     eastAsianLineBreakFilter,
                     htmlSpanLikeElements,
                     filterIpynbOutput,
                     formatCode,
                     -- * TagSoup HTML handling
                     renderTags',
                     -- * File handling
                     inDirectory,
                     collapseFilePath,
                     uriPathToPath,
                     filteredFilesFromArchive,
                     -- * URI handling
                     schemes,
                     isURI,
                     -- * Error handling
                     mapLeft,
                     -- * for squashing blocks
                     blocksToInlines,
                     blocksToInlines',
                     blocksToInlinesWithSep,
                     defaultBlocksSeparator,
                     -- * Safe read
                     safeRead,
                     safeStrRead,
                     -- * User data directory
                     defaultUserDataDir,
                     -- * Version
                     pandocVersion
                    ) where

import Codec.Archive.Zip
import qualified Control.Exception as E
import Control.Monad (MonadPlus (..), msum, unless)
import qualified Control.Monad.State.Strict as S
import qualified Data.ByteString.Lazy as BL
import qualified Data.Bifunctor as Bifunctor
import Data.Char (isAlpha, isLower, isSpace, isUpper, toLower, isAlphaNum,
                  generalCategory, GeneralCategory(NonSpacingMark,
                  SpacingCombiningMark, EnclosingMark, ConnectorPunctuation))
import Data.Containers.ListUtils (nubOrd)
import Data.List (find, intercalate, intersperse, sortOn, foldl', groupBy)
import qualified Data.Map as M
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Monoid (Any (..))
import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr)
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Version (showVersion)
import Network.URI (URI (uriScheme), escapeURIString, parseURI)
import Paths_pandoc (version)
import System.Directory
import System.FilePath (isPathSeparator, splitDirectories)
import qualified System.FilePath.Posix as Posix
import Text.HTML.TagSoup (RenderOptions (..), Tag (..), renderOptions,
                          renderTagsOptions)
import Text.Pandoc.Builder (Blocks, Inlines, ToMetaValue (..))
import qualified Text.Pandoc.Builder as B
import Data.Time
import Text.Pandoc.Asciify (toAsciiText)
import Text.Pandoc.Definition
import Text.Pandoc.Extensions (Extensions, Extension(..), extensionEnabled)
import Text.Pandoc.Generic (bottomUp)
import Text.DocLayout (charWidth)
import Text.Pandoc.Walk

-- | Version number of pandoc library.
pandocVersion :: T.Text
pandocVersion :: Text
pandocVersion = FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVersion Version
version

--
-- List processing
--

-- | Split list by groups of one or more sep.
splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy :: forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
_ [] = []
splitBy a -> Bool
isSep [a]
lst =
  let ([a]
first, [a]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
isSep [a]
lst
  in  [a]
firstforall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [[a]]
splitBy a -> Bool
isSep (forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
isSep [a]
rest)

-- | Split text by groups of one or more separator.
splitTextBy :: (Char -> Bool) -> T.Text -> [T.Text]
splitTextBy :: (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
isSep Text
t
  | Text -> Bool
T.null Text
t = []
  | Bool
otherwise = let (Text
first, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break Char -> Bool
isSep Text
t
                in  Text
first forall a. a -> [a] -> [a]
: (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
isSep ((Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSep Text
rest)

-- | Split text at the given widths. Note that the break points are
-- /not/ indices but text widths, which will be different for East Asian
-- characters, emojis, etc.
splitTextByIndices :: [Int] -> T.Text -> [T.Text]
splitTextByIndices :: [Int] -> Text -> [Text]
splitTextByIndices [Int]
ns = [Int] -> FilePath -> [Text]
splitTextByRelIndices (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
ns (Int
0forall a. a -> [a] -> [a]
:[Int]
ns)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
 where
  splitTextByRelIndices :: [Int] -> FilePath -> [Text]
splitTextByRelIndices [] FilePath
cs = [FilePath -> Text
T.pack FilePath
cs]
  splitTextByRelIndices (Int
x:[Int]
xs) FilePath
cs =
    let (FilePath
first, FilePath
rest) = Int -> FilePath -> (FilePath, FilePath)
splitAt' Int
x FilePath
cs
     in FilePath -> Text
T.pack FilePath
first forall a. a -> [a] -> [a]
: [Int] -> FilePath -> [Text]
splitTextByRelIndices [Int]
xs FilePath
rest

-- | Returns a pair whose first element is a prefix of @t@ and that has
-- width @n@, and whose second is the remainder of the string.
--
-- Note: Do *not* replace this with 'T.splitAt', which is not sensitive
-- to character widths!
splitAt' :: Int {-^ n -} -> [Char] {-^ t -} -> ([Char],[Char])
splitAt' :: Int -> FilePath -> (FilePath, FilePath)
splitAt' Int
_ []          = ([],[])
splitAt' Int
n FilePath
xs | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ([],FilePath
xs)
splitAt' Int
n (Char
x:FilePath
xs)      = (Char
xforall a. a -> [a] -> [a]
:FilePath
ys,FilePath
zs)
  where (FilePath
ys,FilePath
zs) = Int -> FilePath -> (FilePath, FilePath)
splitAt' (Int
n forall a. Num a => a -> a -> a
- Char -> Int
charWidth Char
x) FilePath
xs

-- | Remove duplicates from a list.
ordNub :: (Ord a) => [a] -> [a]
ordNub :: forall a. Ord a => [a] -> [a]
ordNub = forall a. Ord a => [a] -> [a]
nubOrd
{-# INLINE ordNub #-}

-- | Returns the first element in a foldable structure for that the
-- monadic predicate holds true, and @Nothing@ if no such element
-- exists.
findM :: forall m t a. (Monad m, Foldable t)
      => (a -> m Bool) -> t a -> m (Maybe a)
findM :: forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m (Maybe a) -> m (Maybe a)
go (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
  where
    go :: a -> m (Maybe a) -> m (Maybe a)
    go :: a -> m (Maybe a) -> m (Maybe a)
go a
x m (Maybe a)
acc = do
      Bool
b <- a -> m Bool
p a
x
      if Bool
b then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just a
x) else m (Maybe a)
acc

--
-- Text processing
--

-- | Wrap double quotes around a Text
inquotes :: T.Text -> T.Text
inquotes :: Text -> Text
inquotes Text
txt = Char -> Text -> Text
T.cons Char
'\"' (Text -> Char -> Text
T.snoc Text
txt Char
'\"')

-- | Like @'show'@, but returns a 'T.Text' instead of a 'String'.
tshow :: Show a => a -> T.Text
tshow :: forall a. Show a => a -> Text
tshow = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show

-- | @True@ exactly when the @Char@ appears in the @Text@.
elemText :: Char -> T.Text -> Bool
elemText :: Char -> Text -> Bool
elemText Char
c = (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
c)

-- | @True@ exactly when the @Char@ does not appear in the @Text@.
notElemText :: Char -> T.Text -> Bool
notElemText :: Char -> Text -> Bool
notElemText Char
c = (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
/= Char
c)

-- | Strip trailing newlines from string.
stripTrailingNewlines :: T.Text -> T.Text
stripTrailingNewlines :: Text -> Text
stripTrailingNewlines = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | Returns 'True' for an ASCII whitespace character, viz. space,
-- carriage return, newline, and horizontal tab.
isWS :: Char -> Bool
isWS :: Char -> Bool
isWS Char
' '  = Bool
True
isWS Char
'\r' = Bool
True
isWS Char
'\n' = Bool
True
isWS Char
'\t' = Bool
True
isWS Char
_    = Bool
False

-- | Remove leading and trailing space (including newlines) from string.
trim :: T.Text -> T.Text
trim :: Text -> Text
trim = (Char -> Bool) -> Text -> Text
T.dropAround Char -> Bool
isWS

-- | Remove leading space (including newlines) from string.
triml :: T.Text -> T.Text
triml :: Text -> Text
triml = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isWS

-- | Remove trailing space (including newlines) from string.
trimr :: T.Text -> T.Text
trimr :: Text -> Text
trimr = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isWS

-- | Trim leading space and trailing space unless after \.
trimMath :: T.Text -> T.Text
trimMath :: Text -> Text
trimMath = Text -> Text
triml forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripBeginSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse -- no Text.spanEnd
  where
    stripBeginSpace :: Text -> Text
stripBeginSpace Text
t
      | Text -> Bool
T.null Text
pref = Text
t
      | Just (Char
'\\', Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
suff = Char -> Text -> Text
T.cons (Text -> Char
T.last Text
pref) Text
suff
      | Bool
otherwise = Text
suff
      where
        (Text
pref, Text
suff) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isWS Text
t

-- | Strip leading and trailing characters from string
stripFirstAndLast :: T.Text -> T.Text
stripFirstAndLast :: Text -> Text
stripFirstAndLast Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
  Just (Char
_, Text
t') -> case Text -> Maybe (Text, Char)
T.unsnoc Text
t' of
    Just (Text
t'', Char
_) -> Text
t''
    Maybe (Text, Char)
_             -> Text
t'
  Maybe (Char, Text)
_               -> Text
""

-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
camelCaseToHyphenated :: T.Text -> T.Text
camelCaseToHyphenated :: Text -> Text
camelCaseToHyphenated = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
camelCaseStrToHyphenated forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

-- This may not work as expected on general Unicode, if it contains
-- letters with a longer lower case form than upper case. I don't know
-- what the camel case practices of affected scripts are, though.
camelCaseStrToHyphenated :: String -> String
camelCaseStrToHyphenated :: FilePath -> FilePath
camelCaseStrToHyphenated [] = FilePath
""
camelCaseStrToHyphenated (Char
a:Char
b:FilePath
rest)
  | Char -> Bool
isLower Char
a
  , Char -> Bool
isUpper Char
b = Char
aforall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bforall a. a -> [a] -> [a]
:FilePath -> FilePath
camelCaseStrToHyphenated FilePath
rest
-- handle ABCDef = abc-def
camelCaseStrToHyphenated (Char
a:Char
b:Char
c:FilePath
rest)
  | Char -> Bool
isUpper Char
a
  , Char -> Bool
isUpper Char
b
  , Char -> Bool
isLower Char
c = Char -> Char
toLower Char
aforall a. a -> [a] -> [a]
:Char
'-'forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bforall a. a -> [a] -> [a]
:FilePath -> FilePath
camelCaseStrToHyphenated (Char
cforall a. a -> [a] -> [a]
:FilePath
rest)
camelCaseStrToHyphenated (Char
a:FilePath
rest) = Char -> Char
toLower Char
aforall a. a -> [a] -> [a]
:FilePath -> FilePath
camelCaseStrToHyphenated FilePath
rest

-- | Convert number < 4000 to uppercase roman numeral.
toRomanNumeral :: Int -> T.Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"CM" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
900)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"D" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
500)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"CD" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
400)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"C" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
100)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"XC" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
90)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"L"  forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
50)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"XL" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
40)
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"X" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
10)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"IX"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"V" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
5)
  | Int
x forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"IV"
  | Int
x forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"I" forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise = Text
""

-- | Escape whitespace and some punctuation characters in URI.
escapeURI :: T.Text -> T.Text
escapeURI :: Text -> Text
escapeURI = FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
escapeURIString (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
needsEscaping) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
  where needsEscaping :: Char -> Bool
needsEscaping Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Text -> Bool
`elemText` Text
"<>|\"{}[]^`"


-- | Convert tabs to spaces. Tabs will be preserved if tab stop is set to 0.
tabFilter :: Int       -- ^ Tab stop
          -> T.Text    -- ^ Input
          -> T.Text
tabFilter :: Int -> Text -> Text
tabFilter Int
0 = forall a. a -> a
id
tabFilter Int
tabStop = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where go :: Text -> Text
go Text
s =
         let (Text
s1, Text
s2) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'\t') Text
s
         in  if Text -> Bool
T.null Text
s2
                then Text
s1
                else Text
s1 forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate
                       (Int
tabStop forall a. Num a => a -> a -> a
- (Text -> Int
T.length Text
s1 forall a. Integral a => a -> a -> a
`mod` Int
tabStop)) (FilePath -> Text
T.pack FilePath
" ")
                       forall a. Semigroup a => a -> a -> a
<> Text -> Text
go (Int -> Text -> Text
T.drop Int
1 Text
s2)

{-# DEPRECATED crFilter "readers filter crs automatically" #-}
-- | Strip out DOS line endings.
crFilter :: T.Text -> T.Text
crFilter :: Text -> Text
crFilter = (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')

--
-- Date/time
--

-- | Parse a date and convert (if possible) to "YYYY-MM-DD" format. We
-- limit years to the range 1601-9999 (ISO 8601 accepts greater than
-- or equal to 1583, but MS Word only accepts dates starting 1601).
normalizeDate :: T.Text -> Maybe T.Text
normalizeDate :: Text -> Maybe Text
normalizeDate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
normalizeDate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

-- | Like @'normalizeDate'@, but acts on 'String' instead of 'T.Text'.
normalizeDate' :: String -> Maybe String
normalizeDate' :: FilePath -> Maybe FilePath
normalizeDate' FilePath
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%F")
  (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
fs -> FilePath -> FilePath -> Maybe Day
parsetimeWith FilePath
fs FilePath
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Day -> Maybe Day
rejectBadYear) [FilePath]
formats :: Maybe Day)
  where rejectBadYear :: Day -> Maybe Day
rejectBadYear Day
day = case Day -> (Year, Int, Int)
toGregorian Day
day of
          (Year
y, Int
_, Int
_) | Year
y forall a. Ord a => a -> a -> Bool
>= Year
1601 Bool -> Bool -> Bool
&& Year
y forall a. Ord a => a -> a -> Bool
<= Year
9999 -> forall a. a -> Maybe a
Just Day
day
          (Year, Int, Int)
_         -> forall a. Maybe a
Nothing
        parsetimeWith :: FilePath -> FilePath -> Maybe Day
parsetimeWith = forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
        formats :: [FilePath]
formats = [FilePath
"%x",FilePath
"%m/%d/%Y", FilePath
"%D",FilePath
"%F", FilePath
"%d %b %Y",
                    FilePath
"%e %B %Y", FilePath
"%b. %e, %Y", FilePath
"%B %e, %Y",
                    FilePath
"%Y%m%d", FilePath
"%Y%m", FilePath
"%Y"]

--
-- Pandoc block and inline list processing
--

-- | Generate infinite lazy list of markers for an ordered list,
-- depending on list attributes.
orderedListMarkers :: (Int, ListNumberStyle, ListNumberDelim) -> [T.Text]
orderedListMarkers :: (Int, ListNumberStyle, ListNumberDelim) -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
numstyle, ListNumberDelim
numdelim) =
  let nums :: [Text]
nums = case ListNumberStyle
numstyle of
                     ListNumberStyle
DefaultStyle -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Example      -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Decimal      -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
UpperAlpha   -> forall a. Int -> [a] -> [a]
drop (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$
                                     forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A'..Char
'Z']
                     ListNumberStyle
LowerAlpha   -> forall a. Int -> [a] -> [a]
drop (Int
start forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$
                                     forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'a'..Char
'z']
                     ListNumberStyle
UpperRoman   -> forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
toRomanNumeral [Int
start..]
                     ListNumberStyle
LowerRoman   -> forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
toRomanNumeral) [Int
start..]
      inDelim :: a -> a
inDelim a
str = case ListNumberDelim
numdelim of
                            ListNumberDelim
DefaultDelim -> a
str forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
Period       -> a
str forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
OneParen     -> a
str forall a. Semigroup a => a -> a -> a
<> a
")"
                            ListNumberDelim
TwoParens    -> a
"(" forall a. Semigroup a => a -> a -> a
<> a
str forall a. Semigroup a => a -> a -> a
<> a
")"
  in  forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => a -> a
inDelim [Text]
nums


-- | Extract the leading and trailing spaces from inside an inline element
-- and place them outside the element.  SoftBreaks count as Spaces for
-- these purposes.
extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces :: (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f Inlines
is =
  let contents :: Seq Inline
contents = forall a. Many a -> Seq a
B.unMany Inlines
is
      left :: Inlines
left  = case forall a. Seq a -> ViewL a
viewl Seq Inline
contents of
                    (Inline
Space :< Seq Inline
_)     -> Inlines
B.space
                    (Inline
SoftBreak :< Seq Inline
_) -> Inlines
B.softbreak
                    ViewL Inline
_                -> forall a. Monoid a => a
mempty
      right :: Inlines
right = case forall a. Seq a -> ViewR a
viewr Seq Inline
contents of
                    (Seq Inline
_ :> Inline
Space)     -> Inlines
B.space
                    (Seq Inline
_ :> Inline
SoftBreak) -> Inlines
B.softbreak
                    ViewR Inline
_                -> forall a. Monoid a => a
mempty in
  (Inlines
left forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
f (Inlines -> Inlines
B.trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Many a
B.Many forall a b. (a -> b) -> a -> b
$ Seq Inline
contents) forall a. Semigroup a => a -> a -> a
<> Inlines
right)

-- | Extract inlines, removing formatting.
removeFormatting :: Walkable Inline a => a -> [Inline]
removeFormatting :: forall a. Walkable Inline a => a -> [Inline]
removeFormatting = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
deQuote)
  where go :: Inline -> [Inline]
        go :: Inline -> [Inline]
go (Str Text
xs)   = [Text -> Inline
Str Text
xs]
        go Inline
Space      = [Inline
Space]
        go Inline
SoftBreak  = [Inline
SoftBreak]
        go (Code Attr
_ Text
x) = [Text -> Inline
Str Text
x]
        go (Math MathType
_ Text
x) = [Text -> Inline
Str Text
x]
        go Inline
LineBreak  = [Inline
Space]
        go Inline
_          = []

-- | Replaces 'Note' elements with empty strings.
deNote :: Inline -> Inline
deNote :: Inline -> Inline
deNote (Note [Block]
_) = Text -> Inline
Str Text
""
deNote Inline
x        = Inline
x

-- {- DEPRECATED deLink "deLink will be removed in a future version" -}
-- | Turns links into spans, keeping just the link text.
deLink :: Inline -> Inline
deLink :: Inline -> Inline
deLink (Link Attr
_ [Inline]
ils (Text, Text)
_) = Attr -> [Inline] -> Inline
Span Attr
nullAttr [Inline]
ils
deLink Inline
x              = Inline
x

-- | Convert pandoc structure to a string with formatting removed.
-- Footnotes are skipped (since we don't want their contents in link
-- labels).
stringify :: Walkable Inline a => a -> T.Text
stringify :: forall a. Walkable Inline a => a -> Text
stringify = forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
fixInlines
  where go :: Inline -> T.Text
        go :: Inline -> Text
go Inline
Space                                       = Text
" "
        go Inline
SoftBreak                                   = Text
" "
        go (Str Text
x)                                     = Text
x
        go (Code Attr
_ Text
x)                                  = Text
x
        go (Math MathType
_ Text
x)                                  = Text
x
        go (RawInline (Format Text
"html") (Text -> FilePath
T.unpack -> (Char
'<':Char
'b':Char
'r':FilePath
_)))
                                                       = Text
" " -- see #2105
        go Inline
LineBreak                                   = Text
" "
        go Inline
_                                           = Text
""

        fixInlines :: Inline -> Inline
        fixInlines :: Inline -> Inline
fixInlines (Cite [Citation]
_ [Inline]
ils) = [Citation] -> [Inline] -> Inline
Cite [] [Inline]
ils
        fixInlines (Note [Block]
_) = [Block] -> Inline
Note []
        fixInlines (q :: Inline
q@Quoted{}) = Inline -> Inline
deQuote Inline
q
        fixInlines Inline
x = Inline
x

-- | Unwrap 'Quoted' inline elements, enclosing the contents with
-- English-style Unicode quotes instead.
deQuote :: Inline -> Inline
deQuote :: Inline -> Inline
deQuote (Quoted QuoteType
SingleQuote [Inline]
xs) =
  Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8216" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8217"])
deQuote (Quoted QuoteType
DoubleQuote [Inline]
xs) =
  Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8220" forall a. a -> [a] -> [a]
: [Inline]
xs forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
deQuote Inline
x = Inline
x

-- | Bring all regular text in a pandoc structure to uppercase.
--
-- This function correctly handles cases where a lowercase character doesn't
-- match to a single uppercase character – e.g. “Straße” would be converted
-- to “STRASSE”, not “STRAßE”.
capitalize :: Walkable Inline a => a -> a
capitalize :: forall a. Walkable Inline a => a -> a
capitalize = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
go
  where go :: Inline -> Inline
        go :: Inline -> Inline
go (Str Text
s) = Text -> Inline
Str forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
s
        go Inline
x       = Inline
x

-- | Change final list item from @Para@ to @Plain@ if the list contains
-- no other @Para@ blocks.  Otherwise (if the list items contain @Para@
-- blocks besides possibly at the end), turn any @Plain@s into @Para@s (#5285).
compactify :: [Blocks]  -- ^ List of list items (each a list of blocks)
           -> [Blocks]
compactify :: [Blocks] -> [Blocks]
compactify [] = []
compactify [Blocks]
items =
  let ([Blocks]
others, Blocks
final) = (forall a. [a] -> [a]
init [Blocks]
items, forall a. [a] -> a
last [Blocks]
items)
  in  case forall a. [a] -> [a]
reverse (forall a. Many a -> [a]
B.toList Blocks
final) of
           (Para [Inline]
a:[Block]
xs)
             | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- [Block]
xs forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Many a -> [a]
B.toList [Blocks]
others]
             -> [Blocks]
others forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> Many a
B.fromList (forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
a forall a. a -> [a] -> [a]
: [Block]
xs))]
           [Block]
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Many a -> [a]
B.toList [Blocks]
items]
             -> [Blocks]
items
           [Block]
_ -> forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Block -> Block
plainToPara) [Blocks]
items

plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
ils) = [Inline] -> Block
Para [Inline]
ils
plainToPara Block
x = Block
x


-- | Like @compactify@, but acts on items of definition lists.
compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
compactifyDL [(Inlines, [Blocks])]
items =
  case forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
items of
        ((Inlines
t,[Blocks]
ds):[(Inlines, [Blocks])]
ys) ->
           case forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList) [Blocks]
ds) of
             ((Para [Inline]
x:[Block]
xs) : [[Block]]
zs) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isPara [Block]
xs) ->
                  forall a. [a] -> [a]
reverse [(Inlines, [Blocks])]
ys forall a. [a] -> [a] -> [a]
++
                    [(Inlines
t, forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList [[Block]]
zs) forall a. [a] -> [a] -> [a]
++
                         [forall a. [a] -> Many a
B.fromList (forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
xforall a. a -> [a] -> [a]
:[Block]
xs))])]
             [[Block]]
_     -> [(Inlines, [Blocks])]
items
        [(Inlines, [Blocks])]
_          -> [(Inlines, [Blocks])]
items


-- | Combine a list of lines by adding hard linebreaks.
combineLines :: [[Inline]] -> [Inline]
combineLines :: [[Inline]] -> [Inline]
combineLines = forall a. [a] -> [[a]] -> [a]
intercalate [Inline
LineBreak]

-- | Convert a list of lines into a paragraph with hard line breaks. This is
--   useful e.g. for rudimentary support of LineBlock elements in writers.
linesToPara :: [[Inline]] -> Block
linesToPara :: [[Inline]] -> Block
linesToPara = [Inline] -> Block
Para forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Inline]] -> [Inline]
combineLines

isPara :: Block -> Bool
isPara :: Block -> Bool
isPara (Para [Inline]
_) = Bool
True
isPara Block
_        = Bool
False

-- | Convert Pandoc inline list to plain text identifier.  HTML
-- identifiers must start with a letter, and may contain only
-- letters, digits, and the characters _-.
inlineListToIdentifier :: Extensions -> [Inline] -> T.Text
inlineListToIdentifier :: Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
exts =
  Text -> Text
dropNonLetter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterAscii forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toIdent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Walkable Inline a => a -> Text
stringify forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
unEmojify
  where
    unEmojify :: [Inline] -> [Inline]
    unEmojify :: [Inline] -> [Inline]
unEmojify
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts Bool -> Bool -> Bool
||
        Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_ascii_identifiers Extensions
exts = forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unEmoji
      | Bool
otherwise = forall a. a -> a
id
    unEmoji :: Inline -> Inline
unEmoji (Span (Text
"",[Text
"emoji"],[(Text
"data-emoji",Text
ename)]) [Inline]
_) = Text -> Inline
Str Text
ename
    unEmoji Inline
x = Inline
x
    dropNonLetter :: Text -> Text
dropNonLetter
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts = forall a. a -> a
id
      | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha)
    filterAscii :: Text -> Text
filterAscii
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_ascii_identifiers Extensions
exts
        = Text -> Text
toAsciiText
      | Bool
otherwise = forall a. a -> a
id
    toIdent :: Text -> Text
toIdent
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts =
        Text -> Text
filterPunct forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
spaceToDash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
      | Bool
otherwise = Text -> [Text] -> Text
T.intercalate Text
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterPunct forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
    filterPunct :: Text -> Text
filterPunct = (Char -> Bool) -> Text -> Text
T.filter (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAllowedPunct Char
c)
    isAllowedPunct :: Char -> Bool
isAllowedPunct Char
c
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts
        = Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
          Char -> GeneralCategory
generalCategory Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark,
                                    GeneralCategory
EnclosingMark, GeneralCategory
ConnectorPunctuation]
      | Bool
otherwise = Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.'
    spaceToDash :: Text -> Text
spaceToDash = (Char -> Char) -> Text -> Text
T.map (\Char
c -> if Char -> Bool
isSpace Char
c then Char
'-' else Char
c)


-- | Put a list of Pandoc blocks into a hierarchical structure:
-- a list of sections (each a Div with class "section" and first
-- element a Header).  If the 'numbering' parameter is True, Header
-- numbers are added via the number attribute on the header.
-- If the baseLevel parameter is Just n, Header levels are
-- adjusted to be gapless starting at level n.
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections :: Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
numbering Maybe Int
mbBaseLevel [Block]
bs =
  forall s a. State s a -> s -> a
S.evalState ([Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
bs) (Maybe Int
mbBaseLevel, [])
 where
  go :: [Block] -> S.State (Maybe Int, [Int]) [Block]
  go :: [Block] -> State (Maybe Int, [Int]) [Block]
go (Header Int
level (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
title':[Block]
xs) = do
    (Maybe Int
mbLevel, [Int]
lastnum) <- forall s (m :: * -> *). MonadState s m => m s
S.get
    let level' :: Int
level' = forall a. a -> Maybe a -> a
fromMaybe Int
level Maybe Int
mbLevel
    let lastnum' :: [Int]
lastnum' = forall a. Int -> [a] -> [a]
take Int
level' [Int]
lastnum
    let newnum :: [Int]
newnum =
          if Int
level' forall a. Ord a => a -> a -> Bool
> Int
0
             then case forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum' of
                      Int
x | Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> []
                        | Int
x forall a. Ord a => a -> a -> Bool
>= Int
level' -> forall a. [a] -> [a]
init [Int]
lastnum' forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [Int]
lastnum' forall a. Num a => a -> a -> a
+ Int
1]
                        | Bool
otherwise -> [Int]
lastnum forall a. [a] -> [a] -> [a]
++
                             forall a. Int -> a -> [a]
replicate (Int
level' forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum forall a. Num a => a -> a -> a
- Int
1) Int
0 forall a. [a] -> [a] -> [a]
++ [Int
1]
             else []
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
newnum) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
mbl, [Int]
_) -> (Maybe Int
mbl, [Int]
newnum)
    let ([Block]
sectionContents, [Block]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
level) [Block]
xs
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
_, [Int]
ln) -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Num a => a -> a -> a
+ Int
1) Maybe Int
mbLevel, [Int]
ln)
    [Block]
sectionContents' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
sectionContents
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify forall a b. (a -> b) -> a -> b
$ \(Maybe Int
_, [Int]
ln) -> (Maybe Int
mbLevel, [Int]
ln)
    [Block]
rest' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
rest
    let kvs' :: [(Text, Text)]
kvs' = -- don't touch number if already present
               case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
                  Maybe Text
Nothing | Bool
numbering
                          , Text
"unnumbered" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes ->
                        (Text
"number", Text -> [Text] -> Text
T.intercalate Text
"." (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> Text
tshow [Int]
newnum)) forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                  Maybe Text
_ -> [(Text, Text)]
kvs
    let divattr :: Attr
divattr = (Text
ident, Text
"section"forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs')
    let attr :: Attr
attr = (Text
"",[Text]
classes,[(Text, Text)]
kvs')
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      Attr -> [Block] -> Block
Div Attr
divattr (Int -> Attr -> [Inline] -> Block
Header Int
level' Attr
attr [Inline]
title' forall a. a -> [a] -> [a]
: [Block]
sectionContents') forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Div divattr :: Attr
divattr@(Text
dident,[Text]
dclasses,[(Text, Text)]
_) (Header Int
level Attr
hattr [Inline]
title':[Block]
ys) : [Block]
xs)
      | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
               Header Int
level' Attr
_ [Inline]
_ -> Int
level' forall a. Ord a => a -> a -> Bool
> Int
level
               Block
_                 -> Bool
True) [Block]
ys
      , Text
"column" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"columns" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"fragment" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses = do
    [Block]
inner <- [Block] -> State (Maybe Int, [Int]) [Block]
go (Int -> Attr -> [Inline] -> Block
Header Int
level Attr
hattr [Inline]
title'forall a. a -> [a] -> [a]
:[Block]
ys)
    [Block]
rest <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      case [Block]
inner of
            [Div divattr' :: Attr
divattr'@(Text
dident',[Text]
_,[(Text, Text)]
_) [Block]
zs]
              | Text -> Bool
T.null Text
dident Bool -> Bool -> Bool
|| Text -> Bool
T.null Text
dident' Bool -> Bool -> Bool
|| Text
dident forall a. Eq a => a -> a -> Bool
== Text
dident'
              -> Attr -> [Block] -> Block
Div (Attr -> Attr -> Attr
combineAttr Attr
divattr' Attr
divattr) [Block]
zs forall a. a -> [a] -> [a]
: [Block]
rest
            [Block]
_ -> Attr -> [Block] -> Block
Div Attr
divattr [Block]
inner forall a. a -> [a] -> [a]
: [Block]
rest
  go (Div Attr
attr [Block]
xs : [Block]
rest) = do
    [Block]
xs' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
    [Block]
rest' <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
rest
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
attr [Block]
xs' forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Block
Null:[Block]
xs) = [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
  go (Block
x:[Block]
xs) = (Block
x forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
  go [] = forall (m :: * -> *) a. Monad m => a -> m a
return []

  combineAttr :: Attr -> Attr -> Attr
  combineAttr :: Attr -> Attr -> Attr
combineAttr (Text
id1, [Text]
classes1, [(Text, Text)]
kvs1) (Text
id2, [Text]
classes2, [(Text, Text)]
kvs2) =
    (if Text -> Bool
T.null Text
id1 then Text
id2 else Text
id1,
     forall a. Ord a => [a] -> [a]
ordNub ([Text]
classes1 forall a. [a] -> [a] -> [a]
++ [Text]
classes2),
     forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
k,Text
v) [(Text, Text)]
kvs -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> (Text
k,Text
v)forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs
                             Just Text
_  -> [(Text, Text)]
kvs) forall a. Monoid a => a
mempty ([(Text, Text)]
kvs1 forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
kvs2))

headerLtEq :: Int -> Block -> Bool
headerLtEq :: Int -> Block -> Bool
headerLtEq Int
level (Header Int
l Attr
_ [Inline]
_)  = Int
l forall a. Ord a => a -> a -> Bool
<= Int
level
headerLtEq Int
level (Div Attr
_ (Block
b:[Block]
_))   = Int -> Block -> Bool
headerLtEq Int
level Block
b
headerLtEq Int
_ Block
_                   = Bool
False

-- | Generate a unique identifier from a list of inlines.
-- Second argument is a list of already used identifiers.
uniqueIdent :: Extensions -> [Inline] -> Set.Set T.Text -> T.Text
uniqueIdent :: Extensions -> [Inline] -> Set Text -> Text
uniqueIdent Extensions
exts [Inline]
title' Set Text
usedIdents =
  if Text
baseIdent forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
usedIdents
     then forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent forall a. Show a => a -> Text
numIdent
          forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> forall a. Show a => a -> Text
numIdent Int
x forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
usedIdents) ([Int
1..Int
60000] :: [Int])
          -- if we have more than 60,000, allow repeats
     else Text
baseIdent
  where
    baseIdent :: Text
baseIdent = case Extensions -> [Inline] -> Text
inlineListToIdentifier Extensions
exts [Inline]
title' of
                     Text
"" -> Text
"section"
                     Text
x  -> Text
x
    numIdent :: a -> Text
numIdent a
n = Text
baseIdent forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow a
n

-- | True if block is a Header block.
isHeaderBlock :: Block -> Bool
isHeaderBlock :: Block -> Bool
isHeaderBlock Header{} = Bool
True
isHeaderBlock Block
_        = Bool
False

-- | Shift header levels up or down.
headerShift :: Int -> Pandoc -> Pandoc
headerShift :: Int -> Pandoc -> Pandoc
headerShift Int
n (Pandoc Meta
meta (Header Int
m Attr
_ [Inline]
ils : [Block]
bs))
  | Int
n forall a. Ord a => a -> a -> Bool
< Int
0
  , Int
m forall a. Num a => a -> a -> a
+ Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Pandoc -> Pandoc
headerShift Int
n forall a b. (a -> b) -> a -> b
$
                 Inlines -> Pandoc -> Pandoc
B.setTitle (forall a. [a] -> Many a
B.fromList [Inline]
ils) forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
bs
headerShift Int
n (Pandoc Meta
meta [Block]
bs) = Meta -> [Block] -> Pandoc
Pandoc Meta
meta (forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
shift [Block]
bs)

 where
   shift :: Block -> Block
   shift :: Block -> Block
shift (Header Int
level Attr
attr [Inline]
inner)
     | Int
level forall a. Num a => a -> a -> a
+ Int
n forall a. Ord a => a -> a -> Bool
> Int
0  = Int -> Attr -> [Inline] -> Block
Header (Int
level forall a. Num a => a -> a -> a
+ Int
n) Attr
attr [Inline]
inner
     | Bool
otherwise      = [Inline] -> Block
Para [Inline]
inner
   shift Block
x            = Block
x

-- | Remove empty paragraphs.
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs :: Pandoc -> Pandoc
stripEmptyParagraphs = forall a b. Walkable a b => (a -> a) -> b -> b
walk [Block] -> [Block]
go
  where go :: [Block] -> [Block]
        go :: [Block] -> [Block]
go = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isEmptyParagraph)
        isEmptyParagraph :: Block -> Bool
isEmptyParagraph (Para []) = Bool
True
        isEmptyParagraph Block
_         = Bool
False

-- | Detect if table rows contain only cells consisting of a single
-- paragraph that has no @LineBreak@.
onlySimpleTableCells :: [[[Block]]] -> Bool
onlySimpleTableCells :: [[[Block]]] -> Bool
onlySimpleTableCells = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  where
    isSimpleCell :: [Block] -> Bool
isSimpleCell [Plain [Inline]
ils] = Bool -> Bool
not ([Inline] -> Bool
hasLineBreak [Inline]
ils)
    isSimpleCell [Para [Inline]
ils ] = Bool -> Bool
not ([Inline] -> Bool
hasLineBreak [Inline]
ils)
    isSimpleCell []          = Bool
True
    isSimpleCell [Block]
_           = Bool
False
    hasLineBreak :: [Inline] -> Bool
hasLineBreak = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak
    isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
    isLineBreak Inline
_         = Bool -> Any
Any Bool
False

-- | Detect if a list is tight.
isTightList :: [[Block]] -> Bool
isTightList :: [[Block]] -> Bool
isTightList = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[Block]
item -> [Block] -> Bool
firstIsPlain [Block]
item Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
item)
  where firstIsPlain :: [Block] -> Bool
firstIsPlain (Plain [Inline]
_ : [Block]
_) = Bool
True
        firstIsPlain [Block]
_             = Bool
False

-- | Convert a list item containing tasklist syntax (e.g. @[x]@)
-- to using @U+2610 BALLOT BOX@ or @U+2612 BALLOT BOX WITH X@.
taskListItemFromAscii :: Extensions -> [Block] -> [Block]
taskListItemFromAscii :: Extensions -> [Block] -> [Block]
taskListItemFromAscii = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
fromMd
  where
    fromMd :: [Inline] -> [Inline]
fromMd (Str Text
"[" : Inline
Space : Str Text
"]" : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☐" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[x]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[X]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd [Inline]
is = [Inline]
is

-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
-- or @U+2612 BALLOT BOX WITH X@ to tasklist syntax (e.g. @[x]@).
taskListItemToAscii :: Extensions -> [Block] -> [Block]
taskListItemToAscii :: Extensions -> [Block] -> [Block]
taskListItemToAscii = ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
toMd
  where
    toMd :: [Inline] -> [Inline]
toMd (Str Text
"☐" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[ ]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"❏" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[ ]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"✓" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" forall a. a -> [a] -> [a]
: Inline
Space forall a. a -> [a] -> [a]
: [Inline]
is
    toMd [Inline]
is = [Inline]
is
    rawMd :: Text -> Inline
rawMd = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"markdown")

handleTaskListItem :: ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem :: ([Inline] -> [Inline]) -> Extensions -> [Block] -> [Block]
handleTaskListItem [Inline] -> [Inline]
handleInlines Extensions
exts [Block]
bls =
  if Extension
Ext_task_lists Extension -> Extensions -> Bool
`extensionEnabled` Extensions
exts
  then [Block] -> [Block]
handleItem [Block]
bls
  else [Block]
bls
  where
    handleItem :: [Block] -> [Block]
handleItem (Plain [Inline]
is : [Block]
bs) = [Inline] -> Block
Plain ([Inline] -> [Inline]
handleInlines [Inline]
is) forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem (Para [Inline]
is  : [Block]
bs) = [Inline] -> Block
Para  ([Inline] -> [Inline]
handleInlines [Inline]
is) forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem [Block]
bs = [Block]
bs

-- | Set a field of a 'Meta' object.  If the field already has a value,
-- convert it into a list with the new value appended to the old value(s).
addMetaField :: ToMetaValue a
             => T.Text
             -> a
             -> Meta
             -> Meta
addMetaField :: forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
key a
val (Meta Map Text MetaValue
meta) =
  Map Text MetaValue -> Meta
Meta forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith MetaValue -> MetaValue -> MetaValue
combine Text
key (forall a. ToMetaValue a => a -> MetaValue
toMetaValue a
val) Map Text MetaValue
meta
  where combine :: MetaValue -> MetaValue -> MetaValue
combine MetaValue
newval (MetaList [MetaValue]
xs) = [MetaValue] -> MetaValue
MetaList ([MetaValue]
xs forall a. [a] -> [a] -> [a]
++ MetaValue -> [MetaValue]
tolist MetaValue
newval)
        combine MetaValue
newval MetaValue
x             = [MetaValue] -> MetaValue
MetaList [MetaValue
x, MetaValue
newval]
        tolist :: MetaValue -> [MetaValue]
tolist (MetaList [MetaValue]
ys) = [MetaValue]
ys
        tolist MetaValue
y             = [MetaValue
y]

-- | Create 'Meta' from old-style title, authors, date.  This is
-- provided to ease the transition from the old API.
makeMeta :: [Inline] -> [[Inline]] -> [Inline] -> Meta
makeMeta :: [Inline] -> [[Inline]] -> [Inline] -> Meta
makeMeta [Inline]
title [[Inline]]
authors [Inline]
date =
      forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"title" (forall a. [a] -> Many a
B.fromList [Inline]
title)
    forall a b. (a -> b) -> a -> b
$ forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"author" (forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> Many a
B.fromList [[Inline]]
authors)
    forall a b. (a -> b) -> a -> b
$ forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"date" (forall a. [a] -> Many a
B.fromList [Inline]
date) Meta
nullMeta

-- | Remove soft breaks between East Asian characters.
eastAsianLineBreakFilter :: Pandoc -> Pandoc
eastAsianLineBreakFilter :: Pandoc -> Pandoc
eastAsianLineBreakFilter = forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Inline] -> [Inline]
go
  where go :: [Inline] -> [Inline]
go (Inline
x:Inline
SoftBreak:Inline
y:[Inline]
zs)
          | Just (Text
_, Char
b) <- Text -> Maybe (Text, Char)
T.unsnoc forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify Inline
x
          , Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify Inline
y
          , Char -> Int
charWidth Char
b forall a. Eq a => a -> a -> Bool
== Int
2
          , Char -> Int
charWidth Char
c forall a. Eq a => a -> a -> Bool
== Int
2
          = Inline
xforall a. a -> [a] -> [a]
:Inline
yforall a. a -> [a] -> [a]
:[Inline]
zs
          | Bool
otherwise
          = Inline
xforall a. a -> [a] -> [a]
:Inline
SoftBreakforall a. a -> [a] -> [a]
:Inline
yforall a. a -> [a] -> [a]
:[Inline]
zs
        go [Inline]
xs
          = [Inline]
xs

-- | Set of HTML elements that are represented as Span with a class equal as
-- the element tag itself.
htmlSpanLikeElements :: Set.Set T.Text
htmlSpanLikeElements :: Set Text
htmlSpanLikeElements = forall a. Ord a => [a] -> Set a
Set.fromList [Text
"kbd", Text
"mark", Text
"dfn"]

-- | Process ipynb output cells.  If mode is Nothing,
-- remove all output.  If mode is Just format, select
-- best output for the format.  If format is not ipynb,
-- strip out ANSI escape sequences from CodeBlocks (see #5633).
filterIpynbOutput :: Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput :: Maybe Format -> Pandoc -> Pandoc
filterIpynbOutput Maybe Format
mode = forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
go
  where go :: Block -> Block
go (Div (Text
ident, Text
"output":[Text]
os, [(Text, Text)]
kvs) [Block]
bs) =
          case Maybe Format
mode of
            Maybe Format
Nothing  -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) []
            -- "best" for ipynb includes all formats:
            Just Format
fmt
              | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ipynb"
                          -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) [Block]
bs
              | Bool
otherwise -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) forall a b. (a -> b) -> a -> b
$
                              forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
removeANSI forall a b. (a -> b) -> a -> b
$
                              forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Block -> Int
rank [Block]
bs
                 where
                  rank :: Block -> Int
rank (RawBlock (Format Text
"html") Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Int
1 :: Int
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
3
                    | Bool
otherwise = Int
4
                  rank (RawBlock (Format Text
"latex") Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" = Int
1
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
3
                    | Bool
otherwise = Int
4
                  rank (RawBlock Format
f Text
_)
                    | Format
fmt forall a. Eq a => a -> a -> Bool
== Format
f = Int
1
                    | Bool
otherwise = Int
4
                  rank (Para [Image{}]) = Int
2
                  rank Block
_ = Int
3
                  removeANSI :: Block -> Block
removeANSI (CodeBlock Attr
attr Text
code) =
                    Attr -> Text -> Block
CodeBlock Attr
attr (Text -> Text
removeANSIEscapes Text
code)
                  removeANSI Block
x = Block
x
                  removeANSIEscapes :: Text -> Text
removeANSIEscapes Text
t
                    | Just Text
cs <- Text -> Text -> Maybe Text
T.stripPrefix Text
"\x1b[" Text
t =
                        Text -> Text
removeANSIEscapes forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'm') Text
cs
                    | Just (Char
c, Text
cs) <- Text -> Maybe (Char, Text)
T.uncons Text
t = Char -> Text -> Text
T.cons Char
c forall a b. (a -> b) -> a -> b
$ Text -> Text
removeANSIEscapes Text
cs
                    | Bool
otherwise = Text
""
        go Block
x = Block
x

-- | Reformat 'Inlines' as code, putting the stringlike parts in 'Code'
-- elements while bringing other inline formatting outside.
-- The idea is that e.g. `[Str "a",Space,Strong [Str "b"]]` should turn
-- into `[Code ("",[],[]) "a ", Strong [Code ("",[],[]) "b"]]`.
-- This helps work around the limitation that pandoc's Code element can
-- only contain string content (see issue #7525).
formatCode :: Attr -> Inlines -> Inlines
formatCode :: Attr -> Inlines -> Inlines
formatCode Attr
attr = forall a. [a] -> Many a
B.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Walkable a b => (a -> a) -> b -> b
walk [Inline] -> [Inline]
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Many a -> [a]
B.toList
  where
    isPlaintext :: Inline -> Bool
isPlaintext (Str Text
_) = Bool
True
    isPlaintext Inline
Space = Bool
True
    isPlaintext Inline
SoftBreak = Bool
True
    isPlaintext (Quoted QuoteType
_ [Inline]
_) = Bool
True
    isPlaintext Inline
_ = Bool
False
    fmt :: [Inline] -> [Inline]
fmt = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Inline]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\Inline
a Inline
b -> Inline -> Bool
isPlaintext Inline
a Bool -> Bool -> Bool
&& Inline -> Bool
isPlaintext Inline
b)
      where
        go :: [Inline] -> [Inline]
go [Inline]
xs
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Inline -> Bool
isPlaintext [Inline]
xs = forall a. Many a -> [a]
B.toList forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
B.codeWith Attr
attr forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Inline]
xs
          | Bool
otherwise = [Inline]
xs

--
-- TagSoup HTML handling
--

-- | Render HTML tags.
renderTags' :: [Tag T.Text] -> T.Text
renderTags' :: [Tag Text] -> Text
renderTags' = forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions
               forall str. StringLike str => RenderOptions str
renderOptions{ optMinimize :: Text -> Bool
optMinimize = forall {t :: * -> *}. Foldable t => t Text -> Text -> Bool
matchTags [Text
"hr", Text
"br", Text
"img",
                                                       Text
"meta", Text
"link", Text
"col"]
                            , optRawTag :: Text -> Bool
optRawTag   = forall {t :: * -> *}. Foldable t => t Text -> Text -> Bool
matchTags [Text
"script", Text
"style"] }
              where matchTags :: t Text -> Text -> Bool
matchTags t Text
tags = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t Text
tags forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower

--
-- File handling
--

-- | Perform an IO action in a directory, returning to starting directory.
inDirectory :: FilePath -> IO a -> IO a
inDirectory :: forall a. FilePath -> IO a -> IO a
inDirectory FilePath
path IO a
action = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
                             IO FilePath
getCurrentDirectory
                             FilePath -> IO ()
setCurrentDirectory
                             (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
setCurrentDirectory FilePath
path forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
action)

--
-- Error reporting
--

mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft :: forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
Bifunctor.first

-- | Remove intermediate "." and ".." directories from a path.
--
-- > collapseFilePath "./foo" == "foo"
-- > collapseFilePath "/bar/../baz" == "/baz"
-- > collapseFilePath "/../baz" == "/../baz"
-- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
-- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
-- > collapseFilePath "parent/foo/.." ==  "parent"
-- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
collapseFilePath :: FilePath -> FilePath
collapseFilePath :: FilePath -> FilePath
collapseFilePath = [FilePath] -> FilePath
Posix.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [FilePath] -> FilePath -> [FilePath]
go [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories
  where
    go :: [FilePath] -> FilePath -> [FilePath]
go [FilePath]
rs FilePath
"." = [FilePath]
rs
    go r :: [FilePath]
r@(FilePath
p:[FilePath]
rs) FilePath
".." = case FilePath
p of
                            FilePath
".."                              -> FilePath
".."forall a. a -> [a] -> [a]
:[FilePath]
r
                            (FilePath -> Maybe Bool
checkPathSeperator -> Just Bool
True) -> FilePath
".."forall a. a -> [a] -> [a]
:[FilePath]
r
                            FilePath
_                                 -> [FilePath]
rs
    go [FilePath]
_ (FilePath -> Maybe Bool
checkPathSeperator -> Just Bool
True) = [[Char
Posix.pathSeparator]]
    go [FilePath]
rs FilePath
x = FilePath
xforall a. a -> [a] -> [a]
:[FilePath]
rs
    isSingleton :: [a] -> Maybe a
isSingleton []  = forall a. Maybe a
Nothing
    isSingleton [a
x] = forall a. a -> Maybe a
Just a
x
    isSingleton [a]
_   = forall a. Maybe a
Nothing
    checkPathSeperator :: FilePath -> Maybe Bool
checkPathSeperator = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. [a] -> Maybe a
isSingleton

-- | Converts the path part of a file: URI to a regular path.
-- On windows, @/c:/foo@ should be @c:/foo@.
-- On linux, @/foo@ should be @/foo@.
uriPathToPath :: T.Text -> FilePath
uriPathToPath :: Text -> FilePath
uriPathToPath (Text -> FilePath
T.unpack -> FilePath
path) =
#ifdef _WINDOWS
  case path of
    '/':ps -> ps
    ps     -> ps
#else
  FilePath
path
#endif

--
-- File selection from the archive
--
filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, BL.ByteString)]
filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, ByteString)]
filteredFilesFromArchive Archive
zf FilePath -> Bool
f =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Archive -> FilePath -> Maybe (FilePath, ByteString)
fileAndBinary Archive
zf) (forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
f (Archive -> [FilePath]
filesInArchive Archive
zf))
  where
    fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, BL.ByteString)
    fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, ByteString)
fileAndBinary Archive
a FilePath
fp = FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
fp Archive
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Entry
e -> forall a. a -> Maybe a
Just (FilePath
fp, Entry -> ByteString
fromEntry Entry
e)

--
-- IANA URIs
--

-- | Schemes from http://www.iana.org/assignments/uri-schemes.html plus
-- the unofficial schemes doi, javascript, isbn, pmid.
schemes :: Set.Set T.Text
schemes :: Set Text
schemes = forall a. Ord a => [a] -> Set a
Set.fromList
  -- Official IANA schemes
  [ Text
"aaa", Text
"aaas", Text
"about", Text
"acap", Text
"acct", Text
"acr", Text
"adiumxtra", Text
"afp", Text
"afs"
  , Text
"aim", Text
"appdata", Text
"apt", Text
"attachment", Text
"aw", Text
"barion", Text
"beshare", Text
"bitcoin"
  , Text
"blob", Text
"bolo", Text
"browserext", Text
"callto", Text
"cap", Text
"chrome", Text
"chrome-extension"
  , Text
"cid", Text
"coap", Text
"coaps", Text
"com-eventbrite-attendee", Text
"content", Text
"crid", Text
"cvs"
  , Text
"data", Text
"dav", Text
"dict", Text
"dis", Text
"dlna-playcontainer", Text
"dlna-playsingle"
  , Text
"dns", Text
"dntp", Text
"dtn", Text
"dvb", Text
"ed2k", Text
"example", Text
"facetime", Text
"fax", Text
"feed"
  , Text
"feedready", Text
"file", Text
"filesystem", Text
"finger", Text
"fish", Text
"ftp", Text
"geo", Text
"gg"
  , Text
"git", Text
"gizmoproject", Text
"go", Text
"gopher", Text
"graph", Text
"gtalk", Text
"h323", Text
"ham"
  , Text
"hcp", Text
"http", Text
"https", Text
"hxxp", Text
"hxxps", Text
"hydrazone", Text
"iax", Text
"icap", Text
"icon"
  , Text
"im", Text
"imap", Text
"info", Text
"iotdisco", Text
"ipn", Text
"ipp", Text
"ipps", Text
"irc", Text
"irc6"
  , Text
"ircs", Text
"iris", Text
"iris.beep", Text
"iris.lwz", Text
"iris.xpc", Text
"iris.xpcs"
  , Text
"isostore", Text
"itms", Text
"jabber", Text
"jar", Text
"jms", Text
"keyparc", Text
"lastfm", Text
"ldap"
  , Text
"ldaps", Text
"lvlt", Text
"magnet", Text
"mailserver", Text
"mailto", Text
"maps", Text
"market"
  , Text
"message", Text
"mid", Text
"mms", Text
"modem", Text
"mongodb", Text
"moz", Text
"ms-access"
  , Text
"ms-browser-extension", Text
"ms-drive-to", Text
"ms-enrollment", Text
"ms-excel"
  , Text
"ms-gamebarservices", Text
"ms-getoffice", Text
"ms-help", Text
"ms-infopath"
  , Text
"ms-media-stream-id", Text
"ms-officeapp", Text
"ms-project", Text
"ms-powerpoint"
  , Text
"ms-publisher", Text
"ms-search-repair", Text
"ms-secondary-screen-controller"
  , Text
"ms-secondary-screen-setup", Text
"ms-settings", Text
"ms-settings-airplanemode"
  , Text
"ms-settings-bluetooth", Text
"ms-settings-camera", Text
"ms-settings-cellular"
  , Text
"ms-settings-cloudstorage", Text
"ms-settings-connectabledevices"
  , Text
"ms-settings-displays-topology", Text
"ms-settings-emailandaccounts"
  , Text
"ms-settings-language", Text
"ms-settings-location", Text
"ms-settings-lock"
  , Text
"ms-settings-nfctransactions", Text
"ms-settings-notifications"
  , Text
"ms-settings-power", Text
"ms-settings-privacy", Text
"ms-settings-proximity"
  , Text
"ms-settings-screenrotation", Text
"ms-settings-wifi", Text
"ms-settings-workplace"
  , Text
"ms-spd", Text
"ms-sttoverlay", Text
"ms-transit-to", Text
"ms-virtualtouchpad"
  , Text
"ms-visio", Text
"ms-walk-to", Text
"ms-whiteboard", Text
"ms-whiteboard-cmd", Text
"ms-word"
  , Text
"msnim", Text
"msrp", Text
"msrps", Text
"mtqp", Text
"mumble", Text
"mupdate", Text
"mvn", Text
"news", Text
"nfs"
  , Text
"ni", Text
"nih", Text
"nntp", Text
"notes", Text
"ocf", Text
"oid", Text
"onenote", Text
"onenote-cmd"
  , Text
"opaquelocktoken", Text
"pack", Text
"palm", Text
"paparazzi", Text
"pkcs11", Text
"platform", Text
"pop"
  , Text
"pres", Text
"prospero", Text
"proxy", Text
"pwid", Text
"psyc", Text
"qb", Text
"query", Text
"redis"
  , Text
"rediss", Text
"reload", Text
"res", Text
"resource", Text
"rmi", Text
"rsync", Text
"rtmfp", Text
"rtmp"
  , Text
"rtsp", Text
"rtsps", Text
"rtspu", Text
"secondlife", Text
"service", Text
"session", Text
"sftp", Text
"sgn"
  , Text
"shttp", Text
"sieve", Text
"sip", Text
"sips", Text
"skype", Text
"smb", Text
"sms", Text
"smtp", Text
"snews"
  , Text
"snmp", Text
"soap.beep", Text
"soap.beeps", Text
"soldat", Text
"spotify", Text
"ssh", Text
"steam"
  , Text
"stun", Text
"stuns", Text
"submit", Text
"svn", Text
"tag", Text
"teamspeak", Text
"tel", Text
"teliaeid"
  , Text
"telnet", Text
"tftp", Text
"things", Text
"thismessage", Text
"tip", Text
"tn3270", Text
"tool", Text
"turn"
  , Text
"turns", Text
"tv", Text
"udp", Text
"unreal", Text
"urn", Text
"ut2004", Text
"v-event", Text
"vemmi"
  , Text
"ventrilo", Text
"videotex", Text
"vnc", Text
"view-source", Text
"wais", Text
"webcal", Text
"wpid"
  , Text
"ws", Text
"wss", Text
"wtai", Text
"wyciwyg", Text
"xcon", Text
"xcon-userid", Text
"xfire"
  , Text
"xmlrpc.beep", Text
"xmlrpc.beeps", Text
"xmpp", Text
"xri", Text
"ymsgr", Text
"z39.50", Text
"z39.50r"
  , Text
"z39.50s"
  -- Unofficial schemes
  , Text
"doi", Text
"isbn", Text
"javascript", Text
"pmid"
  ]

-- | Check if the string is a valid URL with a IANA or frequently used but
-- unofficial scheme (see @schemes@).
isURI :: T.Text -> Bool
isURI :: Text -> Bool
isURI = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False URI -> Bool
hasKnownScheme forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe URI
parseURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack
  where
    hasKnownScheme :: URI -> Bool
hasKnownScheme = (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
schemes) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
':') forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> FilePath
uriScheme

---
--- Squash blocks into inlines
---

blockToInlines :: Block -> Inlines
blockToInlines :: Block -> Inlines
blockToInlines (Plain [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (Para [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (LineBlock [[Inline]]
lns) = forall a. [a] -> Many a
B.fromList forall a b. (a -> b) -> a -> b
$ [[Inline]] -> [Inline]
combineLines [[Inline]]
lns
blockToInlines (CodeBlock Attr
attr Text
str) = Attr -> Text -> Inlines
B.codeWith Attr
attr Text
str
blockToInlines (RawBlock (Format Text
fmt) Text
str) = Text -> Text -> Inlines
B.rawInline Text
fmt Text
str
blockToInlines (BlockQuote [Block]
blks) = [Block] -> Inlines
blocksToInlines' [Block]
blks
blockToInlines (OrderedList (Int, ListNumberStyle, ListNumberDelim)
_ [[Block]]
blkslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (BulletList [[Block]]
blkslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (DefinitionList [([Inline], [[Block]])]
pairslst) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> Inlines
f [([Inline], [[Block]])]
pairslst
  where
    f :: ([Inline], [[Block]]) -> Inlines
f ([Inline]
ils, [[Block]]
blkslst) = forall a. [a] -> Many a
B.fromList [Inline]
ils forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
":" forall a. Semigroup a => a -> a -> a
<> Inlines
B.space forall a. Semigroup a => a -> a -> a
<>
      forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst)
blockToInlines (Header Int
_ Attr
_  [Inline]
ils) = forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines Block
HorizontalRule = forall a. Monoid a => a
mempty
blockToInlines (Table Attr
_ Caption
_ [ColSpec]
_ (TableHead Attr
_ [Row]
hbd) [TableBody]
bodies (TableFoot Attr
_ [Row]
fbd)) =
  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines') (Row -> [[Block]]
plainRowBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row]
hbd forall a. Semigroup a => a -> a -> a
<> [TableBody] -> [Row]
unTableBodies [TableBody]
bodies forall a. Semigroup a => a -> a -> a
<> [Row]
fbd)
  where
    plainRowBody :: Row -> [[Block]]
plainRowBody (Row Attr
_ [Cell]
body) = Cell -> [Block]
cellBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cell]
body
    cellBody :: Cell -> [Block]
cellBody (Cell Attr
_ Alignment
_ RowSpan
_ ColSpan
_ [Block]
body) = [Block]
body
    unTableBody :: TableBody -> [Row]
unTableBody (TableBody Attr
_ RowHeadColumns
_ [Row]
hd [Row]
bd) = [Row]
hd forall a. Semigroup a => a -> a -> a
<> [Row]
bd
    unTableBodies :: [TableBody] -> [Row]
unTableBodies = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [Row]
unTableBody
blockToInlines (Div Attr
_ [Block]
blks) = [Block] -> Inlines
blocksToInlines' [Block]
blks
blockToInlines Block
Null = forall a. Monoid a => a
mempty

blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep Inlines
sep =
  forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Inlines
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Inlines
blockToInlines

blocksToInlines' :: [Block] -> Inlines
blocksToInlines' :: [Block] -> Inlines
blocksToInlines' = Inlines -> [Block] -> Inlines
blocksToInlinesWithSep Inlines
defaultBlocksSeparator

blocksToInlines :: [Block] -> [Inline]
blocksToInlines :: [Block] -> [Inline]
blocksToInlines = forall a. Many a -> [a]
B.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Block] -> Inlines
blocksToInlines'

-- | Inline elements used to separate blocks when squashing blocks into
-- inlines.
defaultBlocksSeparator :: Inlines
defaultBlocksSeparator :: Inlines
defaultBlocksSeparator =
  -- This is used in the pandoc.utils.blocks_to_inlines function. Docs
  -- there should be updated if this is changed.
  Inlines
B.space forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
"¶" forall a. Semigroup a => a -> a -> a
<> Inlines
B.space

--
-- Safe read
--

safeRead :: (MonadPlus m, Read a) => T.Text -> m a
safeRead :: forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead = forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
safeStrRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

safeStrRead :: (MonadPlus m, Read a) => String -> m a
safeStrRead :: forall (m :: * -> *) a. (MonadPlus m, Read a) => FilePath -> m a
safeStrRead FilePath
s = case forall a. Read a => ReadS a
reads FilePath
s of
                  (a
d,FilePath
x):[(a, FilePath)]
_
                    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
d
                  [(a, FilePath)]
_                 -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
--
-- User data directory
--

-- | Return appropriate user data directory for platform.  We use
-- XDG_DATA_HOME (or its default value), but for backwards compatibility,
-- we fall back to the legacy user data directory ($HOME/.pandoc on *nix)
-- if the XDG_DATA_HOME is missing and this exists.  If neither directory
-- is present, we return the XDG data directory.  If the XDG data directory
-- is not defined (e.g. because we are in an environment where $HOME is
-- not defined), we return the empty string.
defaultUserDataDir :: IO FilePath
defaultUserDataDir :: IO FilePath
defaultUserDataDir = do
  FilePath
xdgDir <- forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"pandoc")
               (\(SomeException
_ :: E.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
  FilePath
legacyDir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"pandoc"
  Bool
xdgExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
xdgDir
  Bool
legacyDirExists <- FilePath -> IO Bool
doesDirectoryExist FilePath
legacyDir
  if Bool -> Bool
not Bool
xdgExists Bool -> Bool -> Bool
&& Bool
legacyDirExists
     then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
legacyDir
     else forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
xdgDir