{-
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 OverloadedStrings #-}
module Text.Pandoc.CrossRef.References.Refs (replaceRefs) where

import Text.Pandoc.Definition
import Text.Pandoc.Builder
import Control.Monad.State hiding (get, modify)
import Data.List
import qualified Data.List.HT as HT
import qualified Data.Text as T
import Data.Maybe
import Data.Function
import qualified Data.Map as M
import Control.Arrow as A

import Data.Accessor
import Data.Accessor.Monad.Trans.State
import Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.CrossRef.Util.Template
import Text.Pandoc.CrossRef.Util.Util
import Text.Pandoc.CrossRef.Util.Options
import Control.Applicative
import Debug.Trace
import Prelude

replaceRefs :: Options -> [Inline] -> WS [Inline]
replaceRefs :: Options -> [Inline] -> WS [Inline]
replaceRefs Options
opts (Cite [Citation]
cits [Inline]
_:[Inline]
xs)
  = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline])
-> ([[Inline]] -> Many Inline) -> [[Inline]] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
xs) (Many Inline -> Many Inline)
-> ([[Inline]] -> Many Inline) -> [[Inline]] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (Text -> Many Inline
text Text
", ") ([Many Inline] -> Many Inline)
-> ([[Inline]] -> [Many Inline]) -> [[Inline]] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Many Inline) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([[Inline]] -> [Inline])
-> StateT References Identity [[Inline]] -> WS [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Citation] -> WS [Inline])
-> [[Citation]] -> StateT References Identity [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Citation] -> WS [Inline]
replaceRefs' ((Citation -> Citation -> Bool) -> [Citation] -> [[Citation]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Citation -> Citation -> Bool
eqPrefix [Citation]
cits)
  where
    eqPrefix :: Citation -> Citation -> Bool
eqPrefix Citation
a Citation
b = (Maybe Text -> Maybe Text -> Bool)
-> (Maybe Text, Maybe Text) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Maybe Text, Maybe Text) -> Bool)
-> (Maybe Text, Maybe Text) -> Bool
forall a b. (a -> b) -> a -> b
$
      ((Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
uncapitalizeFirst (Maybe Text -> Maybe Text)
-> (Citation -> Maybe Text) -> Citation -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
getLabelPrefix (Text -> Maybe Text)
-> (Citation -> Text) -> Citation -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId) (Citation -> Maybe Text)
-> (Citation, Citation) -> (Maybe Text, Maybe Text)
forall b' c'. (b' -> c') -> (b', b') -> (c', c')
<***> (Citation
a,Citation
b)
    <***> :: (b' -> c') -> (b', b') -> (c', c')
(<***>) = ((b' -> c') -> (b' -> c') -> (b', b') -> (c', c'))
-> (b' -> c') -> (b', b') -> (c', c')
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (b' -> c') -> (b' -> c') -> (b', b') -> (c', c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)
    replaceRefs' :: [Citation] -> WS [Inline]
replaceRefs' [Citation]
cits'
      | Just Text
prefix <- [Citation] -> Maybe Text
allCitsPrefix [Citation]
cits'
      = Text -> Options -> [Citation] -> WS [Inline]
replaceRefs'' Text
prefix Options
opts [Citation]
cits'
      | Bool
otherwise = [Inline] -> WS [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Citation] -> [Inline] -> Inline
Cite [Citation]
cits' [Inline]
il']
        where
          il' :: [Inline]
il' = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$
              Text -> Many Inline
str Text
"["
            Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline -> [Many Inline] -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (Text -> Many Inline
text Text
"; ") ((Citation -> Many Inline) -> [Citation] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map Citation -> Many Inline
citationToInlines [Citation]
cits')
            Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
str Text
"]"
          citationToInlines :: Citation -> Many Inline
citationToInlines Citation
c =
            [Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Citation -> [Inline]
citationPrefix Citation
c) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Text -> Many Inline
text (Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Citation -> Text
citationId Citation
c)
              Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Citation -> [Inline]
citationSuffix Citation
c)
    replaceRefs'' :: Text -> Options -> [Citation] -> WS [Inline]
replaceRefs'' = case Options -> Maybe Format
outFormat Options
opts of
                    Maybe Format
f | Maybe Format -> Bool
isLatexFormat Maybe Format
f -> Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex
                    Maybe Format
_                      -> Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther
replaceRefs Options
_ [Inline]
x = [Inline] -> WS [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return [Inline]
x

-- accessors to state variables
accMap :: M.Map T.Text (Accessor References RefMap)
accMap :: Map Text (Accessor References RefMap)
accMap = [(Text, Accessor References RefMap)]
-> Map Text (Accessor References RefMap)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
"fig:",Accessor References RefMap
imgRefs)
                    ,(Text
"eq:" ,Accessor References RefMap
eqnRefs)
                    ,(Text
"tbl:",Accessor References RefMap
tblRefs)
                    ,(Text
"lst:",Accessor References RefMap
lstRefs)
                    ,(Text
"sec:",Accessor References RefMap
secRefs)
                    ]

-- accessors to options
prefMap :: M.Map T.Text (Options -> Bool -> Int -> [Inline], Options -> Template)
prefMap :: Map Text (Options -> Bool -> Int -> [Inline], Options -> Template)
prefMap = [(Text, (Options -> Bool -> Int -> [Inline], Options -> Template))]
-> Map
     Text (Options -> Bool -> Int -> [Inline], Options -> Template)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
"fig:",(Options -> Bool -> Int -> [Inline]
figPrefix, Options -> Template
figPrefixTemplate))
                     ,(Text
"eq:" ,(Options -> Bool -> Int -> [Inline]
eqnPrefix, Options -> Template
eqnPrefixTemplate))
                     ,(Text
"tbl:",(Options -> Bool -> Int -> [Inline]
tblPrefix, Options -> Template
tblPrefixTemplate))
                     ,(Text
"lst:",(Options -> Bool -> Int -> [Inline]
lstPrefix, Options -> Template
lstPrefixTemplate))
                     ,(Text
"sec:",(Options -> Bool -> Int -> [Inline]
secPrefix, Options -> Template
secPrefixTemplate))
                     ]

