{-# LANGUAGE CPP                   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE OverloadedStrings     #-}
{- |
   Module      : Text.Pandoc.Shared
   Copyright   : Copyright (C) 2006-2020 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,
                     splitByIndices,
                     splitStringByIndices,
                     splitTextByIndices,
                     substitute,
                     ordNub,
                     findM,
                     -- * Text processing
                     ToString (..),
                     ToText (..),
                     tshow,
                     backslashEscapes,
                     escapeStringUsing,
                     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,
                     addMetaField,
                     makeMeta,
                     eastAsianLineBreakFilter,
                     underlineSpan,
                     htmlSpanLikeElements,
                     splitSentences,
                     filterIpynbOutput,
                     -- * 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
                     defaultUserDataDirs,
                     -- * 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.List (find, intercalate, intersperse, stripPrefix, sortOn)
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 (toAsciiChar)
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 = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version

--
-- List processing
--

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

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
                    rest' :: Text
rest'         = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSep Text
rest
                in  Text
first Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Char -> Bool) -> Text -> [Text]
splitTextBy Char -> Bool
isSep Text
rest'

splitByIndices :: [Int] -> [a] -> [[a]]
splitByIndices :: [Int] -> [a] -> [[a]]
splitByIndices [] [a]
lst = [[a]
lst]
splitByIndices (Int
x:[Int]
xs) [a]
lst = [a]
first[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[Int] -> [a] -> [[a]]
forall a. [Int] -> [a] -> [[a]]
splitByIndices ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
y -> Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)  [Int]
xs) [a]
rest
  where ([a]
first, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
x [a]
lst

-- | Split string into chunks divided at specified indices.
splitStringByIndices :: [Int] -> [Char] -> [[Char]]
splitStringByIndices :: [Int] -> String -> [String]
splitStringByIndices [] String
lst = [String
lst]
splitStringByIndices (Int
x:[Int]
xs) String
lst =
  let (String
first, String
rest) = Int -> String -> (String, String)
splitAt' Int
x String
lst in
  String
first String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Int] -> String -> [String]
splitStringByIndices ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
y -> Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x) [Int]
xs) String
rest

