{-
pandoc-crossref is a pandoc filter for numbering figures,
equations, tables and cross-references to them.
Copyright (C) 2015  Nikolay Yakimov <root@livid.pp.ru>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-}

{-# LANGUAGE RankNTypes, OverloadedStrings, CPP #-}
module Text.Pandoc.CrossRef.Util.Util
  ( module Text.Pandoc.CrossRef.Util.Util
  , module Data.Generics
  ) where

import Data.Char (isUpper, toLower, toUpper)
import Data.Default
import Data.Generics
import Data.List (find)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Version
import Text.Pandoc.Builder hiding ((<>))
import Text.Pandoc.Class
import Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.Writers.LaTeX
import Text.ParserCombinators.ReadP (readP_to_S)
import qualified Data.Sequence as S

intercalate' :: (Eq a, Monoid a, Foldable f) => a -> f a -> a
intercalate' :: forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' a
s f a
xs
  | f a -> Bool
forall a. f a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
xs = a
forall a. Monoid a => a
mempty
  | Bool
otherwise = (a -> a -> a) -> f a -> a
forall a. (a -> a -> a) -> f a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\a
x a
acc -> a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
acc) f a
xs

isFormat :: T.Text -> Maybe Format -> Bool
isFormat :: Text -> Maybe Format -> Bool
isFormat Text
fmt (Just (Format Text
f)) = (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ([Char]
"+-" :: String)) Text
f Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
fmt
isFormat Text
_ Maybe Format
Nothing = Bool
False

capitalizeFirst :: T.Text -> T.Text
capitalizeFirst :: Text -> Text
capitalizeFirst Text
t
  | Just (Char
x, Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
t = Char -> Char
toUpper Char
x Char -> Text -> Text
`T.cons` Text
xs
  | Bool
otherwise = Text
T.empty

uncapitalizeFirst :: T.Text -> T.Text
uncapitalizeFirst :: Text -> Text
uncapitalizeFirst Text
t
  | Just (Char
x, Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
t = Char -> Char
toLower Char
x Char -> Text -> Text
`T.cons` Text
xs
  | Bool
otherwise = Text
T.empty

isFirstUpper :: T.Text -> Bool
isFirstUpper :: Text -> Bool
isFirstUpper Text
xs
  | Just (Char
x, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
xs  = Char -> Bool
isUpper Char
x
  | Bool
otherwise = Bool
False

chapPrefix :: [Inline] -> Index -> [Inline]
chapPrefix :: [Inline] -> Index -> [Inline]
chapPrefix [Inline]
delim = Many Inline -> [Inline]
forall a. Many a -> [a]
toList
  (Many Inline -> [Inline])
-> (Index -> Many Inline) -> Index -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> Seq (Many Inline) -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
delim)
  (Seq (Many Inline) -> Many Inline)
-> (Index -> Seq (Many Inline)) -> Index -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Many Inline) -> Seq Text -> Seq (Many Inline)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Many Inline
str
  (Seq Text -> Seq (Many Inline))
-> (Index -> Seq Text) -> Index -> Seq (Many Inline)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> Seq Text -> Seq Text
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
  (Seq Text -> Seq Text) -> (Index -> Seq Text) -> Index -> Seq Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe Text) -> Text) -> Index -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Maybe Text -> Text) -> (Int, Maybe Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Maybe Text -> Text)
-> (Int -> Text) -> Int -> Maybe Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Int -> [Char]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show))

data ReplacedResult a = Replaced Bool a | NotReplaced Bool
type GenRR m = forall a. Data a => (a -> m (ReplacedResult a))
newtype RR m a = RR {forall (m :: * -> *) a. RR m a -> a -> m (ReplacedResult a)
unRR :: a -> m (ReplacedResult a)}

runReplace :: (Monad m) => GenRR m -> GenericM m
runReplace :: forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace GenRR m
f a
x = do
  ReplacedResult a
res <- a -> m (ReplacedResult a)
GenRR m
f a
x
  case ReplacedResult a
res of
    Replaced Bool