prefixes :: [T.Text]
prefixes :: [Text]
prefixes = Map Text (Accessor References RefMap) -> [Text]
forall k a. Map k a -> [k]
M.keys Map Text (Accessor References RefMap)
accMap

getRefPrefix :: Options -> T.Text -> Bool -> Int -> [Inline] -> [Inline]
getRefPrefix :: Options -> Text -> Bool -> Int -> [Inline] -> [Inline]
getRefPrefix Options
opts Text
prefix Bool
capitalize Int
num [Inline]
cit =
  Map Text [Inline] -> Template -> [Inline]
applyTemplate' ([(Text, [Inline])] -> Map Text [Inline]
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList [(Text
"i", [Inline]
cit), (Text
"p", [Inline]
refprefix)])
        (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
reftempl Options
opts
  where (Options -> Bool -> Int -> [Inline]
refprefixf, Options -> Template
reftempl) = Text
-> Map
     Text (Options -> Bool -> Int -> [Inline], Options -> Template)
-> (Options -> Bool -> Int -> [Inline], Options -> Template)
forall k v. Ord k => k -> Map k v -> v
lookupUnsafe Text
prefix Map Text (Options -> Bool -> Int -> [Inline], Options -> Template)
prefMap
        refprefix :: [Inline]
refprefix = Options -> Bool -> Int -> [Inline]
refprefixf Options
opts Bool
capitalize Int
num


lookupUnsafe :: Ord k => k -> M.Map k v -> v
lookupUnsafe :: k -> Map k v -> v
lookupUnsafe = (Maybe v -> v
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe v -> v) -> (Map k v -> Maybe v) -> Map k v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Map k v -> Maybe v) -> Map k v -> v)
-> (k -> Map k v -> Maybe v) -> k -> Map k v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

allCitsPrefix :: [Citation] -> Maybe T.Text
allCitsPrefix :: [Citation] -> Maybe Text
allCitsPrefix [Citation]
cits = (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Text -> Bool
isCitationPrefix [Text]
prefixes
  where
  isCitationPrefix :: Text -> Bool
isCitationPrefix Text
p =
    (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Text
p Text -> Text -> Bool
`T.isPrefixOf`) (Text -> Bool) -> (Citation -> Text) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
uncapitalizeFirst (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId) [Citation]
cits

replaceRefsLatex :: T.Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex :: Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex Text
prefix Options
opts [Citation]
cits
  | Options -> Bool
cref Options
opts
  = Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex' Text
prefix Options
opts [Citation]
cits
  | Bool
otherwise
  = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline])
