Refs.hs

{-
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.
-}

module Text.Pandoc.CrossRef.References.Refs (replaceRefs) where

import Control.Arrow as A
import Data.Function
import Numeric.Natural
import Data.List
import qualified Data.List.HT as HT
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Text.Pandoc.Builder
import qualified Data.Sequence as S
import Data.Sequence (ViewR(..))
import Control.Monad (liftM2, join)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty)

import Debug.Trace
import Lens.Micro
import Text.Pandoc.CrossRef.References.Types
import Text.Pandoc.CrossRef.Util.Options
import Text.Pandoc.CrossRef.Util.Template
import Text.Pandoc.CrossRef.Util.Util

replaceRefs :: [Citation] -> Options -> References -> Inlines
replaceRefs cits opts = intercalate' (text ", ") . map fromList <$> mapM replaceRefs' (NE.groupBy eqPrefix cits)
  where
    eqPrefix = (==) `on` getLabelPrefix . citationId
    replaceRefs' :: NonEmpty Citation -> References -> [Inline]
    replaceRefs' cits'
      | Just prefix <- getLabelPrefix . citationId $ NE.head cits'
      = replaceRefs'' prefix cits'
      | otherwise = return [Cite (NE.toList cits') il']
        where
          il' = toList $
              str "["
            <> intercalate' (text "; ") (map citationToInlines $ NE.toList cits')
            <> str "]"
          citationToInlines c =
            fromList (citationPrefix c) <> text ("@" <> citationId c)
              <> fromList (citationSuffix c)
    replaceRefs'' :: Prefix -> NonEmpty Citation -> References -> [Inline]
    replaceRefs'' = ($ opts) . flip $
      if isLatexFormat opts
      then replaceRefsLatex
      else replaceRefsOther

-- accessors to options
prefMap :: Prefix -> (Options -> Bool -> Int -> [Inline], Options -> Template)
prefMap = \case
  PfxImg -> (figPrefix, figPrefixTemplate)
  PfxEqn -> (eqnPrefix, eqnPrefixTemplate)
  PfxTbl -> (tblPrefix, tblPrefixTemplate)
  PfxLst -> (lstPrefix, lstPrefixTemplate)
  PfxSec -> (secPrefix, secPrefixTemplate)

prefixes :: [Prefix]
prefixes = [minBound..]

getRefPrefix :: Options -> Prefix -> Bool -> Int -> [Inline] -> [Inline]
getRefPrefix opts prefix capitalize num cit =
  applyTemplate' (M.fromDistinctAscList [("i", cit), ("p", refprefix)])
        $ reftempl opts
  where (refprefixf, reftempl) = prefMap prefix
        refprefix = refprefixf opts capitalize num

