{-
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
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null f a
xs = forall a. Monoid a => a
mempty
  | Bool
otherwise = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\a
x a
acc -> a
x forall a. Semigroup a => a -> a -> a
<> a
s 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 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"+-" :: String)) Text
f forall a. Eq a => a -> a -> Bool
== Text
fmt
isFormat Text
_ Maybe Format
Nothing = Bool
False

isLatexFormat :: Maybe Format -> Bool
isLatexFormat :: Maybe Format -> Bool
isLatexFormat = Text -> Maybe Format -> Bool
isFormat Text
"latex" forall {f :: * -> *}. Applicative f => f Bool -> f Bool -> f Bool
`or'` Text -> Maybe Format -> Bool
isFormat Text
"beamer"
  where f Bool
a or' :: f Bool -> f Bool -> f Bool
`or'` f Bool
b = Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Bool
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f Bool
b

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 = forall a. Many a -> [a]
toList
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (forall a. [a] -> Many a
fromList [Inline]
delim)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Many Inline
str
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
S.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. a -> Maybe a -> a
fromMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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 <- GenRR m
f a
x
  case ReplacedResult a
res of
    Replaced Bool
True a
x' -> forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM (forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace GenRR m
f) a
x'
    Replaced Bool
False a
x' -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x'
    NotReplaced Bool
True -> forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM (forall (m :: * -> *). Monad m => GenRR m -> GenericM m
runReplace GenRR m
f) a
x
    NotReplaced Bool
False -> 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 = forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m (ReplacedResult a))
-> (b -> m (ReplacedResult b)) -> a -> m (ReplacedResult a)
extRR (forall a b. a -> b -> a
const 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 = forall (m :: * -> *) a. RR m a -> a -> m (ReplacedResult a)
unRR (forall (m :: * -> *) a. (a -> m (ReplacedResult a)) -> RR m a
RR a -> m (ReplacedResult a)
def' forall a b (c :: * -> *).
(Typeable a, Typeable b) =>
c a -> c b -> c a
`ext0` 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Bool -> ReplacedResult a
NotReplaced Bool
recurse

noReplaceRecurse :: Monad m => m (ReplacedResult a)
noReplaceRecurse :: forall (m :: * -> *) a. Monad m => m (ReplacedResult a)
noReplaceRecurse = 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 = 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{" forall a. Semigroup a => a -> a -> a
<> Text -> Text
mkLaTeXLabel' Text
l forall a. Semigroup a => a -> a -> a
<> Text
"}"

mkLaTeXLabel' :: T.Text -> T.Text
mkLaTeXLabel' :: Text -> Text
mkLaTeXLabel' Text
l =
  let ll :: Text
ll = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
            forall a. PandocPure a -> Either PandocError a
runPure (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX forall a. Default a => a
def 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 (forall a. Eq a => a -> a -> Bool
/=Char
'}') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'{') forall a b. (a -> b) -> a -> b
$ Text
ll

escapeLaTeX :: T.Text -> T.Text
escapeLaTeX :: Text -> Text
escapeLaTeX Text
l =
  let ll :: Text
ll = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$
            forall a. PandocPure a -> Either PandocError a
runPure (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX forall a. Default a => a
def 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Version
mv 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
_ [] = forall a. Maybe a
Nothing
getRefLabel Text
tag [Inline]
ils
  | Str Text
attr <- forall a. [a] -> a
last [Inline]
ils
  , forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==Inline
Space) (forall a. [a] -> [a]
init [Inline]
ils)
  , Text
"}" Text -> Text -> Bool
`T.isSuffixOf` Text
attr
  , (Text
"{#"forall a. Semigroup a => a -> a -> a
<>Text
tagforall a. Semigroup a => a -> a -> a
<>Text
":") Text -> Text -> Bool
`T.isPrefixOf` Text
attr
  = Text -> Text
T.init 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]
_ = forall a. Maybe a
Nothing

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