-> ([[Inline]] -> Many Inline) -> [[Inline]] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (Text -> Many Inline
text Text
", ") ([Many Inline] -> Many Inline)
-> ([[Inline]] -> [Many Inline]) -> [[Inline]] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Many Inline) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([[Inline]] -> [Inline])
-> StateT References Identity [[Inline]] -> WS [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ([Citation] -> WS [Inline])
-> [[Citation]] -> StateT References Identity [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex' Text
prefix Options
opts) ((Citation -> Citation -> Bool) -> [Citation] -> [[Citation]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Citation -> Citation -> Bool
citationGroupPred [Citation]
cits)

replaceRefsLatex' :: T.Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex' :: Text -> Options -> [Citation] -> WS [Inline]
replaceRefsLatex' Text
prefix Options
opts [Citation]
cits =
  [Inline] -> WS [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> WS [Inline]) -> [Inline] -> WS [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
p [Inline
texcit]
  where
    texcit :: Inline
texcit =
      Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"tex") (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$
      if Options -> Bool
cref Options
opts then
        Text
cref'Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"{"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text -> Text -> Text -> Text -> [Citation] -> Text
listLabels Text
prefix Text
"" Text
"," Text
"" [Citation]
citsText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"}"
        else
          Text -> Text -> Text -> Text -> [Citation] -> Text
listLabels Text
prefix Text
"\\ref{" Text
", " Text
"}" [Citation]
cits
    suppressAuthor :: Bool
suppressAuthor = (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
==CitationMode
SuppressAuthor) (CitationMode -> Bool)
-> (Citation -> CitationMode) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> CitationMode
citationMode) [Citation]
cits
    noPrefix :: Bool
noPrefix = (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool) -> (Citation -> [Inline]) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationPrefix) [Citation]
cits
    p :: [Inline] -> [Inline]
p | Options -> Bool
cref Options
opts = [Inline] -> [Inline]
forall a. a -> a
id
      | Bool
suppressAuthor
      = [Inline] -> [Inline]
forall a. a -> a
id
      | Bool
noPrefix
      = Options -> Text -> Bool -> Int -> [Inline] -> [Inline]
getRefPrefix Options
opts Text
prefix Bool
cap ([Citation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Citation]
cits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Bool
otherwise = ((Citation -> [Inline]
citationPrefix ([Citation] -> Citation
forall a. [a] -> a
head [Citation]
cits) [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<> [Inline
Space]) [Inline] -> [Inline] -> [Inline]
forall a. Semigroup a => a -> a -> a
<>)
    cap :: Bool
cap = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
isFirstUpper (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
getLabelPrefix (Text -> Maybe Text)
-> ([Citation] -> Text) -> [Citation] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId (Citation -> Text)
-> ([Citation] -> Citation) -> [Citation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation] -> Citation
forall a. [a] -> a
head ([Citation] -> Maybe Text) -> [Citation] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Citation]
cits
    cref' :: Text
cref' | Bool
suppressAuthor = Text
"\\labelcref"
          | Bool
cap = Text
"\\Cref"
          | Bool
otherwise = Text
"\\cref"

listLabels :: T.Text -> T.Text -> T.Text -> T.Text -> [Citation] -> T.Text
listLabels :: Text -> Text -> Text -> Text -> [Citation] -> Text
listLabels Text
prefix Text
p Text
sep Text
s =
  Text -> [Text] -> Text
T.intercalate Text
sep ([Text] -> Text) -> ([Citation] -> [Text]) -> [Citation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Citation -> Text) -> [Citation] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
mkLaTeXLabel' (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
prefixText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getLabelWithoutPrefix (Text -> Text) -> (Citation -> Text) -> Citation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId)

getLabelWithoutPrefix :: T.Text -> T.Text
getLabelWithoutPrefix :: Text -> Text
getLabelWithoutPrefix = 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
':')

getLabelPrefix :: T.Text -> Maybe T.Text
getLabelPrefix :: Text -> Maybe Text
getLabelPrefix Text
lab
  | Text -> Text
uncapitalizeFirst Text
p Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
prefixes = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p
  | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing
  where p :: Text
p = (Text -> Char -> Text) -> Char -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Char -> Text
T.snoc Char
':' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
':') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
lab