replaceRefsLatex :: Prefix -> Options -> NonEmpty Citation -> References -> [Inline]
replaceRefsLatex prefix opts cits
  | cref opts
  = replaceRefsLatex' prefix opts cits
  | otherwise
  = toList . intercalate' (text ", ") . map fromList <$>
      mapM (replaceRefsLatex' prefix opts) (NE.groupBy citationGroupPred cits)

replaceRefsLatex' :: Prefix -> Options -> NonEmpty Citation -> References -> [Inline]
replaceRefsLatex' prefix opts cits =
  return $ p [texcit]
  where
    texcit =
      RawInline (Format "tex") $
      if cref opts then
        cref'<>"{"<>listLabels prefix "" "," "" cits<>"}"
        else
          listLabels prefix "\\ref{" ", " "}" cits
    suppressAuthor = all ((==SuppressAuthor) . citationMode) cits
    noPrefix = all (null . citationPrefix) cits
    p | cref opts = id
      | suppressAuthor
      = id
      | noPrefix
      = getRefPrefix opts prefix cap (length cits - 1)
      | otherwise = ((citationPrefix (NE.head cits) <> [Space]) <>)
    cap = isFirstUpper . citationId . NE.head $ cits
    cref' | suppressAuthor = "\\labelcref"
          | cap = "\\Cref"
          | otherwise = "\\cref"

listLabels :: Prefix -> T.Text -> T.Text -> T.Text -> NonEmpty Citation -> T.Text
listLabels prefix p sep s
  = T.intercalate sep
  . map ((p <>) . (<> s) . mkLaTeXLabel' . (pfxTextCol prefix <>) . getLabelWithoutPrefix . citationId)
  . NE.toList


getLabelWithoutPrefix :: T.Text -> T.Text
getLabelWithoutPrefix = T.drop 1 . T.dropWhile (/=':')

getLabelPrefix :: T.Text -> Maybe Prefix
getLabelPrefix lab = find (p `hasPfx`) prefixes
  where
    p = uncapitalizeFirst $ flip T.snoc ':' . T.takeWhile (/=':') $ lab

replaceRefsOther :: Prefix -> Options -> NonEmpty Citation -> References -> [Inline]
replaceRefsOther prefix opts cits = toList . intercalate' (text ", ") . map fromList <$>
    traverse (replaceRefsOther' prefix opts) (NE.groupBy citationGroupPred cits)

citationGroupPred :: Citation -> Citation -> Bool
citationGroupPred = (==) `on` liftM2 (,) citationPrefix citationMode

replaceRefsOther' :: Prefix -> Options -> NonEmpty Citation -> References -> [Inline]
replaceRefsOther' prefix opts cits refs =
  let
    indices = getRefIndex prefix refs <$> NE.toList cits
    cap = isFirstUpper . citationId . NE.head $ cits
    writePrefix | all ((==SuppressAuthor) . citationMode) cits
                = id
                | all (null . citationPrefix) cits
                = cmap $ getRefPrefix opts prefix cap (length cits - 1)
                | otherwise
                = cmap $ toList . ((fromList (citationPrefix (NE.head cits)) <> space) <>) . fromList
    cmap f [Link attr t w]
      | nameInLink opts = [Link attr (f t) w]
    cmap f x = f x
  in writePrefix (makeIndices opts indices)

data RefData = RefData { rdGlob :: Maybe Natural
                       , rdLabel :: T.Text
                       , rdIdx :: Maybe Index
                       , rdSubfig :: Maybe Index
                       , rdSuffix :: [Inline]
                       , rdTitle :: Maybe [Inline]
                       , rdPfx :: Prefix
                       } deriving (Eq)

getRefIndex :: Prefix -> References -> Citation -> RefData
getRefIndex prefix refs Citation{citationId=cid,citationSuffix=suf}
  = let ref = M.lookup (IdxRef prefix lab) $ refs ^. prop
        sub = refSubfigure <$> ref
        idx = refIndex <$> ref
        tit = refTitle <$> ref
        glob = refGlobal <$> ref
    in RefData
      { rdGlob = glob
      , rdLabel = lab
      , rdIdx = idx
      , rdSubfig = join sub
      , rdSuffix = suf
      , rdTitle = tit
      , rdPfx = prefix
      }
  where
  prop = refsAt prefix
  lab = pfxTextCol prefix <> getLabelWithoutPrefix cid

data RefItem = RefRange RefData RefData | RefSingle RefData

makeIndices :: Options -> [RefData] -> [Inline]
makeIndices o = format . concatMap f . HT.groupBy g . sortOn rdGlob . nub
  where
  g :: RefData -> RefData -> Bool
  g a b = all (null . rdSuffix) [a, b] && (
            all (isNothing . rdSubfig) [a, b] &&
            Just True == (liftM2 follows `on` rdIdx) b a ||
            rdIdx a == rdIdx b &&
            Just True == (liftM2 follows `on` rdSubfig) b a
          )
  follows :: Index -> Index -> Bool
  follows a b
    | ai :> al <- S.viewr a
    , bi :> bl <- S.viewr b
    = ai == bi && A.first succ bl == al
    | otherwise = False
  f :: [RefData] -> [RefItem]
  f []  = []                          -- drop empty lists
  f [w] = [RefSingle w]                   -- single value
  f [w1,w2] = [RefSingle w1, RefSingle w2] -- two values
  f (x:xs) = [RefRange x (last xs)] -- shorten more than two values
  format :: [RefItem] -> [Inline]
  format [] = []
  format [x] = toList $ show'' x
  format [x, y] = toList $ show'' x <> fromList (pairDelim o) <> show'' y
  format xs = toList $ intercalate' (fromList $ refDelim o) init' <> fromList (lastDelim o) <> last'
    where initlast []     = error "emtpy list in initlast"
          initlast [y]    = ([], y)
          initlast (y:ys) = first (y:) $ initlast ys
          (init', last') = initlast $ map show'' xs
  show'' :: RefItem -> Inlines
  show'' (RefSingle x) = show' x
  show'' (RefRange x y) = show' x <> fromList (rangeDelim o) <> show' y
  show' :: RefData -> Inlines
  show' RefData{rdLabel=l, rdIdx=Just i, rdSubfig = sub, rdSuffix = suf, rdTitle=tit, rdPfx=pfx}
    | linkReferences o = link ('#' `T.cons` l) "" (fromList txt)
    | otherwise = fromList txt
    where
      txt
        | Just sub' <- sub
        = let vars = M.fromDistinctAscList
                      [ ("i", chapPrefix (chapDelim o) i)
                      , ("s", chapPrefix (chapDelim o) sub')
                      , ("suf", suf)
                      , ("t", fromMaybe mempty tit)
                      ]
          in applyTemplate' vars $ subfigureRefIndexTemplate o
        | otherwise
        = let vars = M.fromDistinctAscList
                      [ ("i", chapPrefix (chapDelim o) i)
                      , ("suf", suf)
                      , ("t", fromMaybe mempty tit)
                      ]
          in applyTemplate' vars $ refIndexTemplate o pfx
  show' RefData{rdLabel=l, rdIdx=Nothing, rdSuffix = suf} =
    trace (T.unpack $ "Undefined cross-reference: " <> l)
          (strong (text $ "¿" <> l <> "?") <> fromList suf)