splitTextByIndices :: [Int] -> T.Text -> [T.Text]
splitTextByIndices :: [Int] -> Text -> [Text]
splitTextByIndices [Int]
ns = (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack ([String] -> [Text]) -> (Text -> [String]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String -> [String]
splitStringByIndices [Int]
ns (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

splitAt' :: Int -> [Char] -> ([Char],[Char])
splitAt' :: Int -> String -> (String, String)
splitAt' Int
_ []          = ([],[])
splitAt' Int
n String
xs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([],String
xs)
splitAt' Int
n (Char
x:String
xs)      = (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
ys,String
zs)
  where (String
ys,String
zs) = Int -> String -> (String, String)
splitAt' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
charWidth Char
x) String
xs

-- | Replace each occurrence of one sublist in a list with another.
substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
substitute :: [a] -> [a] -> [a] -> [a]
substitute [a]
_ [a]
_ [] = []
substitute [] [a]
_ [a]
xs = [a]
xs
substitute [a]
target [a]
replacement lst :: [a]
lst@(a
x:[a]
xs) =
    case [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [a]
target [a]
lst of
      Just [a]
lst' -> [a]
replacement [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
substitute [a]
target [a]
replacement [a]
lst'
      Maybe [a]
Nothing   -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a] -> [a]
substitute [a]
target [a]
replacement [a]
xs

ordNub :: (Ord a) => [a] -> [a]
ordNub :: [a] -> [a]
ordNub [a]
l = Set a -> [a] -> [a]
forall a. Ord a => Set a -> [a] -> [a]
go Set a
forall a. Set a
Set.empty [a]
l
  where
    go :: Set a -> [a] -> [a]
go Set a
_ [] = []
    go Set a
s (a
x:[a]
xs) = if a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
s then Set a -> [a] -> [a]
go Set a
s [a]
xs
                                      else a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
s) [a]
xs

findM :: forall m t a. (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a)
findM :: (a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> t a -> m (Maybe a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m (Maybe a) -> m (Maybe a)
go (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
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 Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else m (Maybe a)
acc

--
-- Text processing
--

class ToString a where
  toString :: a -> String

instance ToString String where
  toString :: String -> String
toString = String -> String
forall a. a -> a
id

instance ToString T.Text where
  toString :: Text -> String
toString = Text -> String
T.unpack

class ToText a where
  toText :: a -> T.Text

instance ToText String where
  toText :: String -> Text
toText = String -> Text
T.pack

instance ToText T.Text where
  toText :: Text -> Text
toText = Text -> Text
forall a. a -> a
id

tshow :: Show a => a -> T.Text
tshow :: a -> Text
tshow = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Returns an association list of backslash escapes for the
-- designated characters.
backslashEscapes :: [Char]    -- ^ list of special characters to escape
                 -> [(Char, T.Text)]
backslashEscapes :: String -> [(Char, Text)]
backslashEscapes = (Char -> (Char, Text)) -> String -> [(Char, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
ch -> (Char
ch, String -> Text
T.pack [Char
'\\',Char
ch]))

-- | Escape a string of characters, using an association list of
-- characters and strings.
escapeStringUsing :: [(Char, T.Text)] -> T.Text -> T.Text
escapeStringUsing :: [(Char, Text)] -> Text -> Text
escapeStringUsing [(Char, Text)]
tbl = (Char -> Text) -> Text -> Text
T.concatMap ((Char -> Text) -> Text -> Text) -> (Char -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ \Char
c -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Char -> Text
T.singleton Char
c) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Char -> [(Char, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c [(Char, Text)]
tbl

-- | @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 (Char -> Char -> Bool
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 (Char -> Char -> Bool
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- | 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 -> Text -> Bool
`elemText` Text
" \r\n\t")

-- | Remove leading space (including newlines) from string.
triml :: T.Text -> T.Text
triml :: Text -> Text
triml = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Text -> Bool
`elemText` Text
" \r\n\t")

-- | Remove trailing space (including newlines) from string.
trimr :: T.Text -> T.Text
trimr :: Text -> Text
trimr = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Text -> Bool
`elemText` Text
" \r\n\t")

-- | Trim leading space and trailing space unless after \.
trimMath :: T.Text -> T.Text
trimMath :: Text -> Text
trimMath = Text -> Text
triml (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
stripBeginSpace (Text -> Text) -> (Text -> Text) -> Text -> Text
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 -> Text -> Bool
`elemText` Text
" \t\n\r") 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 = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
camelCaseStrToHyphenated (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 :: String -> String
camelCaseStrToHyphenated [] = String
""
camelCaseStrToHyphenated (Char
a:Char
b:String
rest)
  | Char -> Bool
isLower Char
a
  , Char -> Bool
isUpper Char
b = Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
camelCaseStrToHyphenated String
rest
-- handle ABCDef = abc-def
camelCaseStrToHyphenated (Char
a:Char
b:Char
c:String
rest)
  | Char -> Bool
isUpper Char
a
  , Char -> Bool
isUpper Char
b
  , Char -> Bool
isLower Char
c = Char -> Char
toLower Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:Char -> Char
toLower Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
camelCaseStrToHyphenated (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest)
camelCaseStrToHyphenated (Char
a:String
rest) = Char -> Char
toLower Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String -> String
camelCaseStrToHyphenated String
rest

-- | Convert number < 4000 to uppercase roman numeral.
toRomanNumeral :: Int -> T.Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
"?"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"M" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"CM" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
900)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"D" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
500)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"CD" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
400)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"C" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"XC" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"L"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"XL" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"X" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"IX"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"V" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"IV"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"I" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
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 = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
escapeURIString (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
needsEscaping) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 = Text -> Text
forall a. a -> a
id
tabFilter Int
tabStop = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
go ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
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 (Char -> Char -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate
                       (Int
tabStop Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Text -> Int
T.length Text
s1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabStop)) (String -> Text
T.pack String
" ")
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
go (Int -> Text -> Text
T.drop Int
1 Text
s2)

-- | Strip out DOS line endings.
crFilter :: T.Text -> T.Text
crFilter :: Text -> Text
crFilter = (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
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 = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Text -> Maybe String) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
normalizeDate' (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

normalizeDate' :: String -> Maybe String
normalizeDate' :: String -> Maybe String
normalizeDate' String
s = (Day -> String) -> Maybe Day -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F")
  ([Maybe Day] -> Maybe Day
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ([Maybe Day] -> Maybe Day) -> [Maybe Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Day) -> [String] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map (\String
fs -> String -> String -> Maybe Day
parsetimeWith String
fs String
s Maybe Day -> (Day -> Maybe Day) -> Maybe Day
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Day -> Maybe Day
rejectBadYear) [String]
formats :: Maybe Day)
  where rejectBadYear :: Day -> Maybe Day
rejectBadYear Day
day = case Day -> (Integer, Int, Int)
toGregorian Day
day of
          (Integer
y, Int
_, Int
_) | Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1601 Bool -> Bool -> Bool
&& Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
9999 -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
day
          (Integer, Int, Int)
_         -> Maybe Day
forall a. Maybe a
Nothing
        parsetimeWith :: String -> String -> Maybe Day
parsetimeWith = Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
        formats :: [String]
formats = [String
"%x",String
"%m/%d/%Y", String
"%D",String
"%F", String
"%d %b %Y",
                    String
"%e %B %Y", String
"%b. %e, %Y", String
"%B %e, %Y",
                    String
"%Y%m%d", String
"%Y%m", String
"%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 -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Example      -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
Decimal      -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int
start..]
                     ListNumberStyle
UpperAlpha   -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
cycle ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                                     (Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'A'..Char
'Z']
                     ListNumberStyle
LowerAlpha   -> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
cycle ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                                     (Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Text
T.singleton [Char
'a'..Char
'z']
                     ListNumberStyle
UpperRoman   -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
toRomanNumeral [Int
start..]
                     ListNumberStyle
LowerRoman   -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.toLower (Text -> Text) -> (Int -> Text) -> Int -> Text
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 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
Period       -> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"."
                            ListNumberDelim
OneParen     -> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
                            ListNumberDelim
TwoParens    -> a
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
str a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
")"
  in  (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
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 = Inlines -> Seq Inline
forall a. Many a -> Seq a
B.unMany Inlines
is
      left :: Inlines
left  = case Seq Inline -> ViewL Inline
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
_                -> Inlines
forall a. Monoid a => a
mempty
      right :: Inlines
right = case Seq Inline -> ViewR Inline
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
_                -> Inlines
forall a. Monoid a => a
mempty in
  (Inlines
left Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
f (Inlines -> Inlines
B.trimInlines (Inlines -> Inlines)
-> (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Inline -> Inlines
forall a. Seq a -> Many a
B.Many (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Seq Inline
contents) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
right)

-- | Extract inlines, removing formatting.
removeFormatting :: Walkable Inline a => a -> [Inline]
removeFormatting :: a -> [Inline]
removeFormatting = (Inline -> [Inline]) -> a -> [Inline]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> [Inline]
go (a -> [Inline]) -> (a -> a) -> a -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
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
_          = []

deNote :: Inline -> Inline
deNote :: Inline -> Inline
deNote (Note [Block]
_) = Text -> Inline
Str Text
""
deNote Inline
x        = Inline
x

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

deQuote :: Inline -> Inline
deQuote :: Inline -> Inline
deQuote (Quoted QuoteType
SingleQuote [Inline]
xs) =
  Attr -> [Inline] -> Inline
Span (Text
"",[],[]) (Text -> Inline
Str Text
"\8216" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
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" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"\8221"])
deQuote 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 :: a -> Text
stringify = (Inline -> Text) -> a -> Text
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Text
go (a -> Text) -> (a -> a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> a -> a
forall a b. Walkable a b => (a -> a) -> b -> b
walk (Inline -> Inline
deNote (Inline -> Inline) -> (Inline -> Inline) -> Inline -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inline -> Inline
deQuote)
  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 -> String
T.unpack -> (Char
'<':Char
'b':Char
'r':String
_)))
                                                       = Text
" " -- see #2105
        go Inline
LineBreak                                   = Text
" "
        go Inline
_                                           = Text
""

-- | 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 :: a -> a
capitalize = (Inline -> Inline) -> a -> a
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 (Text -> Inline) -> Text -> Inline
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) = ([Blocks] -> [Blocks]
forall a. [a] -> [a]
init [Blocks]
items, [Blocks] -> Blocks
forall a. [a] -> a
last [Blocks]
items)
  in  case [Block] -> [Block]
forall a. [a] -> [a]
reverse (Blocks -> [Block]
forall a. Many a -> [a]
B.toList Blocks
final) of
           (Para [Inline]
a:[Block]
xs)
             | [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- [Block]
xs [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ (Blocks -> [Block]) -> [Blocks] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Blocks -> [Block]
forall a. Many a -> [a]
B.toList [Blocks]
others]
             -> [Blocks]
others [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++ [[Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> [Block]
forall a. [a] -> [a]
reverse ([Inline] -> Block
Plain [Inline]
a Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
xs))]
           [Block]
_ | [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Inline] -> Block
Para [Inline]
x | Para [Inline]
x <- (Blocks -> [Block]) -> [Blocks] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Blocks -> [Block]
forall a. Many a -> [a]
B.toList [Blocks]
items]
             -> [Blocks]
items
           [Block]
_ -> (Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map ((Block -> Block) -> Blocks -> Blocks
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 =
  let defs :: [Blocks]
defs = ((Inlines, [Blocks]) -> [Blocks])
-> [(Inlines, [Blocks])] -> [Blocks]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Inlines, [Blocks]) -> [Blocks]
forall a b. (a, b) -> b
snd [(Inlines, [Blocks])]
items
  in  case [Block] -> [Block]
forall a. [a] -> [a]
reverse ((Blocks -> [Block]) -> [Blocks] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Blocks -> [Block]
forall a. Many a -> [a]
B.toList [Blocks]
defs) of
           (Para [Inline]
x:[Block]
xs)
             | Bool -> Bool
not ((Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Block -> Bool
isPara [Block]
xs) ->
                   let (Inlines
t,[Blocks]
ds) = [(Inlines, [Blocks])] -> (Inlines, [Blocks])
forall a. [a] -> a
last [(Inlines, [Blocks])]
items
                       lastDef :: [Block]
lastDef = Blocks -> [Block]
forall a. Many a -> [a]
B.toList (Blocks -> [Block]) -> Blocks -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. [a] -> a
last [Blocks]
ds
                       ds' :: [Blocks]
ds' = [Blocks] -> [Blocks]
forall a. [a] -> [a]
init [Blocks]
ds [Blocks] -> [Blocks] -> [Blocks]
forall a. [a] -> [a] -> [a]
++
                             if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
lastDef
                                then [[Block] -> Blocks
forall a. [a] -> Many a
B.fromList [Block]
lastDef]
                                else [[Block] -> Blocks
forall a. [a] -> Many a
B.fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
forall a. [a] -> [a]
init [Block]
lastDef [Block] -> [Block] -> [Block]
forall a. [a] -> [a] -> [a]
++ [[Inline] -> Block
Plain [Inline]
x]]
                    in [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. [a] -> [a]
init [(Inlines, [Blocks])]
items [(Inlines, [Blocks])]
-> [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
forall a. [a] -> [a] -> [a]
++ [(Inlines
t, [Blocks]
ds')]
             | Bool
otherwise           -> [(Inlines, [Blocks])]
items
           [Block]
_                       -> [(Inlines, [Blocks])]
items

-- | Combine a list of lines by adding hard linebreaks.
combineLines :: [[Inline]] -> [Inline]
combineLines :: [[Inline]] -> [Inline]
combineLines = [Inline] -> [[Inline]] -> [Inline]
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 ([Inline] -> Block)
-> ([[Inline]] -> [Inline]) -> [[Inline]] -> Block
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 (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterAscii (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toIdent (Text -> Text) -> ([Inline] -> Text) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify ([Inline] -> Text) -> ([Inline] -> [Inline]) -> [Inline] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> [Inline]) -> [Inline] -> [Inline]
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 = (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unEmoji
      | Bool
otherwise = [Inline] -> [Inline]
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 = Text -> Text
forall a. a -> a
id
      | Bool
otherwise = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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
        = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Char) -> String -> String
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
toAsciiChar (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      | Bool
otherwise = Text -> Text
forall a. a -> a
id
    toIdent :: Text -> Text
toIdent
      | Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_gfm_auto_identifiers Extensions
exts =
        Text -> Text
filterPunct (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
spaceToDash (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
      | Bool
otherwise = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
filterPunct (Text -> Text) -> (Text -> Text) -> Text -> Text
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 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
||
          Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark,
                                    GeneralCategory
EnclosingMark, GeneralCategory
ConnectorPunctuation]
      | Bool
otherwise = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
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 =
  State (Maybe Int, [Int]) [Block] -> (Maybe Int, [Int]) -> [Block]
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) <- StateT (Maybe Int, [Int]) Identity (Maybe Int, [Int])
forall s (m :: * -> *). MonadState s m => m s
S.get
    let level' :: Int
level' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
level Maybe Int
mbLevel
    let lastnum' :: [Int]
lastnum' = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
level' [Int]
lastnum
    let newnum :: [Int]
newnum =
          if Int
level' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
             then case [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum' of
                      Int
x | Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes -> []
                        | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
level' -> [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
lastnum' [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [[Int] -> Int
forall a. [a] -> a
last [Int]
lastnum' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
                        | Bool
otherwise -> [Int]
lastnum [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
                             Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
level' Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
lastnum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
1]
             else []
    Bool
-> StateT (Maybe Int, [Int]) Identity ()
-> StateT (Maybe Int, [Int]) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
newnum) (StateT (Maybe Int, [Int]) Identity ()
 -> StateT (Maybe Int, [Int]) Identity ())
-> StateT (Maybe Int, [Int]) Identity ()
-> StateT (Maybe Int, [Int]) Identity ()
forall a b. (a -> b) -> a -> b
$ ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (((Maybe Int, [Int]) -> (Maybe Int, [Int]))
 -> StateT (Maybe Int, [Int]) Identity ())
-> ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
forall a b. (a -> b) -> a -> b
$ \(Maybe Int
mbl, [Int]
_) -> (Maybe Int
mbl, [Int]
newnum)
    let ([Block]
sectionContents, [Block]
rest) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Int -> Block -> Bool
headerLtEq Int
level) [Block]
xs
    ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (((Maybe Int, [Int]) -> (Maybe Int, [Int]))
 -> StateT (Maybe Int, [Int]) Identity ())
-> ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
forall a b. (a -> b) -> a -> b
$ \(Maybe Int
_, [Int]
ln) -> ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
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
    ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
S.modify (((Maybe Int, [Int]) -> (Maybe Int, [Int]))
 -> StateT (Maybe Int, [Int]) Identity ())
-> ((Maybe Int, [Int]) -> (Maybe Int, [Int]))
-> StateT (Maybe Int, [Int]) Identity ()
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 Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"number" [(Text, Text)]
kvs of
                  Maybe Text
Nothing | Bool
numbering
                          , Text
"unnumbered" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
classes ->
                        (Text
"number", Text -> [Text] -> Text
T.intercalate Text
"." ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow [Int]
newnum)) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
kvs
                  Maybe Text
_ -> [(Text, Text)]
kvs
    let divattr :: Attr
divattr = (Text
ident, Text
"section"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
classes, [(Text, Text)]
kvs')
    let attr :: Attr
attr = (Text
"",[Text]
classes,[(Text, Text)]
kvs')
    [Block] -> State (Maybe Int, [Int]) [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State (Maybe Int, [Int]) [Block])
-> [Block] -> State (Maybe Int, [Int]) [Block]
forall a b. (a -> b) -> a -> b
$
      Attr -> [Block] -> Block
Div Attr
divattr (Int -> Attr -> [Inline] -> Block
Header Int
level' Attr
attr [Inline]
title' Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
sectionContents') Block -> [Block] -> [Block]
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)
      | (Block -> Bool) -> [Block] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
               Header Int
level' Attr
_ [Inline]
_ -> Int
level' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
level
               Block
_                 -> Bool
True) [Block]
ys
      , Text
"column" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
dclasses
      , Text
"columns" Text -> [Text] -> Bool
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'Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:[Block]
ys)
    [Block]
rest <- [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
    [Block] -> State (Maybe Int, [Int]) [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State (Maybe Int, [Int]) [Block])
-> [Block] -> State (Maybe Int, [Int]) [Block]
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 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
dident'
              -> Attr -> [Block] -> Block
Div (Attr -> Attr -> Attr
combineAttr Attr
divattr' Attr
divattr) [Block]
zs Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest
            [Block]
_ -> Attr -> [Block] -> Block
Div Attr
divattr [Block]
inner Block -> [Block] -> [Block]
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
    [Block] -> State (Maybe Int, [Int]) [Block]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block] -> State (Maybe Int, [Int]) [Block])
-> [Block] -> State (Maybe Int, [Int]) [Block]
forall a b. (a -> b) -> a -> b
$ Attr -> [Block] -> Block
Div Attr
attr [Block]
xs' Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
rest'
  go (Block
x:[Block]
xs) = (Block
x Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
:) ([Block] -> [Block])
-> State (Maybe Int, [Int]) [Block]
-> State (Maybe Int, [Int]) [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> State (Maybe Int, [Int]) [Block]
go [Block]
xs
  go [] = [Block] -> State (Maybe Int, [Int]) [Block]
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,
     [Text] -> [Text]
forall a. Ord a => [a] -> [a]
ordNub ([Text]
classes1 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
classes2),
     ((Text, Text) -> [(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
k,Text
v) [(Text, Text)]
kvs -> case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
k [(Text, Text)]
kvs of
                             Maybe Text
Nothing -> (Text
k,Text
v)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[(Text, Text)]
kvs
                             Just Text
_  -> [(Text, Text)]
kvs) [(Text, Text)]
forall a. Monoid a => a
mempty ([(Text, Text)]
kvs1 [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
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 Int -> Int -> Bool
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 Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
usedIdents
     then Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
baseIdent Int -> Text
forall a. Show a => a -> Text
numIdent
          (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> Maybe Int
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Int
x -> Int -> Text
forall a. Show a => a -> Text
numIdent Int
x Text -> Set Text -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
  , Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Pandoc -> Pandoc
headerShift Int
n (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
                 Inlines -> Pandoc -> Pandoc
B.setTitle ([Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils) (Pandoc -> Pandoc) -> Pandoc -> Pandoc
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 ((Block -> Block) -> [Block] -> [Block]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0  = Int -> Attr -> [Inline] -> Block
Header (Int
level Int -> Int -> Int
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 = ([Block] -> [Block]) -> Pandoc -> Pandoc
forall a b. Walkable a b => (a -> a) -> b -> b
walk [Block] -> [Block]
go
  where go :: [Block] -> [Block]
        go :: [Block] -> [Block]
go = (Block -> Bool) -> [Block] -> [Block]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
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 = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
isSimpleCell ([[Block]] -> Bool)
-> ([[[Block]]] -> [[Block]]) -> [[[Block]]] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Block]]] -> [[Block]]
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 (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
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 = ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\[Block]
item -> [Block] -> Bool
firstIsPlain [Block]
item Bool -> Bool -> Bool
|| [Block] -> 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
"☐" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[x]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    fromMd (Str Text
"[X]"                 : Inline
Space : [Inline]
is) = Text -> Inline
Str Text
"☒" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
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
"[ ]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
is
    toMd (Str Text
"☒" : Inline
Space : [Inline]
is) = Text -> Inline
rawMd Text
"[x]" Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Inline
Space Inline -> [Inline] -> [Inline]
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) Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
bs
    handleItem (Para [Inline]
is  : [Block]
bs) = [Inline] -> Block
Para  ([Inline] -> [Inline]
handleInlines [Inline]
is) Block -> [Block] -> [Block]
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 :: Text -> a -> Meta -> Meta
addMetaField Text
key a
val (Meta Map Text MetaValue
meta) =
  Map Text MetaValue -> Meta
Meta (Map Text MetaValue -> Meta) -> Map Text MetaValue -> Meta
forall a b. (a -> b) -> a -> b
$ (MetaValue -> MetaValue -> MetaValue)
-> Text -> MetaValue -> Map Text MetaValue -> Map Text MetaValue
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith MetaValue -> MetaValue -> MetaValue
combine Text
key (a -> MetaValue
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 [MetaValue] -> [MetaValue] -> [MetaValue]
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 =
      Text -> Inlines -> Meta -> Meta
forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"title" ([Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
title)
    (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> Meta -> Meta
forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"author" (([Inline] -> Inlines) -> [[Inline]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [[Inline]]
authors)
    (Meta -> Meta) -> Meta -> Meta
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> Meta -> Meta
forall a. ToMetaValue a => Text -> a -> Meta -> Meta
addMetaField Text
"date" ([Inline] -> Inlines
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 = ([Inline] -> [Inline]) -> Pandoc -> Pandoc
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 (Text -> Maybe (Text, Char)) -> Text -> Maybe (Text, Char)
forall a b. (a -> b) -> a -> b
$ Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
x
          , Just (Char
c, Text
_) <- Text -> Maybe (Char, Text)
T.uncons (Text -> Maybe (Char, Text)) -> Text -> Maybe (Char, Text)
forall a b. (a -> b) -> a -> b
$ Inline -> Text
forall a. Walkable Inline a => a -> Text
stringify Inline
y
          , Char -> Int
charWidth Char
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
          , Char -> Int
charWidth Char
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
          = Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Inline
yInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
zs
          | Bool
otherwise
          = Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Inline
SoftBreakInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:Inline
yInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
zs
        go [Inline]
xs
          = [Inline]
xs

{-# DEPRECATED underlineSpan "Use Text.Pandoc.Builder.underline instead" #-}
-- | Builder for underline (deprecated).
-- This probably belongs in Builder.hs in pandoc-types.
-- Will be replaced once Underline is an element.
underlineSpan :: Inlines -> Inlines
underlineSpan :: Inlines -> Inlines
underlineSpan = Inlines -> Inlines
B.underline

-- | 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 = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"kbd", Text
"mark", Text
"dfn"]

-- | Returns the first sentence in a list of inlines, and the rest.
breakSentence :: [Inline] -> ([Inline], [Inline])
breakSentence :: [Inline] -> ([Inline], [Inline])
breakSentence [] = ([],[])
breakSentence [Inline]
xs =
  let isSentenceEndInline :: Inline -> Bool
isSentenceEndInline (Str Text
ys)
        | Just (Text
_, Char
c) <- Text -> Maybe (Text, Char)
T.unsnoc Text
ys = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
      isSentenceEndInline Inline
LineBreak  = Bool
True
      isSentenceEndInline Inline
_          = Bool
False
      ([Inline]
as, [Inline]
bs) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Inline -> Bool
isSentenceEndInline [Inline]
xs
  in  case [Inline]
bs of
        []             -> ([Inline]
as, [])
        [Inline
c]            -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
c], [])
        (Inline
c:Inline
Space:[Inline]
cs)   -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
c], [Inline]
cs)
        (Inline
c:Inline
SoftBreak:[Inline]
cs) -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
c], [Inline]
cs)
        (Str Text
".":Str s :: Text
s@(Text -> Maybe (Char, Text)
T.uncons -> Just (Char
')',Text
_)):[Inline]
cs)
          -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
".", Text -> Inline
Str Text
s], [Inline]
cs)
        (x :: Inline
x@(Str (Text -> Text -> Maybe Text
T.stripPrefix Text
".)" -> Just Text
_)):[Inline]
cs) -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
x], [Inline]
cs)
        (Inline
LineBreak:x :: Inline
x@(Str (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'.',Text
_))):[Inline]
cs) -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++[Inline
LineBreak], Inline
xInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
cs)
        (Inline
c:[Inline]
cs)         -> ([Inline]
as [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
c] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ds, [Inline]
es)
          where ([Inline]
ds, [Inline]
es) = [Inline] -> ([Inline], [Inline])
breakSentence [Inline]
cs

-- | Split a list of inlines into sentences.
splitSentences :: [Inline] -> [[Inline]]
splitSentences :: [Inline] -> [[Inline]]
splitSentences [Inline]
xs =
  let ([Inline]
sent, [Inline]
rest) = [Inline] -> ([Inline], [Inline])
breakSentence [Inline]
xs
  in  if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
rest then [[Inline]
sent] else [Inline]
sent [Inline] -> [[Inline]] -> [[Inline]]
forall a. a -> [a] -> [a]
: [Inline] -> [[Inline]]
splitSentences [Inline]
rest

-- | 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 = (Block -> Block) -> Pandoc -> Pandoc
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"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) []
            -- "best" for ipynb includes all formats:
            Just Format
fmt
              | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"ipynb"
                          -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) [Block]
bs
              | Bool
otherwise -> Attr -> [Block] -> Block
Div (Text
ident, Text
"output"Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
os, [(Text, Text)]
kvs) ([Block] -> Block) -> [Block] -> Block
forall a b. (a -> b) -> a -> b
$
                              (Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
removeANSI ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$
                              Int -> [Block] -> [Block]
forall a. Int -> [a] -> [a]
take Int
1 ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ (Block -> Int) -> [Block] -> [Block]
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 Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"html" = Int
1 :: Int
                    | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
2
                    | Bool
otherwise = Int
3
                  rank (RawBlock (Format Text
"latex") Text
_)
                    | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"latex" = Int
1
                    | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Format
Format Text
"markdown" = Int
2
                    | Bool
otherwise = Int
3
                  rank (RawBlock Format
f Text
_)
                    | Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
f = Int
1
                    | Bool
otherwise = Int
3
                  rank (Para [Image{}]) = Int
1
                  rank Block
_ = Int
2
                  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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
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 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
removeANSIEscapes Text
cs
                    | Bool
otherwise = Text
""
        go Block
x = Block
x

--
-- TagSoup HTML handling
--

-- | Render HTML tags.
renderTags' :: [Tag T.Text] -> T.Text
renderTags' :: [Tag Text] -> Text
renderTags' = RenderOptions Text -> [Tag Text] -> Text
forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions
               RenderOptions Text
forall str. StringLike str => RenderOptions str
renderOptions{ optMinimize :: Text -> Bool
optMinimize = [Text] -> Text -> Bool
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   = [Text] -> Text -> Bool
forall (t :: * -> *). Foldable t => t Text -> Text -> Bool
matchTags [Text
"script", Text
"style"] }
              where matchTags :: t Text -> Text -> Bool
matchTags t Text
tags = (Text -> t Text -> Bool) -> t Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> t Text -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem t Text
tags (Text -> Bool) -> (Text -> Text) -> Text -> Bool
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 :: String -> IO a -> IO a
inDirectory String
path IO a
action = IO String -> (String -> IO ()) -> (String -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
                             IO String
getCurrentDirectory
                             String -> IO ()
setCurrentDirectory
                             (IO a -> String -> IO a
forall a b. a -> b -> a
const (IO a -> String -> IO a) -> IO a -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String -> IO ()
setCurrentDirectory String
path IO () -> IO a -> IO a
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 :: (a -> b) -> Either a c -> Either b c
mapLeft = (a -> b) -> Either a c -> Either b c
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 :: String -> String
collapseFilePath = [String] -> String
Posix.joinPath ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String -> [String])
-> [String] -> [String] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> String -> [String]
go [] ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
  where
    go :: [String] -> String -> [String]
go [String]
rs String
"." = [String]
rs
    go r :: [String]
r@(String
p:[String]
rs) String
".." = case String
p of
                            String
".."                              -> String
".."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
r
                            (String -> Maybe Bool
checkPathSeperator -> Just Bool
True) -> String
".."String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
r
                            String
_                                 -> [String]
rs
    go [String]
_ (String -> Maybe Bool
checkPathSeperator -> Just Bool
True) = [[Char
Posix.pathSeparator]]
    go [String]
rs String
x = String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rs
    isSingleton :: [a] -> Maybe a
isSingleton []  = Maybe a
forall a. Maybe a
Nothing
    isSingleton [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    isSingleton [a]
_   = Maybe a
forall a. Maybe a
Nothing
    checkPathSeperator :: String -> Maybe Bool
checkPathSeperator = (Char -> Bool) -> Maybe Char -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Bool
isPathSeparator (Maybe Char -> Maybe Bool)
-> (String -> Maybe Char) -> String -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Char
forall a. [a] -> Maybe a
isSingleton

-- Convert 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 -> String
uriPathToPath (Text -> String
T.unpack -> String
path) =
#ifdef _WINDOWS
  case path of
    '/':ps -> ps
    ps     -> ps
#else
  String
path
#endif

--
-- File selection from the archive
--
filteredFilesFromArchive :: Archive -> (FilePath -> Bool) -> [(FilePath, BL.ByteString)]
filteredFilesFromArchive :: Archive -> (String -> Bool) -> [(String, ByteString)]
filteredFilesFromArchive Archive
zf String -> Bool
f =
  (String -> Maybe (String, ByteString))
-> [String] -> [(String, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Archive -> String -> Maybe (String, ByteString)
fileAndBinary Archive
zf) ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
f (Archive -> [String]
filesInArchive Archive
zf))
  where
    fileAndBinary :: Archive -> FilePath -> Maybe (FilePath, BL.ByteString)
    fileAndBinary :: Archive -> String -> Maybe (String, ByteString)
fileAndBinary Archive
a String
fp = String -> Archive -> Maybe Entry
findEntryByPath String
fp Archive
a Maybe Entry
-> (Entry -> Maybe (String, ByteString))
-> Maybe (String, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Entry
e -> (String, ByteString) -> Maybe (String, ByteString)
forall a. a -> Maybe a
Just (String
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 = [Text] -> Set Text
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 = Bool -> (URI -> Bool) -> Maybe URI -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False URI -> Bool
hasKnownScheme (Maybe URI -> Bool) -> (Text -> Maybe URI) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe URI
parseURI (String -> Maybe URI) -> (Text -> String) -> Text -> Maybe URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
  where
    hasKnownScheme :: URI -> Bool
hasKnownScheme = (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
schemes) (Text -> Bool) -> (URI -> Text) -> URI -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (URI -> Text) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                     (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') (Text -> Text) -> (URI -> Text) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriScheme

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

blockToInlines :: Block -> Inlines
blockToInlines :: Block -> Inlines
blockToInlines (Plain [Inline]
ils) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (Para [Inline]
ils) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines (LineBlock [[Inline]]
lns) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList ([Inline] -> Inlines) -> [Inline] -> Inlines
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) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (BulletList [[Block]]
blkslst) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst
blockToInlines (DefinitionList [([Inline], [[Block]])]
pairslst) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> Inlines)
-> [([Inline], [[Block]])] -> [Inlines]
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) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
":" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>
      [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat (([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines' [[Block]]
blkslst)
blockToInlines (Header Int
_ Attr
_  [Inline]
ils) = [Inline] -> Inlines
forall a. [a] -> Many a
B.fromList [Inline]
ils
blockToInlines Block
HorizontalRule = Inlines
forall a. Monoid a => a
mempty
blockToInlines (Table Attr
_ Caption
_ [ColSpec]
_ (TableHead Attr
_ [Row]
hbd) [TableBody]
bodies (TableFoot Attr
_ [Row]
fbd)) =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
B.linebreak ([Inlines] -> [Inlines]) -> [Inlines] -> [Inlines]
forall a b. (a -> b) -> a -> b
$
    ([[Block]] -> Inlines) -> [[[Block]]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([[Block]] -> [Inlines]) -> [[Block]] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Block] -> Inlines) -> [[Block]] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Inlines
blocksToInlines') (Row -> [[Block]]
plainRowBody (Row -> [[Block]]) -> [Row] -> [[[Block]]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row]
hbd [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [TableBody] -> [Row]
unTableBodies [TableBody]
bodies [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
fbd)
  where
    plainRowBody :: Row -> [[Block]]
plainRowBody (Row Attr
_ [Cell]
body) = Cell -> [Block]
cellBody (Cell -> [Block]) -> [Cell] -> [[Block]]
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 [Row] -> [Row] -> [Row]
forall a. Semigroup a => a -> a -> a
<> [Row]
bd
    unTableBodies :: [TableBody] -> [Row]
unTableBodies = (TableBody -> [Row]) -> [TableBody] -> [Row]
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 = Inlines
forall a. Monoid a => a
mempty

blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep :: Inlines -> [Block] -> Inlines
blocksToInlinesWithSep Inlines
sep =
  [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Block] -> [Inlines]) -> [Block] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
sep ([Inlines] -> [Inlines])
-> ([Block] -> [Inlines]) -> [Block] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> Inlines) -> [Block] -> [Inlines]
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 = Inlines -> [Inline]
forall a. Many a -> [a]
B.toList (Inlines -> [Inline])
-> ([Block] -> Inlines) -> [Block] -> [Inline]
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 Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
B.str Text
"¶" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
B.space

--
-- Safe read
--

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

safeStrRead :: (MonadPlus m, Read a) => String -> m a
safeStrRead :: String -> m a
safeStrRead String
s = case ReadS a
forall a. Read a => ReadS a
reads String
s of
                  (a
d,String
x):[(a, String)]
_
                    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
x -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
                  [(a, String)]
_                 -> m a
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 fall back to the
-- legacy user data directory ($HOME/.pandoc on *nix) if this is
-- missing.
defaultUserDataDirs :: IO [FilePath]
defaultUserDataDirs :: IO [String]
defaultUserDataDirs = IO [String] -> (SomeException -> IO [String]) -> IO [String]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (do
  String
xdgDir <- XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"pandoc"
  String
legacyDir <- String -> IO String
getAppUserDataDirectory String
"pandoc"
  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
ordNub [String
xdgDir, String
legacyDir])
 (\(SomeException
_ :: E.SomeException) -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])