replaceRefsOther :: T.Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther :: Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther Text
prefix Options
opts [Citation]
cits = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline])
-> ([[Inline]] -> Many Inline) -> [[Inline]] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many Inline -> [Many Inline] -> Many Inline
forall a (f :: * -> *).
(Eq a, Monoid a, Foldable f) =>
a -> f a -> a
intercalate' (Text -> Many Inline
text Text
", ") ([Many Inline] -> Many Inline)
-> ([[Inline]] -> [Many Inline]) -> [[Inline]] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Inline] -> Many Inline) -> [[Inline]] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map [Inline] -> Many Inline
forall a. [a] -> Many a
fromList ([[Inline]] -> [Inline])
-> StateT References Identity [[Inline]] -> WS [Inline]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ([Citation] -> WS [Inline])
-> [[Citation]] -> StateT References Identity [[Inline]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther' Text
prefix Options
opts) ((Citation -> Citation -> Bool) -> [Citation] -> [[Citation]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Citation -> Citation -> Bool
citationGroupPred [Citation]
cits)

citationGroupPred :: Citation -> Citation -> Bool
citationGroupPred :: Citation -> Citation -> Bool
citationGroupPred = ([Inline], CitationMode) -> ([Inline], CitationMode) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (([Inline], CitationMode) -> ([Inline], CitationMode) -> Bool)
-> (Citation -> ([Inline], CitationMode))
-> Citation
-> Citation
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([Inline] -> CitationMode -> ([Inline], CitationMode))
-> (Citation -> [Inline])
-> (Citation -> CitationMode)
-> Citation
-> ([Inline], CitationMode)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Citation -> [Inline]
citationPrefix Citation -> CitationMode
citationMode

replaceRefsOther' :: T.Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther' :: Text -> Options -> [Citation] -> WS [Inline]
replaceRefsOther' Text
prefix Options
opts [Citation]
cits = do
  [RefData]
indices <- (Citation -> StateT References Identity RefData)
-> [Citation] -> StateT References Identity [RefData]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Options -> Citation -> StateT References Identity RefData
getRefIndex Text
prefix Options
opts) [Citation]
cits
  let
    cap :: Bool
cap = Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
isFirstUpper (Maybe Text -> Bool) -> Maybe Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
getLabelPrefix (Text -> Maybe Text)
-> ([Citation] -> Text) -> [Citation] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> Text
citationId (Citation -> Text)
-> ([Citation] -> Citation) -> [Citation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation] -> Citation
forall a. [a] -> a
head ([Citation] -> Maybe Text) -> [Citation] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Citation]
cits
    writePrefix :: [Inline] -> [Inline]
writePrefix | (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((CitationMode -> CitationMode -> Bool
forall a. Eq a => a -> a -> Bool
==CitationMode
SuppressAuthor) (CitationMode -> Bool)
-> (Citation -> CitationMode) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> CitationMode
citationMode) [Citation]
cits
                = [Inline] -> [Inline]
forall a. a -> a
id
                | (Citation -> Bool) -> [Citation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool) -> (Citation -> [Inline]) -> Citation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation -> [Inline]
citationPrefix) [Citation]
cits
                = ([Inline] -> [Inline]) -> [Inline] -> [Inline]
cmap (([Inline] -> [Inline]) -> [Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Text -> Bool -> Int -> [Inline] -> [Inline]
getRefPrefix Options
opts Text
prefix Bool
cap ([Citation] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Citation]
cits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                | Bool
otherwise
                = ([Inline] -> [Inline]) -> [Inline] -> [Inline]
cmap (([Inline] -> [Inline]) -> [Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline])
-> ([Inline] -> Many Inline) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Citation -> [Inline]
citationPrefix ([Citation] -> Citation
forall a. [a] -> a
head [Citation]
cits)) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
space) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<>) (Many Inline -> Many Inline)
-> ([Inline] -> Many Inline) -> [Inline] -> Many Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Many Inline
forall a. [a] -> Many a
fromList
    cmap :: ([Inline] -> [Inline]) -> [Inline] -> [Inline]
cmap [Inline] -> [Inline]
f [Link Attr
attr [Inline]
t Target
w]
      | Options -> Bool
