content: {-
  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.Blocks.Util
    ( replaceAttr
    , SPrefix(..)
    , latexCaption
    , latexCaptionRaw
    , chapIndex
    , mkCaption
    , setLabel
    , checkHidden
    , latexLabel
    , walkReplaceInlines
    ) where
  
  import qualified Data.Map as M
  import qualified Data.Set as Set
  import Data.Set (Set)
  import qualified Data.Text as T
  import Text.Pandoc.Definition
  import Text.Pandoc.Shared (stringify, deNote)
  import Text.Pandoc.Walk (walk)
  import Control.Monad (when)
  import Data.Maybe (fromMaybe)
  
  import Text.Read (readMaybe)
  
  import Control.Applicative
  import Lens.Micro.Mtl
  import Text.Pandoc.CrossRef.References.Types
  import Text.Pandoc.CrossRef.References.Monad
  import Text.Pandoc.CrossRef.Util.Options
  import Text.Pandoc.CrossRef.Util.Util
  import qualified Data.Sequence as S
  import Data.Sequence (ViewR(..))
  
  setLabel :: Options -> [Inline] -> [(T.Text, T.Text)] -> [(T.Text, T.Text)]
  setLabel opts idx
    | setLabelAttribute opts
    = (("label", stringify idx) :)
    . filter ((/= "label") . fst)
    | otherwise = id
  
  walkReplaceInlines :: [Inline] -> [Inline] -> Block -> Block
  walkReplaceInlines newTitle title = walk replaceInlines
    where
    replaceInlines xs
      | xs == title = newTitle
      | otherwise = xs
  
  -- | Exactly like 'Prefix' but doesn't have 'PfxSec'. @S@ stands for "safer".
  -- Sections are handled specially, see
  -- "Text.Pandoc.CrossRef.References.Blocks.Header"
  data SPrefix
    = SPfxImg
    | SPfxEqn
    | SPfxTbl
    | SPfxLst
  
  toPrefix :: SPrefix -> Prefix
  toPrefix = \case
    SPfxImg -> PfxImg
    SPfxEqn -> PfxEqn
    SPfxTbl -> PfxTbl
    SPfxLst -> PfxLst
  
  replaceAttr
    :: Maybe T.Text -- ^ Reference id
    -> [(T.Text, T.Text)] -- ^ Attributes
    -> [Inline] -- ^ Title
    -> SPrefix -- ^ Prefix type
    -> WS RefRec
  replaceAttr label attrs title (toPrefix -> pfx) = do
    let refLabel = lookup "label" attrs
        number = readMaybe . T.unpack =<< lookup "number" attrs
    Options{..} <- use wsOptions
    chap  <- S.take chaptersDepth <$> use (wsReferences . ctrsAt PfxSec)
    prop' <- use $ wsReferences . refsAt pfx
    curIdx <- use $ wsReferences . ctrsAt pfx
    globCtr <- wsReferences . stGlob <<%= (+ 1)
    let i | Just n <- number = n
          | chap' :> last' <- S.viewr curIdx
          , chap' == chap
          = succ . fst $ last'
          | otherwise = 1
        index = chap S.|> (i, refLabel <|> customLabel (Pfx pfx) i)
        synthLabel = IdxSynth globCtr
        label' = fromMaybe synthLabel $ IdxRef pfx <$> label
    when (M.member label' prop') $
      error $ "Duplicate label: " <> displayIdx label'
    wsReferences . ctrsAt pfx .= index
    refHideFromList <- checkHidden attrs
    let rec' = RefRec {
        refIndex= index
      , refGlobal = globCtr
      , refTitle= title
      , refSubfigure = Nothing
      , refHideFromList
      , refLabel = label
      }
    wsReferences . refsAt pfx %= M.insert label' rec'
    pure rec'
  
  chapIndex :: RefRec -> WS [Inline]
  chapIndex r = do
    Options{chapDelim} <- use wsOptions
    pure $ chapPrefix chapDelim $ refIndex r
  
  mkCaption :: Options -> T.Text -> [Inline] -> Block
  mkCaption opts style
    | outFormat opts == Just (Format "docx") = Div ("", [], [("custom-style", style)]) . return . Para
    | otherwise = Para
  
  latexLabel :: RefRec -> [Inline]
  latexLabel RefRec{refLabel}
    | Just lab <- refLabel = [ RawInline (Format "latex") $ mkLaTeXLabel lab ]
    | otherwise = mempty
  
  latexCaption :: RefRec -> [Inline]
  latexCaption ref = latexCaptionGeneric lcsRich ref <> latexLabel ref
    where
      lcsRich = LatexCaptionSpec
        { lcsEmptyShort = \caption ->
            [ RawInline (Format "latex") "\\caption[]", Span nullAttr caption ]
        , lcsWithoutShort = \caption ->
            [ RawInline (Format "latex") "\\caption", Span nullAttr caption ]
        , lcsWithShort = \(Short short) long ->
            [ RawInline (Format "latex") "\\caption["
            , Span nullAttr short
            , RawInline (Format "latex") "]"
            , Span nullAttr long ]
        }
  
  data LatexCaptionSpec a = LatexCaptionSpec
    { lcsEmptyShort :: [Inline] -> a
    , lcsWithShort :: Short -> [Inline] -> a
    , lcsWithoutShort :: [Inline] -> a
    }
  
  newtype Short = Short [Inline]
    deriving Eq
  
  -- | Only used in lstlistings code blocks.
  latexCaptionRaw :: RefRec -> T.Text
  latexCaptionRaw = latexCaptionGeneric lcsRaw
    where
      lcsRaw = LatexCaptionSpec
        { lcsEmptyShort = \caption -> "[]" <> stringify caption
        , lcsWithShort = \(Short short) long -> "[" <> stringify short <> "]" <> stringify long
        , lcsWithoutShort = stringify
        }
  
  latexCaptionGeneric :: Monoid a => LatexCaptionSpec a -> RefRec -> a
  latexCaptionGeneric LatexCaptionSpec{..} ref
    | refHideFromList ref = lcsEmptyShort caption
    | Short (refTitle ref) == sansFootnotes = lcsWithoutShort caption
    | otherwise = lcsWithShort sansFootnotes caption
    where
      caption = refTitle ref
      sansFootnotes = Short $ walk deNote caption
  
  checkHidden :: [(T.Text, T.Text)] -> WS Bool
  checkHidden attrs = do
    hiddenHdr <- use $ wsReferences . stHiddenHeaderLevel
    pure $ maybe (isHdrHidden hiddenHdr) (not . isFalseValue)
      $ lookup "hidden" attrs
  
  isFalseValue :: T.Text -> Bool
  isFalseValue = (`Set.member` falseValues) . T.strip . T.toLower
  
  falseValues :: Set T.Text
  falseValues = Set.fromList
    [ "no"
    , "n"
    , "false"
    , "f"
    , "off"
    , "0"
    , "none"
    , "null"
    , "disable"
    , "disabled"
    , "unset"
    ]
  