True a
x' -> (forall d. Data d => d -> m d) -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM (GenRR m -> forall d. Data d => d -> m d
forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace a -> m (ReplacedResult a)
GenRR m
f) a
x'
    Replaced Bool
False a
x' -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x'
    NotReplaced Bool
True -> (forall d. Data d => d -> m d) -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM (GenRR m -> forall d. Data d => d -> m d
forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace a -> m (ReplacedResult a)
GenRR m
f) a
x
    NotReplaced Bool
False -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

mkRR :: (Monad m, Typeable a, Typeable b)
     => (b -> m (ReplacedResult b))
     -> (a -> m (ReplacedResult a))
mkRR :: forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
mkRR = (a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
extRR (m (ReplacedResult a) -> a -> m (ReplacedResult a)
forall a b. a -> b -> a
const m (ReplacedResult a)
forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse)

extRR :: ( Monad m, Typeable a, Typeable b)
     => (a -> m (ReplacedResult a))
     -> (b -> m (ReplacedResult b))
     -> (a -> m (ReplacedResult a))
extRR :: forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
extRR a -> m (ReplacedResult a)
def' b -> m (ReplacedResult b)
ext = RR m a -> a -> m (ReplacedResult a)
forall (m :: * -> *) a. RR m a -> a -> m (ReplacedResult a)
unRR ((a -> m (ReplacedResult a)) -> RR m a
forall (m :: * -> *) a. (a -> m (ReplacedResult a)) -> RR m a
RR a -> m (ReplacedResult a)
def' RR m a -> RR m b -> RR m a
forall a b (c :: * -> *).
(Typeable a, Typeable b) =>
c a -> c b -> c a
`ext0` (b -> m (ReplacedResult b)) -> RR m b
forall (m :: * -> *) a. (a -> m (ReplacedResult a)) -> RR m a
RR b -> m (ReplacedResult b)
ext)

replaceRecurse :: Monad m => a -> m (ReplacedResult a)
replaceRecurse :: forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceRecurse = ReplacedResult a -> m (ReplacedResult a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplacedResult a -> m (ReplacedResult a))
-> (a -> ReplacedResult a) -> a -> m (ReplacedResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> ReplacedResult a
forall a. Bool -> a -> ReplacedResult a
Replaced Bool
True

replaceNoRecurse :: Monad m => a -> m (ReplacedResult a)
replaceNoRecurse :: forall (m :: * -> *) a. Monad m => a -> m (ReplacedResult a)
replaceNoRecurse = ReplacedResult a -> m (ReplacedResult a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplacedResult a -> m (ReplacedResult a))
-> (a -> ReplacedResult a) -> a -> m (ReplacedResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> a -> ReplacedResult a
forall a. Bool -> a -> ReplacedResult a
Replaced Bool
False

noReplace :: Monad m => Bool -> m (ReplacedResult a)
noReplace :: forall (m :: * -> *) a. Monad m => Bool -> m (ReplacedResult a)
noReplace Bool
recurse = ReplacedResult a -> m (ReplacedResult a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplacedResult a -> m (ReplacedResult a))
-> ReplacedResult a -> m (ReplacedResult a)
forall a b. (a -> b) -> a -> b
$ Bool -> ReplacedResult a
forall a. Bool -> ReplacedResult a
NotReplaced Bool
recurse

noReplaceRecurse :: Monad m => m (ReplacedResult a)
noReplaceRecurse :: forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse = Bool -> m (ReplacedResult a)
forall (m :: * -> *) a. Monad m => Bool -> m (ReplacedResult a)
noReplace Bool
True

noReplaceNoRecurse :: Monad m => m (ReplacedResult a)
noReplaceNoRecurse :: forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceNoRecurse = Bool -> m (ReplacedResult a)
forall (m :: * -> *) a. Monad m => Bool -> m (ReplacedResult a)
noReplace Bool
False

mkLaTeXLabel :: T.Text -> T.Text
mkLaTeXLabel :: Text -> Text
mkLaTeXLabel Text
l
 | Text -> Bool
T.null Text
l = Text
""
 | Bool
otherwise = Text
"\\label{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
mkLaTeXLabel' Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

mkLaTeXLabel' :: T.Text -> T.Text
mkLaTeXLabel' :: Text -> Text
mkLaTeXLabel' Text
l =
  let ll :: Text
ll = (PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> (PandocError -> [Char]) -> PandocError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> [Char]
forall a. Show a => a -> [Char]
show) Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> Either PandocError Text -> Text
forall a b. (a -> b) -> a -> b
$
            PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
forall a. Default a => a
def (Pandoc -> PandocPure Text) -> Pandoc -> PandocPure Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [Attr -> [Block] -> Block
Div (Text
l, [], []) []])
  in (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'}') (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'{') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
ll

escapeLaTeX :: T.Text -> T.Text
escapeLaTeX :: Text -> Text
escapeLaTeX Text
l =
  let ll :: Text
ll = (PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> (PandocError -> [Char]) -> PandocError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> [Char]
forall a. Show a => a -> [Char]
show) Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> Either PandocError Text -> Text
forall a b. (a -> b) -> a -> b
$
            PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
forall a. Default a => a
def (Pandoc -> PandocPure Text) -> Pandoc -> PandocPure Text
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc Meta
nullMeta [[Inline] -> Block
Plain [Text -> Inline
Str Text
l]])
      pv :: Maybe Version
pv = ((Version, [Char]) -> Version)
-> Maybe (Version, [Char]) -> Maybe Version
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Version, [Char]) -> Version
forall a b. (a, b) -> a
fst (Maybe (Version, [Char]) -> Maybe Version)
-> ([Char] -> Maybe (Version, [Char])) -> [Char] -> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, [Char]) -> Bool)
-> [(Version, [Char])] -> Maybe (Version, [Char])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Char] -> Bool)
-> ((Version, [Char]) -> [Char]) -> (Version, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [Char]) -> [Char]
forall a b. (a, b) -> b
snd) ([(Version, [Char])] -> Maybe (Version, [Char]))
-> ([Char] -> [(Version, [Char])])
-> [Char]
-> Maybe (Version, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadP Version -> [Char] -> [(Version, [Char])]
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion ([Char] -> Maybe Version) -> [Char] -> Maybe Version
forall a b. (a -> b) -> a -> b
$ VERSION_pandoc
      mv :: Version
mv = [Int] -> Version
makeVersion [Int
2,Int
11,Int
0,Int
1]
      cond :: Bool
cond = Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Version
mv Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Version
pv
  in if Bool
cond then Text
ll else Text
l

getRefLabel :: T.Text -> [Inline] -> Maybe T.Text
getRefLabel :: Text -> [Inline] -> Maybe Text
getRefLabel Text
_ [] = Maybe Text
forall a. Maybe a
Nothing
getRefLabel Text
tag [Inline]
ils
  | Str Text
attr <- [Inline] -> Inline
forall a. HasCallStack => [a] -> a
last [Inline]
ils
  , (Inline -> Bool) -> [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) ([Inline] -> [Inline]
forall a. HasCallStack => [a] -> [a]
init [Inline]
ils)
  , Text
"}" Text -> Text -> Bool
`T.isSuffixOf` Text
attr
  , (Text
"{#"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
tagText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
":") Text -> Text -> Bool
`T.isPrefixOf` Text
attr
  = HasCallStack => Text -> Text
Text -> Text
T.init (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Text -> Maybe Text
T.stripPrefix Text
"{#" Text
attr
getRefLabel Text
_ [Inline]
_ = Maybe Text
forall a. Maybe a
Nothing

isSpace :: Inline -> Bool
isSpace :: Inline -> Bool
isSpace = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> (Inline -> Bool) -> Inline -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) (Inline -> Bool -> Bool) -> (Inline -> Bool) -> Inline -> Bool
forall a b. (Inline -> a -> b) -> (Inline -> a) -> Inline -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
SoftBreak)

isLaTeXRawBlockFmt :: Format -> Bool
isLaTeXRawBlockFmt :: Format -> Bool
isLaTeXRawBlockFmt (Format Text
"latex") = Bool
True
isLaTeXRawBlockFmt (Format Text
"tex") = Bool
True
isLaTeXRawBlockFmt Format
_ = Bool
False