nameInLink Options
opts = [Attr -> [Inline] -> Target -> Inline
Link Attr
attr ([Inline] -> [Inline]
f [Inline]
t) Target
w]
    cmap [Inline] -> [Inline]
f [Inline]
x = [Inline] -> [Inline]
f [Inline]
x
  [Inline] -> WS [Inline]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inline] -> WS [Inline]) -> [Inline] -> WS [Inline]
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Inline]
writePrefix (Options -> [RefData] -> [Inline]
makeIndices Options
opts [RefData]
indices)

data RefData = RefData { RefData -> Text
rdLabel :: T.Text
                       , RefData -> Maybe Index
rdIdx :: Maybe Index
                       , RefData -> Maybe Index
rdSubfig :: Maybe Index
                       , RefData -> [Inline]
rdSuffix :: [Inline]
                       } deriving (RefData -> RefData -> Bool
(RefData -> RefData -> Bool)
-> (RefData -> RefData -> Bool) -> Eq RefData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefData -> RefData -> Bool
$c/= :: RefData -> RefData -> Bool
== :: RefData -> RefData -> Bool
$c== :: RefData -> RefData -> Bool
Eq)

instance Ord RefData where
  <= :: RefData -> RefData -> Bool
(<=) = Maybe Index -> Maybe Index -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (Maybe Index -> Maybe Index -> Bool)
-> (RefData -> Maybe Index) -> RefData -> RefData -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RefData -> Maybe Index
rdIdx

getRefIndex :: T.Text -> Options -> Citation -> WS RefData
getRefIndex :: Text -> Options -> Citation -> StateT References Identity RefData
getRefIndex Text
prefix Options
_opts Citation{citationId :: Citation -> Text
citationId=Text
cid,citationSuffix :: Citation -> [Inline]
citationSuffix=[Inline]
suf}
  = do
    Maybe RefRec
ref <- Text -> RefMap -> Maybe RefRec
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
lab (RefMap -> Maybe RefRec)
-> StateT References Identity RefMap
-> StateT References Identity (Maybe RefRec)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Accessor References RefMap -> StateT References Identity RefMap
forall (m :: * -> *) r a. Monad m => T r a -> StateT r m a
get Accessor References RefMap
prop
    let sub :: Maybe (Maybe Index)
sub = RefRec -> Maybe Index
refSubfigure (RefRec -> Maybe Index) -> Maybe RefRec -> Maybe (Maybe Index)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RefRec
ref
        idx :: Maybe Index
idx = RefRec -> Index
refIndex (RefRec -> Index) -> Maybe RefRec -> Maybe Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RefRec
ref
    RefData -> StateT References Identity RefData
forall (m :: * -> *) a. Monad m => a -> m a
return RefData :: Text -> Maybe Index -> Maybe Index -> [Inline] -> RefData
RefData
      { rdLabel :: Text
rdLabel = Text
lab
      , rdIdx :: Maybe Index
rdIdx = Maybe Index
idx
      , rdSubfig :: Maybe Index
rdSubfig = Maybe (Maybe Index) -> Maybe Index
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe Index)
sub
      , rdSuffix :: [Inline]
rdSuffix = [Inline]
suf
      }
  where
  prop :: Accessor References RefMap
prop = Text
-> Map Text (Accessor References RefMap)
-> Accessor References RefMap
forall k v. Ord k => k -> Map k v -> v
lookupUnsafe Text
prefix Map Text (Accessor References RefMap)
accMap
  lab :: Text
lab = Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
getLabelWithoutPrefix Text
cid

data RefItem = RefRange RefData RefData | RefSingle RefData

makeIndices :: Options -> [RefData] -> [Inline]
makeIndices :: Options -> [RefData] -> [Inline]
makeIndices Options
o [RefData]
s = [RefItem] -> [Inline]
format ([RefItem] -> [Inline]) -> [RefItem] -> [Inline]
forall a b. (a -> b) -> a -> b
$ ([RefData] -> [RefItem]) -> [[RefData]] -> [RefItem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [RefData] -> [RefItem]
f ([[RefData]] -> [RefItem]) -> [[RefData]] -> [RefItem]
forall a b. (a -> b) -> a -> b
$ (RefData -> RefData -> Bool) -> [RefData] -> [[RefData]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
HT.groupBy RefData -> RefData -> Bool
g ([RefData] -> [[RefData]]) -> [RefData] -> [[RefData]]
forall a b. (a -> b) -> a -> b
$ [RefData] -> [RefData]
forall a. Ord a => [a] -> [a]
sort ([RefData] -> [RefData]) -> [RefData] -> [RefData]
forall a b. (a -> b) -> a -> b
$ [RefData] -> [RefData]
forall a. Eq a => [a] -> [a]
nub [RefData]
s
  where
  g :: RefData -> RefData -> Bool
  g :: RefData -> RefData -> Bool
g RefData
a RefData
b = (RefData -> Bool) -> [RefData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Inline] -> Bool) -> (RefData -> [Inline]) -> RefData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefData -> [Inline]
rdSuffix) [RefData
a, RefData
b] Bool -> Bool -> Bool
&& (
            (RefData -> Bool) -> [RefData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe Index -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Index -> Bool)
-> (RefData -> Maybe Index) -> RefData -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefData -> Maybe Index
rdSubfig) [RefData
a, RefData
b] Bool -> Bool -> Bool
&&
            Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ((Index -> Index -> Bool)
-> Maybe Index -> Maybe Index -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Index -> Index -> Bool
follows (Maybe Index -> Maybe Index -> Maybe Bool)
-> (RefData -> Maybe Index) -> RefData -> RefData -> Maybe Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RefData -> Maybe Index
rdIdx) RefData
b RefData
a Bool -> Bool -> Bool
||
            RefData -> Maybe Index
rdIdx RefData
a Maybe Index -> Maybe Index -> Bool
forall a. Eq a => a -> a -> Bool
== RefData -> Maybe Index
rdIdx RefData
b Bool -> Bool -> Bool
&&
            Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ((Index -> Index -> Bool)
-> Maybe Index -> Maybe Index -> Maybe Bool
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Index -> Index -> Bool
follows (Maybe Index -> Maybe Index -> Maybe Bool)
-> (RefData -> Maybe Index) -> RefData -> RefData -> Maybe Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` RefData -> Maybe Index
rdSubfig) RefData
b RefData
a
          )
  follows :: Index -> Index -> Bool
  follows :: Index -> Index -> Bool
follows Index
a Index
b
    | Just (Index
ai, (Int, Maybe Text)
al) <- Index -> Maybe (Index, (Int, Maybe Text))
forall a. [a] -> Maybe ([a], a)
HT.viewR Index
a
    , Just (Index
bi, (Int, Maybe Text)
bl) <- Index -> Maybe (Index, (Int, Maybe Text))
forall a. [a] -> Maybe ([a], a)
HT.viewR Index
b
    = Index
ai Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
bi Bool -> Bool -> Bool
&& (Int -> Int) -> (Int, Maybe Text) -> (Int, Maybe Text)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int, Maybe Text)
bl (Int, Maybe Text) -> (Int, Maybe Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Maybe Text)
al
  follows Index
_ Index
_ = Bool
False
  f :: [RefData] -> [RefItem]
  f :: [RefData] -> [RefItem]
f []  = []                          -- drop empty lists
  f [RefData
w] = [RefData -> RefItem
RefSingle RefData
w]                   -- single value
  f [RefData
w1,RefData
w2] = [RefData -> RefItem
RefSingle RefData
w1, RefData -> RefItem
RefSingle RefData
w2] -- two values
  f (RefData
x:[RefData]
xs) = [RefData -> RefData -> RefItem
RefRange RefData
x ([RefData] -> RefData
forall a. [a] -> a
last [RefData]
xs)] -- shorten more than two values
  format :: [RefItem] -> [Inline]
  format :: [RefItem] -> [Inline]
format [] = []
  format [RefItem
x] = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ RefItem -> Many Inline
show'' RefItem
x
  format [RefItem
x, RefItem
y] = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ RefItem -> Many Inline
show'' RefItem
x Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Options -> [Inline]
pairDelim Options
o) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> RefItem -> Many Inline
show'' RefItem
y
  format [RefItem]
xs = Many Inline -> [Inline]
forall a. Many a -> [a]
toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Many Inline -> [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] -> Many Inline) -> [Inline] -> Many Inline
forall a b. (a -> b) -> a -> b
$ Options -> [Inline]
refDelim Options
o) [Many Inline]
init' Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Options -> [Inline]
lastDelim Options
o) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> Many Inline
last'
    where initlast :: [a] -> ([a], a)
initlast []     = [Char] -> ([a], a)
forall a. HasCallStack => [Char] -> a
error [Char]
"emtpy list in initlast"
          initlast [a
y]    = ([], a
y)
          initlast (a
y:[a]
ys) = ([a] -> [a]) -> ([a], a) -> ([a], a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (([a], a) -> ([a], a)) -> ([a], a) -> ([a], a)
forall a b. (a -> b) -> a -> b
$ [a] -> ([a], a)
initlast [a]
ys
          ([Many Inline]
init', Many Inline
last') = [Many Inline] -> ([Many Inline], Many Inline)
forall a. [a] -> ([a], a)
initlast ([Many Inline] -> ([Many Inline], Many Inline))
-> [Many Inline] -> ([Many Inline], Many Inline)
forall a b. (a -> b) -> a -> b
$ (RefItem -> Many Inline) -> [RefItem] -> [Many Inline]
forall a b. (a -> b) -> [a] -> [b]
map RefItem -> Many Inline
show'' [RefItem]
xs
  show'' :: RefItem -> Inlines
  show'' :: RefItem -> Many Inline
show'' (RefSingle RefData
x) = RefData -> Many Inline
show' RefData
x
  show'' (RefRange RefData
x RefData
y) = RefData -> Many Inline
show' RefData
x Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList (Options -> [Inline]
rangeDelim Options
o) Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> RefData -> Many Inline
show' RefData
y
  show' :: RefData -> Inlines
  show' :: RefData -> Many Inline
show' RefData{rdLabel :: RefData -> Text
rdLabel=Text
l, rdIdx :: RefData -> Maybe Index
rdIdx=Just Index
i, rdSubfig :: RefData -> Maybe Index
rdSubfig = Maybe Index
sub, rdSuffix :: RefData -> [Inline]
rdSuffix = [Inline]
suf}
    | Options -> Bool
linkReferences Options
o = Text -> Text -> Many Inline -> Many Inline
link (Char
'#' Char -> Text -> Text
`T.cons` Text
l) Text
"" ([Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
txt)
    | Bool
otherwise = [Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
txt
    where
      txt :: [Inline]
txt
        | Just Index
sub' <- Maybe Index
sub
        = let vars :: Map Text [Inline]
vars = [(Text, [Inline])] -> Map Text [Inline]
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList
                      [ (Text
"i", [Inline] -> Index -> [Inline]
chapPrefix (Options -> [Inline]
chapDelim Options
o) Index
i)
                      , (Text
"s", [Inline] -> Index -> [Inline]
chapPrefix (Options -> [Inline]
chapDelim Options
o) Index
sub')
                      , (Text
"suf", [Inline]
suf)
                      ]
          in Map Text [Inline] -> Template -> [Inline]
applyTemplate' Map Text [Inline]
vars (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
subfigureRefIndexTemplate Options
o
        | Bool
otherwise
        = let vars :: Map Text [Inline]
vars = [(Text, [Inline])] -> Map Text [Inline]
forall k a. [(k, a)] -> Map k a
M.fromDistinctAscList
                      [ (Text
"i", [Inline] -> Index -> [Inline]
chapPrefix (Options -> [Inline]
chapDelim Options
o) Index
i)
                      , (Text
"suf", [Inline]
suf)
                      ]
          in Map Text [Inline] -> Template -> [Inline]
applyTemplate' Map Text [Inline]
vars (Template -> [Inline]) -> Template -> [Inline]
forall a b. (a -> b) -> a -> b
$ Options -> Template
refIndexTemplate Options
o
  show' RefData{rdLabel :: RefData -> Text
rdLabel=Text
l, rdIdx :: RefData -> Maybe Index
rdIdx=Maybe Index
Nothing, rdSuffix :: RefData -> [Inline]
rdSuffix = [Inline]
suf} =
    [Char] -> Many Inline -> Many Inline
forall a. [Char] -> a -> a
trace (Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Undefined cross-reference: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l)
          (Many Inline -> Many Inline
strong (Text -> Many Inline
text (Text -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ Text
"¿" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?") Many Inline -> Many Inline -> Many Inline
forall a. Semigroup a => a -> a -> a
<> [Inline] -> Many Inline
forall a. [a] -> Many a
fromList [Inline]
suf)