{-# LANGUAGE StrictData #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Citeproc.Eval
  ( evalStyle )
where
import Citeproc.Types
import Citeproc.Style (mergeLocales)
import qualified Citeproc.Unicode as Unicode
import Control.Monad.Trans.RWS.CPS
import Data.Containers.ListUtils (nubOrdOn, nubOrd)
import Safe (headMay, headDef, lastMay, initSafe, tailSafe, maximumMay)
import Data.Maybe
import Control.Monad (foldM, foldM_, zipWithM, when, unless)
import qualified Data.Map as M
import qualified Data.Set as Set
import Data.Coerce (coerce)
import Data.List (find, intersperse, sortBy, sortOn, groupBy, foldl', transpose,
                  sort, (\\))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (isSpace, isDigit, isUpper, isLower, isLetter,
                  ord, chr)
import Text.Printf (printf)
import Control.Applicative
import Data.Generics.Uniplate.Operations (universe, transform)

-- import Debug.Trace (trace)

-- traceShowIdLabeled :: Show a => String -> a -> a
-- traceShowIdLabeled label x =
--   trace (label ++ ": " ++ show x) x

-- import Text.Show.Pretty (ppShow)
-- ppTrace :: Show a => a -> a
-- ppTrace x = trace (ppShow x) x

data Context a =
  Context
  { Context a -> Locale
contextLocale              :: Locale
  , Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             :: [SortKeyValue] -> [SortKeyValue] -> Ordering
  , Context a -> Maybe Abbreviations
contextAbbreviations       :: Maybe Abbreviations
  , Context a -> StyleOptions
contextStyleOptions        :: StyleOptions
  , Context a -> Maybe Text
contextLocator             :: Maybe Text
  , Context a -> Maybe Text
contextLabel               :: Maybe Text
  , Context a -> [Position]
contextPosition            :: [Position]
  , Context a -> Bool
contextInSubstitute        :: Bool
  , Context a -> Bool
contextInSortKey           :: Bool
  , Context a -> Bool
contextInBibliography      :: Bool
  , Context a -> Maybe NamesFormat
contextSubstituteNamesForm :: Maybe NamesFormat
  }

-- used internally for group elements, which
-- are skipped if (a) the group calls a variable
-- but (b) all of the variables called are empty.
data VarCount =
  VarCount
  { VarCount -> Int
variablesAccessed :: Int
  , VarCount -> Int
variablesNonempty :: Int
  } deriving (Int -> VarCount -> ShowS
[VarCount] -> ShowS
VarCount -> String
(Int -> VarCount -> ShowS)
-> (VarCount -> String) -> ([VarCount] -> ShowS) -> Show VarCount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarCount] -> ShowS
$cshowList :: [VarCount] -> ShowS
show :: VarCount -> String
$cshow :: VarCount -> String
showsPrec :: Int -> VarCount -> ShowS
$cshowsPrec :: Int -> VarCount -> ShowS
Show)

data EvalState a =
  EvalState
  { EvalState a -> VarCount
stateVarCount       :: VarCount
  , EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap   :: M.Map ItemId (Int, Maybe Int, Int,
                                          Bool, Maybe Text, Maybe Text)
                        -- (citegroup, noteNum, posInGroup,
                        --      aloneInCitation, label, locator)
  , EvalState a -> Map Int (Set ItemId)
stateNoteMap        :: M.Map Int (Set.Set ItemId) -- ids cited in note
  , EvalState a -> ReferenceMap a
stateRefMap         :: ReferenceMap a
  , EvalState a -> Reference a
stateReference      :: Reference a
  , EvalState a -> Bool
stateUsedYearSuffix :: Bool
  , EvalState a -> Bool
stateUsedIdentifier :: Bool
  -- ^ tracks whether an identifier (DOI,PMCID,PMID,URL) has yet been used
  , EvalState a -> Bool
stateUsedTitle      :: Bool
  -- ^ tracks whether the item title has yet been used
  } deriving (Int -> EvalState a -> ShowS
[EvalState a] -> ShowS
EvalState a -> String
(Int -> EvalState a -> ShowS)
-> (EvalState a -> String)
-> ([EvalState a] -> ShowS)
-> Show (EvalState a)
forall a. Show a => Int -> EvalState a -> ShowS
forall a. Show a => [EvalState a] -> ShowS
forall a. Show a => EvalState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalState a] -> ShowS
$cshowList :: forall a. Show a => [EvalState a] -> ShowS
show :: EvalState a -> String
$cshow :: forall a. Show a => EvalState a -> String
showsPrec :: Int -> EvalState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EvalState a -> ShowS
Show)


type Eval a = RWS (Context a) (Set.Set Text) (EvalState a)

updateVarCount :: Int -> Int -> Eval a ()
updateVarCount :: Int -> Int -> Eval a ()
updateVarCount Int
total' Int
nonempty' =
  (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
    let VarCount Int
total Int
nonempty = EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount EvalState a
st
     in EvalState a
st{ stateVarCount :: VarCount
stateVarCount =
              Int -> Int -> VarCount
VarCount (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
total') (Int
nonempty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nonempty') }

evalStyle  :: CiteprocOutput a
           => Style a          -- ^ Parsed CSL style.
           -> Maybe Lang       -- ^ Override style default locale.
           -> [Reference a]    -- ^ List of references (bibliographic data).
           -> [Citation a]     -- ^ List of citations.
           -> ([Output a], [(Text, Output a)], [Text])
                       -- ^ (citations, (id, bibentry) pairs, warnings)
evalStyle :: Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
evalStyle Style a
style Maybe Lang
mblang [Reference a]
refs' [Citation a]
citations =
  ([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
warnings)
 where
  ([Reference a]
refs, ReferenceMap a
refmap) = [Reference a] -> ([Reference a], ReferenceMap a)
forall a. [Reference a] -> ([Reference a], ReferenceMap a)
makeReferenceMap [Reference a]
refs'

  (([Output a]
citationOs, [(Text, Output a)]
bibliographyOs), Set Text
warnings) = RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
-> Context a
-> EvalState a
-> (([Output a], [(Text, Output a)]), Set Text)
forall w r s a. Monoid w => RWS r w s a -> r -> s -> (a, w)
evalRWS RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
go
     Context :: forall a.
Locale
-> ([SortKeyValue] -> [SortKeyValue] -> Ordering)
-> Maybe Abbreviations
-> StyleOptions
-> Maybe Text
-> Maybe Text
-> [Position]
-> Bool
-> Bool
-> Bool
-> Maybe NamesFormat
-> Context a
Context
      { contextLocale :: Locale
contextLocale              = Maybe Lang -> Style a -> Locale
forall a. Maybe Lang -> Style a -> Locale
mergeLocales Maybe Lang
mblang Style a
style
      , contextCollate :: [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate             = \[SortKeyValue]
xs [SortKeyValue]
ys ->
                                       (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues (Maybe Lang -> Text -> Text -> Ordering
Unicode.comp Maybe Lang
mblang)
                                       [SortKeyValue]
xs [SortKeyValue]
ys
      , contextAbbreviations :: Maybe Abbreviations
contextAbbreviations       = Style a -> Maybe Abbreviations
forall a. Style a -> Maybe Abbreviations
styleAbbreviations Style a
style
      , contextStyleOptions :: StyleOptions
contextStyleOptions        = Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style
      , contextLocator :: Maybe Text
contextLocator             = Maybe Text
forall a. Maybe a
Nothing
      , contextLabel :: Maybe Text
contextLabel               = Maybe Text
forall a. Maybe a
Nothing
      , contextPosition :: [Position]
contextPosition            = []
      , contextInSubstitute :: Bool
contextInSubstitute        = Bool
False
      , contextInSortKey :: Bool
contextInSortKey           = Bool
False
      , contextInBibliography :: Bool
contextInBibliography      = Bool
False
      , contextSubstituteNamesForm :: Maybe NamesFormat
contextSubstituteNamesForm = Maybe NamesFormat
forall a. Maybe a
Nothing
      }
      EvalState :: forall a.
VarCount
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Map Int (Set ItemId)
-> ReferenceMap a
-> Reference a
-> Bool
-> Bool
-> Bool
-> EvalState a
EvalState
      { stateVarCount :: VarCount
stateVarCount = Int -> Int -> VarCount
VarCount Int
0 Int
0
      , stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a. Monoid a => a
mempty
      , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = Map Int (Set ItemId)
forall a. Monoid a => a
mempty
      , stateRefMap :: ReferenceMap a
stateRefMap = ReferenceMap a
refmap
      , stateReference :: Reference a
stateReference = ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty Maybe DisambiguationData
forall a. Maybe a
Nothing Map Variable (Val a)
forall a. Monoid a => a
mempty
      , stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
False
      , stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
False
      , stateUsedTitle :: Bool
stateUsedTitle = Bool
False
      }

  assignCitationNumbers :: [ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedIds =
    (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$ (Map ItemId (Reference a)
 -> (ItemId, Int) -> Map ItemId (Reference a))
-> Map ItemId (Reference a)
-> [(ItemId, Int)]
-> Map ItemId (Reference a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
                     (\Map ItemId (Reference a)
m (ItemId
citeId, Int
num) ->
                         (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref ->
                           Reference a
ref{ referenceVariables :: Map Variable (Val a)
referenceVariables =
                                 Variable -> Val a -> Map Variable (Val a) -> Map Variable (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
"citation-number"
                                    (Int -> Val a
forall a. Int -> Val a
NumVal Int
num) (Map Variable (Val a) -> Map Variable (Val a))
-> (Map Variable (Val a) -> Map Variable (Val a))
-> Map Variable (Val a)
-> Map Variable (Val a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                 (Maybe (Val a) -> Maybe (Val a))
-> Variable -> Map Variable (Val a) -> Map Variable (Val a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (Val a -> Maybe (Val a) -> Maybe (Val a)
forall a. a -> Maybe a -> Maybe a
addIfMissing (Reference a -> Val a
forall a. Reference a -> Val a
citationLabel Reference a
ref))
                                    Variable
"citation-label"
                                 (Map Variable (Val a) -> Map Variable (Val a))
-> Map Variable (Val a) -> Map Variable (Val a)
forall a b. (a -> b) -> a -> b
$ Reference a -> Map Variable (Val a)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref
                              }) ItemId
citeId Map ItemId (Reference a)
m)
                     (ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st))
                     ([ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ItemId]
sortedIds [Int
1..]) }

  addIfMissing :: a -> Maybe a -> Maybe a
addIfMissing a
x Maybe a
Nothing  = a -> Maybe a
forall a. a -> Maybe a
Just a
x
  addIfMissing a
_ (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

  go :: RWS
  (Context a)
  (Set Text)
  (EvalState a)
  ([Output a], [(Text, Output a)])
go = do
      -- list of citationItemIds that are actually cited
      let citationOrder :: Map ItemId Int
citationOrder = [(ItemId, Int)] -> Map ItemId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ItemId, Int)] -> Map ItemId Int)
-> [(ItemId, Int)] -> Map ItemId Int
forall a b. (a -> b) -> a -> b
$ [(ItemId, Int)] -> [(ItemId, Int)]
forall a. [a] -> [a]
reverse ([(ItemId, Int)] -> [(ItemId, Int)])
-> [(ItemId, Int)] -> [(ItemId, Int)]
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [Int] -> [(ItemId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip
            ((Citation a -> [ItemId]) -> [Citation a] -> [ItemId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> ItemId) -> [CitationItem a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId ([CitationItem a] -> [ItemId])
-> (Citation a -> [CitationItem a]) -> Citation a -> [ItemId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems) [Citation a]
citations)
            [(Int
1 :: Int)..]
      let citeIds :: Set ItemId
citeIds = Map ItemId Int -> Set ItemId
forall k a. Map k a -> Set k
M.keysSet Map ItemId Int
citationOrder
      let sortedCiteIds :: [ItemId]
sortedCiteIds = (ItemId -> Int) -> [ItemId] -> [ItemId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn
              (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> (ItemId -> Maybe Int) -> ItemId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId -> Map ItemId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map ItemId Int
citationOrder))
              ((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
      [ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) r w a.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers [ItemId]
sortedCiteIds
      -- sorting of bibliography, insertion of citation-number
      [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- (Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([SortKeyValue] -> [SortKeyValue] -> Ordering)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate

      ([Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap) <-
        case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
          Maybe (Layout a)
Nothing -> ([Citation a], Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([Citation a], Map ItemId [SortKeyValue])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Map ItemId [SortKeyValue]
forall a. Monoid a => a
mempty)
          Just Layout a
biblayout -> do
            Map ItemId [SortKeyValue]
bibSortKeyMap <- [(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                      ([(ItemId, [SortKeyValue])] -> Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     [(ItemId, [SortKeyValue])]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Reference a
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (ItemId, [SortKeyValue]))
-> [Reference a]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     [(ItemId, [SortKeyValue])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                          ((\ItemId
citeId ->
                             (ItemId
citeId,) ([SortKeyValue] -> (ItemId, [SortKeyValue]))
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (ItemId, [SortKeyValue])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Layout a
-> ItemId
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
biblayout ItemId
citeId)
                             (ItemId
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (ItemId, [SortKeyValue]))
-> (Reference a -> ItemId)
-> Reference a
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (ItemId, [SortKeyValue])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId)
                          [Reference a]
refs
            let sortedIds :: [ItemId]
sortedIds =
                  if [SortKey a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout)
                     then [ItemId]
sortedCiteIds
                     else (ItemId -> ItemId -> Ordering) -> [ItemId] -> [ItemId]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                       (\ItemId
x ItemId
y -> [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                  ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
x Map ItemId [SortKeyValue]
bibSortKeyMap)
                                  ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ItemId
y Map ItemId [SortKeyValue]
bibSortKeyMap))
                            ((Reference a -> ItemId) -> [Reference a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId [Reference a]
refs)
            [ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) r w a.
Monad m =>
[ItemId] -> RWST r w (EvalState a) m ()
assignCitationNumbers ([ItemId] -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [ItemId]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$
              case Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
biblayout of
                (SortKeyVariable SortDirection
Descending Variable
"citation-number":[SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (ENumber Variable
"citation-number" NumberForm
_) Formatting
_:[Element a]
_) : [SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                (SortKeyMacro SortDirection
Descending
                  (Element (EText (TextVariable VariableForm
_ Variable
"citation-number")) Formatting
_:[Element a]
_): [SortKey a]
_)
                  -> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
                [SortKey a]
_ -> [ItemId]
sortedIds
            let bibCitations :: [Citation a]
bibCitations = (ItemId -> Citation a) -> [ItemId] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map (\ItemId
ident ->
                  Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId ItemId
ident) Maybe Int
forall a. Maybe a
Nothing
                   [ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> CitationItem a
forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> CitationItem a
CitationItem ItemId
ident Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
                      CitationItemType
NormalCite Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing]) [ItemId]
sortedIds
            ([Citation a], Map ItemId [SortKeyValue])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([Citation a], Map ItemId [SortKeyValue])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Citation a]
forall a. [Citation a]
bibCitations, Map ItemId [SortKeyValue]
bibSortKeyMap)
      -- styling of citations
      Map ItemId [SortKeyValue]
sortKeyMap <-
        (Map ItemId [SortKeyValue]
 -> ItemId
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (Map ItemId [SortKeyValue]))
-> Map ItemId [SortKeyValue]
-> Set ItemId
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Map ItemId [SortKeyValue]
m ItemId
citeId -> do
                  [SortKeyValue]
sk <- Layout a
-> ItemId
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [SortKeyValue]
forall a.
CiteprocOutput a =>
Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style) ItemId
citeId
                  Map ItemId [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ItemId [SortKeyValue]
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (Map ItemId [SortKeyValue]))
-> Map ItemId [SortKeyValue]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId [SortKeyValue])
forall a b. (a -> b) -> a -> b
$ ItemId
-> [SortKeyValue]
-> Map ItemId [SortKeyValue]
-> Map ItemId [SortKeyValue]
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ItemId
citeId [SortKeyValue]
sk Map ItemId [SortKeyValue]
m)
               Map ItemId [SortKeyValue]
forall k a. Map k a
M.empty
               Set ItemId
citeIds
      -- We can't just sort all the citations, because
      -- this can make a hash out of prefixes and suffixes.
      -- See e.g. pandoc-citeproc issue #292.
      -- we need to first break into groups so that any
      -- suffix ends a group and any prefix begins a group;
      -- then sort the groups; then combine again:
      let canGroup :: CitationItem a -> CitationItem a -> Bool
canGroup CitationItem a
i1 CitationItem a
i2
           =   Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
i1) Bool -> Bool -> Bool
&&
               Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
i2)
      let sortCitationItems :: Citation a -> Citation a
sortCitationItems Citation a
citation' =
            Citation a
citation'{ citationItems :: [CitationItem a]
citationItems =
                          ([CitationItem a] -> [CitationItem a])
-> [[CitationItem a]] -> [CitationItem a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                           ((CitationItem a -> CitationItem a -> Ordering)
-> [CitationItem a] -> [CitationItem a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
                             (\CitationItem a
item1 CitationItem a
item2 ->
                               [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
                                ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item1) Map ItemId [SortKeyValue]
sortKeyMap)
                                ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup
                                   (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item2) Map ItemId [SortKeyValue]
sortKeyMap)))
                        ([[CitationItem a]] -> [CitationItem a])
-> [[CitationItem a]] -> [CitationItem a]
forall a b. (a -> b) -> a -> b
$ (CitationItem a -> CitationItem a -> Bool)
-> [CitationItem a] -> [[CitationItem a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy CitationItem a -> CitationItem a -> Bool
forall a a. CitationItem a -> CitationItem a -> Bool
canGroup
                        ([CitationItem a] -> [[CitationItem a]])
-> [CitationItem a] -> [[CitationItem a]]
forall a b. (a -> b) -> a -> b
$ Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation' }
      let citCitations :: [Citation a]
citCitations = (Citation a -> Citation a) -> [Citation a] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map Citation a -> Citation a
forall a. Citation a -> Citation a
sortCitationItems [Citation a]
citations
      let layoutOpts :: LayoutOptions
layoutOpts = Layout a -> LayoutOptions
forall a. Layout a -> LayoutOptions
layoutOptions (Layout a -> LayoutOptions) -> Layout a -> LayoutOptions
forall a b. (a -> b) -> a -> b
$ Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style
      [Output a]
cs <- Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citCitations
      let mbcgDelim :: Maybe Text
mbcgDelim =
            case StyleOptions -> Maybe Text
styleCiteGroupDelimiter (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
              Just Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
              Maybe Text
Nothing
                -- grouping is activated whenever there is
                -- collapsing; this is the default
                -- cite-group-delimiter
                | Maybe Collapsing -> Bool
forall a. Maybe a -> Bool
isJust (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
", "
                | Bool
otherwise -> Maybe Text
forall a. Maybe a
Nothing
      let cs' :: [Output a]
cs' = case Maybe Text
mbcgDelim of
                   Maybe Text
Nothing -> [Output a]
cs
                   Just Text
citeGroupDelim -> (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map
                      (Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
forall a.
CiteprocOutput a =>
Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
groupAndCollapseCitations Text
citeGroupDelim
                       (LayoutOptions -> Maybe Text
layoutYearSuffixDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Text
layoutAfterCollapseDelimiter LayoutOptions
layoutOpts)
                       (LayoutOptions -> Maybe Collapsing
layoutCollapse LayoutOptions
layoutOpts))
                      [Output a]
cs

      let removeIfEqual :: Output a -> Output a -> Output a
removeIfEqual Output a
x Output a
y
           | Output a
x Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
y    = Output a
forall a. Output a
NullOutput
           | Bool
otherwise = Output a
y
      let removeNamesIfSuppressAuthor :: Output a -> Output a
removeNamesIfSuppressAuthor
           (Tagged (TagItem CitationItemType
SuppressAuthor ItemId
cid') Output a
x)
             = let y :: Output a
y = Output a -> Output a
forall a. Output a -> Output a
getAuthors Output a
x
                in Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
SuppressAuthor ItemId
cid')
                     ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Output a -> Output a -> Output a
forall a. Eq a => Output a -> Output a -> Output a
removeIfEqual Output a
y) Output a
x)
          removeNamesIfSuppressAuthor Output a
x = Output a
x

      -- we need to do this after disambiguation and collapsing
      let handleSuppressAuthors :: Output a -> Output a
handleSuppressAuthors = (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall a. Eq a => Output a -> Output a
removeNamesIfSuppressAuthor

      let isNoteCitation :: Bool
isNoteCitation = StyleOptions -> Bool
styleIsNoteStyle (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style)

      -- if we have an author-only citation at the beginning
      -- separate it out:
      let handleAuthorOnly :: Output a -> Output a
handleAuthorOnly Output a
formattedCit =
            case Output a
formattedCit of
              Formatted Formatting
f
                (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs)
                  | Bool
isNoteCitation
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs) | Bool -> Bool
not ([Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs)])
                  | Bool
otherwise
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs
                            then []
                            else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs])
              Formatted Formatting
f
                (Formatted Formatting
f'
                  (x :: Output a
x@(Tagged (TagItem CitationItemType
AuthorOnly ItemId
_) Output a
_):[Output a]
xs) : [Output a]
ys)
                  | Bool
isNoteCitation
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
                        (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f'{ formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing
                                     , formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing } [Output a
x] Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [Output a -> Output a
forall a. Output a -> Output a
InNote (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f
                                           (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys))])
                  | Bool
otherwise
                    -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty
                        (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f'{ formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing
                                     , formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing } [Output a
x] Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                         if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
xs Bool -> Bool -> Bool
&& [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
ys
                            then []
                            else [a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "),
                                  Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f' [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys)])
              Output a
_ | Bool
isNoteCitation -> Output a -> Output a
forall a. Output a -> Output a
InNote Output a
formattedCit
                | Bool
otherwise      -> Output a
formattedCit

      let cs'' :: [Output a]
cs'' = (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map (Output a -> Output a
handleSuppressAuthors (Output a -> Output a)
-> (Output a -> Output a) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a
handleAuthorOnly) [Output a]
cs'

      -- styling of bibliography (this needs to go here to take account
      -- of year suffixes added in disambiguation)
      [Output a]
bs <- case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
               Just Layout a
biblayout
                 -> (Context a -> Context a) -> Eval a [Output a] -> Eval a [Output a]
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
local (\Context a
context ->
                             Context a
context{ contextInBibliography :: Bool
contextInBibliography = Bool
True }) (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
                    ((Int, Citation a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [(Int, Citation a)] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Layout a
-> (Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
biblayout) ([Int] -> [Citation a] -> [(Int, Citation a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
bibCitations)
                    Eval a [Output a]
-> ([Output a] -> Eval a [Output a]) -> Eval a [Output a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Output a]
bs ->
                      case StyleOptions -> Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute
                            (Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
                        Maybe SubsequentAuthorSubstitute
Nothing -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
bs
                        Just SubsequentAuthorSubstitute
subs -> SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes SubsequentAuthorSubstitute
subs [Output a]
bs
               Maybe (Layout a)
Nothing -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      ([Output a], [(Text, Output a)])
-> RWS
     (Context a)
     (Set Text)
     (EvalState a)
     ([Output a], [(Text, Output a)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a]
cs'', case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
                     Maybe (Layout a)
Nothing -> []
                     Just Layout a
_  ->
                       [Text] -> [Output a] -> [(Text, Output a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Citation a -> Text) -> [Citation a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> (Citation a -> Maybe Text) -> Citation a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> Maybe Text
forall a. Citation a -> Maybe Text
citationId) [Citation a]
bibCitations) [Output a]
bs)

subsequentAuthorSubstitutes :: CiteprocOutput a
                            => SubsequentAuthorSubstitute
                            -> [Output a]
                            -> Eval a [Output a]
subsequentAuthorSubstitutes :: SubsequentAuthorSubstitute -> [Output a] -> Eval a [Output a]
subsequentAuthorSubstitutes (SubsequentAuthorSubstitute Text
t SubsequentAuthorSubstituteRule
rule) =
  [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a] -> Eval a [Output a])
-> ([Output a] -> [Output a]) -> [Output a] -> Eval a [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> [Output a]
forall a. CiteprocOutput a => [Output a] -> [Output a]
groupCitesByNames
 where
  groupCitesByNames :: [Output a] -> [Output a]
groupCitesByNames [] = []
  groupCitesByNames (Output a
x:[Output a]
xs) =
    let xnames :: ([Name], Output a)
xnames = ([Name], Output a)
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a. a -> Maybe a -> a
fromMaybe ([],Output a
forall a. Output a
NullOutput) (Maybe ([Name], Output a) -> ([Name], Output a))
-> Maybe ([Name], Output a) -> ([Name], Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe ([Name], Output a)
forall a. Output a -> Maybe ([Name], Output a)
getNames Output a
x
        samenames :: [Output a]
samenames = SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t) ([Name], Output a)
xnames [Output a]
xs
        rest :: [Output a]
rest = Int -> [Output a] -> [Output a]
forall a. Int -> [a] -> [a]
drop ([Output a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
samenames) [Output a]
xs
    in  (Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
samenames) [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a] -> [Output a]
groupCitesByNames [Output a]
rest
  getNames :: Output a -> Maybe ([Name], Output a)
getNames (Formatted Formatting
_ (Output a
x:[Output a]
_)) =
    case [([Name]
ns,Output a
r) | (Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x] of
      (([Name]
ns,Output a
r) : [([Name], Output a)]
_) -> ([Name], Output a) -> Maybe ([Name], Output a)
forall a. a -> Maybe a
Just ([Name]
ns,Output a
r)
      []           -> Maybe ([Name], Output a)
forall a. Maybe a
Nothing
  getNames Output a
_ = Maybe ([Name], Output a)
forall a. Maybe a
Nothing

replaceMatch :: CiteprocOutput a
             => SubsequentAuthorSubstituteRule
             -> a
             -> ([Name], Output a)
             -> [Output a]
             -> [Output a]
replaceMatch :: SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
_ a
_ ([Name], Output a)
_ [] = []
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) (Output a
z:[Output a]
zs) =
  case Output a -> Maybe (Output a)
go Output a
z of
    Maybe (Output a)
Nothing -> []
    Just Output a
z' -> Output a
z' Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
forall a.
CiteprocOutput a =>
SubsequentAuthorSubstituteRule
-> a -> ([Name], Output a) -> [Output a] -> [Output a]
replaceMatch SubsequentAuthorSubstituteRule
rule a
replacement ([Name]
names, Output a
raw) [Output a]
zs
 where
  go :: Output a -> Maybe (Output a)
go (Tagged t :: Tag
t@TagItem{} Output a
y) =
    Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
t (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go (Formatted Formatting
f (Output a
y:[Output a]
ys)) =
    Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
ys) (Output a -> Output a) -> Maybe (Output a) -> Maybe (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Output a -> Maybe (Output a)
go Output a
y
  go y :: Output a
y@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
r) =
    case (if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names then SubsequentAuthorSubstituteRule
CompleteAll else SubsequentAuthorSubstituteRule
rule) of
        SubsequentAuthorSubstituteRule
CompleteAll ->
          if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names Bool -> Bool -> Bool
&& (Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) Bool -> Bool -> Bool
|| Output a
r Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
raw)
             then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Output a -> Output a
replaceAll Output a
y
             else Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
CompleteEach ->
          if [Name]
ns [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
names
             then Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
replaceEach Output a
y
             else Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialEach ->
          case [Name] -> [Name] -> Int
forall a p. (Eq a, Num p) => [a] -> [a] -> p
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
num) Output a
y
            Int
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
        SubsequentAuthorSubstituteRule
PartialFirst ->
          case [Name] -> [Name] -> Int
forall a p. (Eq a, Num p) => [a] -> [a] -> p
numberOfMatches [Name]
ns [Name]
names of
            Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
1 :: Int) -> Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Int -> Output a -> Output a
replaceFirst Int
1) Output a
y
            Int
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
  go Output a
_ = Maybe (Output a)
forall a. Maybe a
Nothing
  replaceAll :: Output a -> Output a
replaceAll (Tagged (TagNames Variable
t' NamesFormat
nf [Name]
ns') Output a
x)
     = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
t' NamesFormat
nf [Name]
ns') (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
       -- removeName will leave label "ed."
       -- which we want, but it will also leave the substituted
       -- title when there is no name, which we do not want.
       -- So, if ns' is null, then we just remove everything.
       if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns'
          then a -> Output a
forall a. a -> Output a
Literal a
replacement
          else
            case (Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall a. Output a -> Output a
removeName Output a
x of
              Formatted Formatting
f' [Output a]
xs -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f' (a -> Output a
forall a. a -> Output a
Literal a
replacement Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
xs)
              Output a
_               -> a -> Output a
forall a. a -> Output a
Literal a
replacement
  replaceAll Output a
x = Output a
x
  removeName :: Output a -> Output a
removeName (Tagged (TagName Name
_) Output a
_) = Output a
forall a. Output a
NullOutput
  removeName Output a
x = Output a
x
  replaceEach :: Output a -> Output a
replaceEach (Tagged (TagName Name
n) Output a
_)
    | Name
n Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
names
     = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (a -> Output a
forall a. a -> Output a
Literal a
replacement)
  replaceEach Output a
x = Output a
x
  replaceFirst :: Int -> Output a -> Output a
replaceFirst Int
num x :: Output a
x@(Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns') Output a
_)
    -- a kludge to get this to type-check!
    | Bool
True = (Name -> Output a -> Output a) -> Output a -> [Name] -> Output a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform ((Output a -> Output a) -> Output a -> Output a)
-> (Name -> Output a -> Output a) -> Name -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Output a -> Output a
replaceName) Output a
x ([Name] -> Output a) -> [Name] -> Output a
forall a b. (a -> b) -> a -> b
$ Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
num [Name]
ns'
    | Bool
False = a -> Output a
forall a. a -> Output a
Literal a
replacement
  replaceFirst Int
_num Output a
x = Output a
x
  replaceName :: Name -> Output a -> Output a
replaceName Name
name (Tagged (TagName Name
n) Output a
_)
    | Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
n) (a -> Output a
forall a. a -> Output a
Literal a
replacement)
  replaceName Name
_ Output a
x = Output a
x
  numberOfMatches :: [a] -> [a] -> p
numberOfMatches (a
a:[a]
as) (a
b:[a]
bs)
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b    = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ [a] -> [a] -> p
numberOfMatches [a]
as [a]
bs
    | Bool
otherwise = p
0
  numberOfMatches [a]
_ [a]
_ = p
0

--
-- Disambiguation
--

data DisambData =
  DisambData
  { DisambData -> ItemId
ddItem       :: ItemId
  , DisambData -> [Name]
ddNames      :: [Name]
  , DisambData -> [Date]
ddDates      :: [Date]
  , DisambData -> Text
ddRendered   :: Text
  } deriving (DisambData -> DisambData -> Bool
(DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool) -> Eq DisambData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisambData -> DisambData -> Bool
$c/= :: DisambData -> DisambData -> Bool
== :: DisambData -> DisambData -> Bool
$c== :: DisambData -> DisambData -> Bool
Eq, Eq DisambData
Eq DisambData
-> (DisambData -> DisambData -> Ordering)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> Bool)
-> (DisambData -> DisambData -> DisambData)
-> (DisambData -> DisambData -> DisambData)
-> Ord DisambData
DisambData -> DisambData -> Bool
DisambData -> DisambData -> Ordering
DisambData -> DisambData -> DisambData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DisambData -> DisambData -> DisambData
$cmin :: DisambData -> DisambData -> DisambData
max :: DisambData -> DisambData -> DisambData
$cmax :: DisambData -> DisambData -> DisambData
>= :: DisambData -> DisambData -> Bool
$c>= :: DisambData -> DisambData -> Bool
> :: DisambData -> DisambData -> Bool
$c> :: DisambData -> DisambData -> Bool
<= :: DisambData -> DisambData -> Bool
$c<= :: DisambData -> DisambData -> Bool
< :: DisambData -> DisambData -> Bool
$c< :: DisambData -> DisambData -> Bool
compare :: DisambData -> DisambData -> Ordering
$ccompare :: DisambData -> DisambData -> Ordering
$cp1Ord :: Eq DisambData
Ord, Int -> DisambData -> ShowS
[DisambData] -> ShowS
DisambData -> String
(Int -> DisambData -> ShowS)
-> (DisambData -> String)
-> ([DisambData] -> ShowS)
-> Show DisambData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisambData] -> ShowS
$cshowList :: [DisambData] -> ShowS
show :: DisambData -> String
$cshow :: DisambData -> String
showsPrec :: Int -> DisambData -> ShowS
$cshowsPrec :: Int -> DisambData -> ShowS
Show)

disambiguateCitations :: forall a . CiteprocOutput a
                      => Style a
                      -> M.Map ItemId [SortKeyValue]
                      -> [Citation a]
                      -> Eval a [Output a]
disambiguateCitations :: Style a
-> Map ItemId [SortKeyValue] -> [Citation a] -> Eval a [Output a]
disambiguateCitations Style a
style Map ItemId [SortKeyValue]
bibSortKeyMap [Citation a]
citations = do
  Map ItemId (Reference a)
refs <- ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (ReferenceMap a -> Map ItemId (Reference a))
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId (Reference a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState a -> ReferenceMap a)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap
  let refIds :: [ItemId]
refIds = Map ItemId (Reference a) -> [ItemId]
forall k a. Map k a -> [k]
M.keys Map ItemId (Reference a)
refs
  let citeIds :: [ItemId]
citeIds = (Citation a -> [ItemId]) -> [Citation a] -> [ItemId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((CitationItem a -> ItemId) -> [CitationItem a] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId ([CitationItem a] -> [ItemId])
-> (Citation a -> [CitationItem a]) -> Citation a -> [ItemId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems) [Citation a]
citations
  let citeIdsSet :: Set ItemId
citeIdsSet = [ItemId] -> Set ItemId
forall a. Ord a => [a] -> Set a
Set.fromList [ItemId]
citeIds
  let ghostItems :: [ItemId]
ghostItems = [ ItemId
ident
                   | ItemId
ident <- [ItemId]
refIds
                   , Bool -> Bool
not (ItemId
ident ItemId -> Set ItemId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ItemId
citeIdsSet)]
  -- note that citations must go first, and order must be preserved:
  -- we use a "basic item" that strips off prefixes, suffixes, locators
  let allItems :: [CitationItem a]
allItems = (ItemId -> CitationItem a) -> [ItemId] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> CitationItem a
forall a. ItemId -> CitationItem a
basicItem ([ItemId] -> [CitationItem a]) -> [ItemId] -> [CitationItem a]
forall a b. (a -> b) -> a -> b
$ [ItemId]
citeIds [ItemId] -> [ItemId] -> [ItemId]
forall a. [a] -> [a] -> [a]
++ [ItemId]
ghostItems
  [Output a]
allCites <- [CitationItem a] -> Eval a [Output a]
renderItems [CitationItem a]
forall a. [CitationItem a]
allItems

  Maybe Lang
mblang <- (Context a -> Maybe Lang)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Lang)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage (Locale -> Maybe Lang)
-> (Context a -> Locale) -> Context a -> Maybe Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
  StyleOptions
styleOpts <- (Context a -> StyleOptions)
-> RWST (Context a) (Set Text) (EvalState a) Identity StyleOptions
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions
  let strategy :: DisambiguationStrategy
strategy = StyleOptions -> DisambiguationStrategy
styleDisambiguation StyleOptions
styleOpts
  let allNameGroups :: [[Name]]
allNameGroups = [[Name]
ns | Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
_ <-
                              (Output a -> [Output a]) -> [Output a] -> [Output a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe [Output a]
allCites]
  let allNames :: [Name]
allNames = [Name] -> [Name]
forall a. Ord a => [a] -> [a]
nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
allNameGroups
  let primaryNames :: [Name]
primaryNames = [Name] -> [Name]
forall a. Ord a => [a] -> [a]
nubOrd ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ([Name] -> [Name]) -> [[Name]] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
1) [[Name]]
allNameGroups
  [Output a]
allCites' <-
    case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
         Maybe GivenNameDisambiguationRule
Nothing     -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites
         Just GivenNameDisambiguationRule
ByCite -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites -- do this later
         Just GivenNameDisambiguationRule
rule   -> do -- disambiguate names, not just citations
           let relevantNames :: [Name]
relevantNames =
                 case GivenNameDisambiguationRule
rule of
                   GivenNameDisambiguationRule
PrimaryNameWithInitials -> [Name]
primaryNames
                   GivenNameDisambiguationRule
PrimaryName -> [Name]
primaryNames
                   GivenNameDisambiguationRule
_ -> [Name]
allNames
           let familyNames :: [Text]
familyNames = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe Text) -> [Name] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe Text
nameFamily [Name]
relevantNames
           let grps :: [[Name]]
grps = (Text -> [Name]) -> [Text] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
name ->
                             [Name
v | Name
v <- [Name]
relevantNames
                                , Name -> Maybe Text
nameFamily Name
v Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name])
                          [Text]
familyNames
           let toHint :: [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name =
                  if (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) ((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name) [Name]
names)
                     then
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
AllNamesWithInitials    -> Maybe NameHints
forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> Maybe NameHints
forall a. Maybe a
Nothing
                         GivenNameDisambiguationRule
PrimaryName             -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenNameIfPrimary
                         GivenNameDisambiguationRule
_                       -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenName
                     else
                       case GivenNameDisambiguationRule
rule of
                         GivenNameDisambiguationRule
PrimaryNameWithInitials -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
PrimaryName             -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
                         GivenNameDisambiguationRule
_                       -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitials
           let namesMap :: Map Name NameHints
namesMap = [Map Name NameHints] -> Map Name NameHints
forall a. Monoid a => [a] -> a
mconcat ([Map Name NameHints] -> Map Name NameHints)
-> [Map Name NameHints] -> Map Name NameHints
forall a b. (a -> b) -> a -> b
$ ([Name] -> Map Name NameHints) -> [[Name]] -> [Map Name NameHints]
forall a b. (a -> b) -> [a] -> [b]
map
                  (\[Name]
names -> if [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                 then (Name -> Map Name NameHints -> Map Name NameHints)
-> Map Name NameHints -> [Name] -> Map Name NameHints
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                                    (\Name
name ->
                                        case [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name of
                                          Just NameHints
x -> Name -> NameHints -> Map Name NameHints -> Map Name NameHints
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name NameHints
x
                                          Maybe NameHints
Nothing -> Map Name NameHints -> Map Name NameHints
forall a. a -> a
id)
                                    Map Name NameHints
forall a. Monoid a => a
mempty
                                    [Name]
names
                                 else Map Name NameHints
forall a. Monoid a => a
mempty) [[Name]]
grps
           -- use this same names map for every citation
           (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
              EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$
                   (ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a))
-> Map ItemId (Reference a) -> [ItemId] -> Map ItemId (Reference a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                     ((Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
                       (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap :: Map Name NameHints
disambNameMap = Map Name NameHints
namesMap })))
                     (ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (ReferenceMap a -> Map ItemId (Reference a))
-> ReferenceMap a -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st)
                     [ItemId]
refIds }
           -- redo citations
           [CitationItem a] -> Eval a [Output a]
renderItems [CitationItem a]
forall a. [CitationItem a]
allItems

  case [Output a] -> [[DisambData]]
forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities [Output a]
allCites' of
    []          -> () -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [[DisambData]]
ambiguities -> Maybe Lang
-> DisambiguationStrategy
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [[DisambData]]
ambiguities
  (Context a -> EvalState a -> (Context a, EvalState a))
-> Eval a [Output a] -> Eval a [Output a]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx,
                        EvalState a
st { stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a. Monoid a => a
mempty
                           , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = Map Int (Set ItemId)
forall a. Monoid a => a
mempty })) (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
     ((Int, Citation a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [(Int, Citation a)] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Layout a
-> (Int, Citation a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style)) ([Int] -> [Citation a] -> [(Int, Citation a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Citation a]
citations)

 where

  renderItems :: [CitationItem a] -> Eval a [Output a]
  renderItems :: [CitationItem a] -> Eval a [Output a]
renderItems = (Context a -> EvalState a -> (Context a, EvalState a))
-> Eval a [Output a] -> Eval a [Output a]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx,
                                      EvalState a
st { stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap = Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a. Monoid a => a
mempty
                                         , stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = Map Int (Set ItemId)
forall a. Monoid a => a
mempty })) (Eval a [Output a] -> Eval a [Output a])
-> ([CitationItem a] -> Eval a [Output a])
-> [CitationItem a]
-> Eval a [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (CitationItem a
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [CitationItem a] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\CitationItem a
item ->
                          Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
NormalCite (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)) (Output a -> Output a)
-> ([Output a] -> Output a) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> Output a
forall a. [Output a] -> Output a
grouped ([Output a] -> Output a)
-> Eval a [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
forall a.
CiteprocOutput a =>
Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem (Style a -> Layout a
forall a. Style a -> Layout a
styleCitation Style a
style) ([], CitationItem a
item))

  refreshAmbiguities :: [[DisambData]] -> Eval a [[DisambData]]
  refreshAmbiguities :: [[DisambData]] -> Eval a [[DisambData]]
refreshAmbiguities = ([[Output a]] -> [[DisambData]])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
-> Eval a [[DisambData]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Output a] -> [[DisambData]]) -> [[Output a]] -> [[DisambData]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Output a] -> [[DisambData]]
forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities) (RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
 -> Eval a [[DisambData]])
-> ([[DisambData]]
    -> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]])
-> [[DisambData]]
-> Eval a [[DisambData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            ([DisambData] -> Eval a [Output a])
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([CitationItem a] -> Eval a [Output a]
renderItems ([CitationItem a] -> Eval a [Output a])
-> ([DisambData] -> [CitationItem a])
-> [DisambData]
-> Eval a [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisambData -> CitationItem a) -> [DisambData] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId -> CitationItem a
forall a. ItemId -> CitationItem a
basicItem (ItemId -> CitationItem a)
-> (DisambData -> ItemId) -> DisambData -> CitationItem a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> ItemId
ddItem))

  analyzeAmbiguities :: Maybe Lang
                     -> DisambiguationStrategy
                     -> [[DisambData]]
                     -> Eval a ()
  analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [[DisambData]]
ambiguities = do
    -- add names to et al.
    [[DisambData]] -> Eval a [[DisambData]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
ambiguities
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not ([[DisambData]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddNames DisambiguationStrategy
strategy
               then do
                 ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a.
Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang (DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy)) [[DisambData]]
as
                 [[DisambData]] -> Eval a [[DisambData]]
refreshAmbiguities [[DisambData]]
as
               else
                 [[DisambData]] -> Eval a [[DisambData]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
                  Just GivenNameDisambiguationRule
ByCite | Bool -> Bool
not ([[DisambData]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) -> do
                     ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe Lang
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang) [[DisambData]]
as
                     [[DisambData]] -> Eval a [[DisambData]]
refreshAmbiguities [[DisambData]]
as
                  Maybe GivenNameDisambiguationRule
_           -> [[DisambData]] -> Eval a [[DisambData]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]] -> Eval a [[DisambData]])
-> Eval a [[DisambData]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[[DisambData]]
as ->
           (if Bool -> Bool
not ([[DisambData]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[DisambData]]
as) Bool -> Bool -> Bool
&& DisambiguationStrategy -> Bool
disambiguateAddYearSuffix DisambiguationStrategy
strategy
               then do
                 Map ItemId [SortKeyValue]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap [[DisambData]]
as
                 [[DisambData]] -> Eval a [[DisambData]]
refreshAmbiguities [[DisambData]]
as
               else [[DisambData]] -> Eval a [[DisambData]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[DisambData]]
as))
      Eval a [[DisambData]]
-> ([[DisambData]]
    -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. [DisambData] -> Eval a ()
tryDisambiguateCondition

basicItem :: ItemId -> CitationItem a
basicItem :: ItemId -> CitationItem a
basicItem ItemId
iid = CitationItem :: forall a.
ItemId
-> Maybe Text
-> Maybe Text
-> CitationItemType
-> Maybe a
-> Maybe a
-> CitationItem a
CitationItem
  { citationItemId :: ItemId
citationItemId      = ItemId
iid
  , citationItemLabel :: Maybe Text
citationItemLabel   = Maybe Text
forall a. Maybe a
Nothing
  , citationItemLocator :: Maybe Text
citationItemLocator = Maybe Text
forall a. Maybe a
Nothing
  , citationItemType :: CitationItemType
citationItemType    = CitationItemType
NormalCite
  , citationItemPrefix :: Maybe a
citationItemPrefix  = Maybe a
forall a. Maybe a
Nothing
  , citationItemSuffix :: Maybe a
citationItemSuffix  = Maybe a
forall a. Maybe a
Nothing
  }

isDisambiguated :: Maybe Lang
                -> Maybe GivenNameDisambiguationRule
                -> Int -- et al min
                -> [DisambData]
                -> DisambData
                -> Bool
isDisambiguated :: Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
etAlMin [DisambData]
xs DisambData
x =
  (DisambData -> Bool) -> [DisambData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\DisambData
y -> DisambData
x DisambData -> DisambData -> Bool
forall a. Eq a => a -> a -> Bool
== DisambData
y Bool -> Bool -> Bool
|| DisambData -> [Name]
disambiguatedName DisambData
y [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
/= DisambData -> [Name]
disambiguatedName DisambData
x) [DisambData]
xs
 where
  disambiguatedName :: DisambData -> [Name]
disambiguatedName = [Name] -> [Name]
nameParts ([Name] -> [Name])
-> (DisambData -> [Name]) -> DisambData -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
etAlMin ([Name] -> [Name])
-> (DisambData -> [Name]) -> DisambData -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames
  nameParts :: [Name] -> [Name]
nameParts =
    case Maybe GivenNameDisambiguationRule
mbrule of
      Just GivenNameDisambiguationRule
AllNames -> [Name] -> [Name]
forall a. a -> a
id
      Just GivenNameDisambiguationRule
AllNamesWithInitials ->
           (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
""
                                            (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
name })
      Just GivenNameDisambiguationRule
PrimaryName ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
PrimaryNameWithInitials ->
        \case
          [] -> []
          (Name
z:[Name]
zs) -> Name
z{ nameGiven :: Maybe Text
nameGiven =
                     Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
z } Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:
                     (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing }) [Name]
zs
      Just GivenNameDisambiguationRule
ByCite -> [Name] -> [Name]
forall a. a -> a
id -- hints will be added later
      Maybe GivenNameDisambiguationRule
_ -> (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> Name
name{ nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing })

tryAddNames :: Maybe Lang
            -> Maybe GivenNameDisambiguationRule
            -> [DisambData]
            -> Eval a ()
tryAddNames :: Maybe Lang
-> Maybe GivenNameDisambiguationRule -> [DisambData] -> Eval a ()
tryAddNames Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule [DisambData]
bs =
                     (case Maybe GivenNameDisambiguationRule
mbrule of
                          Just GivenNameDisambiguationRule
ByCite -> [DisambData]
bs [DisambData]
-> Eval a ()
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Lang -> [DisambData] -> Eval a ()
forall a. Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
bs
                          Maybe GivenNameDisambiguationRule
_ -> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall (m :: * -> *) a. Monad m => a -> m a
return [DisambData]
bs) RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
-> ([DisambData] -> Eval a ()) -> Eval a ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [DisambData] -> Eval a ()
forall (m :: * -> *) r w a.
Monad m =>
Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
1
                        -- if ByCite, we want to make sure that
                        -- tryAddGivenNames is still applied, as
                        -- calculation of "add names" assumes this.
 where
   maxnames :: [DisambData] -> Int
maxnames = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ([DisambData] -> Maybe Int) -> [DisambData] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall a. Ord a => [a] -> Maybe a
maximumMay ([Int] -> Maybe Int)
-> ([DisambData] -> [Int]) -> [DisambData] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisambData -> Int) -> [DisambData] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Name] -> Int) -> (DisambData -> [Name]) -> DisambData -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> [Name]
ddNames)
   go :: Int -> [DisambData] -> RWST r w (EvalState a) m ()
go Int
n [DisambData]
as
     | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [DisambData] -> Int
maxnames [DisambData]
as = () -> RWST r w (EvalState a) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     | Bool
otherwise = do
         let ds :: [DisambData]
ds = (DisambData -> Bool) -> [DisambData] -> [DisambData]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Lang
-> Maybe GivenNameDisambiguationRule
-> Int
-> [DisambData]
-> DisambData
-> Bool
isDisambiguated Maybe Lang
mblang Maybe GivenNameDisambiguationRule
mbrule Int
n [DisambData]
as) [DisambData]
as
         if [DisambData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DisambData]
ds
            then Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [DisambData]
as
            else do
              (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
                EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
                      (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$ (DisambData
 -> Map ItemId (Reference a) -> Map ItemId (Reference a))
-> Map ItemId (Reference a)
-> [DisambData]
-> Map ItemId (Reference a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall a.
Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setEtAlNames (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) (ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a))
-> (DisambData -> ItemId)
-> DisambData
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> ItemId
ddItem)
                        (ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (ReferenceMap a -> Map ItemId (Reference a))
-> ReferenceMap a -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) [DisambData]
as }
              Int -> [DisambData] -> RWST r w (EvalState a) m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([DisambData]
as [DisambData] -> [DisambData] -> [DisambData]
forall a. Eq a => [a] -> [a] -> [a]
\\ [DisambData]
ds)

tryAddGivenNames :: Maybe Lang
                 -> [DisambData]
                 -> Eval a ()
tryAddGivenNames :: Maybe Lang -> [DisambData] -> Eval a ()
tryAddGivenNames Maybe Lang
mblang [DisambData]
as = do
  let correspondingNames :: [[(ItemId, Name)]]
correspondingNames =
         ([Name] -> [(ItemId, Name)]) -> [[Name]] -> [[(ItemId, Name)]]
forall a b. (a -> b) -> [a] -> [b]
map ([ItemId] -> [Name] -> [(ItemId, Name)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((DisambData -> ItemId) -> [DisambData] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
as)) ([[Name]] -> [[(ItemId, Name)]]) -> [[Name]] -> [[(ItemId, Name)]]
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [[Name]]
forall a. [[a]] -> [[a]]
transpose ([[Name]] -> [[Name]]) -> [[Name]] -> [[Name]]
forall a b. (a -> b) -> a -> b
$ (DisambData -> [Name]) -> [DisambData] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> [Name]
ddNames [DisambData]
as
      go :: [DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [] [(ItemId, Name)]
_ = [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      go ([DisambData]
as' :: [DisambData]) ([(ItemId, Name)]
ns :: [(ItemId, Name)]) = do
        Set ItemId
hintedIds <- [ItemId] -> Set ItemId
forall a. Ord a => [a] -> Set a
Set.fromList ([ItemId] -> Set ItemId)
-> ([Maybe ItemId] -> [ItemId]) -> [Maybe ItemId] -> Set ItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe ItemId] -> [ItemId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ItemId] -> Set ItemId)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [Maybe ItemId]
-> RWST (Context a) (Set Text) (EvalState a) Identity (Set ItemId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        ((ItemId, Name)
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe ItemId))
-> [(ItemId, Name)]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [Maybe ItemId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Maybe Lang
-> [Name]
-> (ItemId, Name)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe ItemId)
forall a.
Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang (((ItemId, Name) -> Name) -> [(ItemId, Name)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, Name) -> Name
forall a b. (a, b) -> b
snd [(ItemId, Name)]
ns)) [(ItemId, Name)]
ns
        [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData])
-> [DisambData]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a b. (a -> b) -> a -> b
$ (DisambData -> Bool) -> [DisambData] -> [DisambData]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DisambData
x -> DisambData -> ItemId
ddItem DisambData
x ItemId -> Set ItemId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ItemId
hintedIds) [DisambData]
as'
  ([DisambData]
 -> [(ItemId, Name)]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData])
-> [DisambData] -> [[(ItemId, Name)]] -> Eval a ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ [DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
forall a.
[DisambData]
-> [(ItemId, Name)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [DisambData]
go [DisambData]
as [[(ItemId, Name)]]
correspondingNames

addYearSuffixes :: M.Map ItemId [SortKeyValue]
                -> [[DisambData]]
                -> Eval a ()
addYearSuffixes :: Map ItemId [SortKeyValue] -> [[DisambData]] -> Eval a ()
addYearSuffixes Map ItemId [SortKeyValue]
bibSortKeyMap' [[DisambData]]
as = do
  let allitems :: [DisambData]
allitems = [[DisambData]] -> [DisambData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DisambData]]
as
  [SortKeyValue] -> [SortKeyValue] -> Ordering
collate <- (Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     ([SortKeyValue] -> [SortKeyValue] -> Ordering)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
forall a. Context a -> [SortKeyValue] -> [SortKeyValue] -> Ordering
contextCollate
  let companions :: DisambData -> [DisambData]
companions DisambData
a =
        (DisambData -> DisambData -> Ordering)
-> [DisambData] -> [DisambData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
        (\DisambData
item1 DisambData
item2 ->
          [SortKeyValue] -> [SortKeyValue] -> Ordering
collate
            ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item1) Map ItemId [SortKeyValue]
bibSortKeyMap')
            ([SortKeyValue] -> Maybe [SortKeyValue] -> [SortKeyValue]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [SortKeyValue] -> [SortKeyValue])
-> Maybe [SortKeyValue] -> [SortKeyValue]
forall a b. (a -> b) -> a -> b
$ ItemId -> Map ItemId [SortKeyValue] -> Maybe [SortKeyValue]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (DisambData -> ItemId
ddItem DisambData
item2) Map ItemId [SortKeyValue]
bibSortKeyMap'))
        ([[DisambData]] -> [DisambData]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [DisambData]
x | [DisambData]
x <- [[DisambData]]
as, DisambData
a DisambData -> [DisambData] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DisambData]
x ])
  let groups :: Set [DisambData]
groups = (DisambData -> [DisambData]) -> Set DisambData -> Set [DisambData]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DisambData -> [DisambData]
companions (Set DisambData -> Set [DisambData])
-> Set DisambData -> Set [DisambData]
forall a b. (a -> b) -> a -> b
$ [DisambData] -> Set DisambData
forall a. Ord a => [a] -> Set a
Set.fromList [DisambData]
allitems
  let addYearSuffix :: ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix ItemId
item Int
suff =
        (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> RWST r w (EvalState a) m ())
-> (EvalState a -> EvalState a) -> RWST r w (EvalState a) m ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
          EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
               (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$ Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall a.
Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setYearSuffix Int
suff ItemId
item
               (Map ItemId (Reference a) -> Map ItemId (Reference a))
-> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap
               (ReferenceMap a -> Map ItemId (Reference a))
-> ReferenceMap a -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st }
  ([DisambData]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [()])
-> Set [DisambData] -> Eval a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[DisambData]
xs -> (ItemId -> Int -> Eval a ())
-> [ItemId]
-> [Int]
-> RWST (Context a) (Set Text) (EvalState a) Identity [()]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ItemId -> Int -> Eval a ()
forall (m :: * -> *) r w a.
Monad m =>
ItemId -> Int -> RWST r w (EvalState a) m ()
addYearSuffix ((DisambData -> ItemId) -> [DisambData] -> [ItemId]
forall a b. (a -> b) -> [a] -> [b]
map DisambData -> ItemId
ddItem [DisambData]
xs) [Int
1..]) Set [DisambData]
groups

tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition [DisambData]
as =
  case [DisambData]
as of
    [] -> () -> Eval a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    [DisambData]
xs -> (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
            EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
                (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$ (DisambData
 -> Map ItemId (Reference a) -> Map ItemId (Reference a))
-> Map ItemId (Reference a)
-> [DisambData]
-> Map ItemId (Reference a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall a.
Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setDisambCondition Bool
True (ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a))
-> (DisambData -> ItemId)
-> DisambData
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambData -> ItemId
ddItem)
                  (ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st))
                  [DisambData]
xs }

alterReferenceDisambiguation :: (DisambiguationData -> DisambiguationData)
                             -> Reference a
                             -> Reference a
alterReferenceDisambiguation :: (DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation DisambiguationData -> DisambiguationData
f Reference a
r =
      Reference a
r{ referenceDisambiguation :: Maybe DisambiguationData
referenceDisambiguation = DisambiguationData -> DisambiguationData
f (DisambiguationData -> DisambiguationData)
-> Maybe DisambiguationData -> Maybe DisambiguationData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           case Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation Reference a
r of
             Maybe DisambiguationData
Nothing -> DisambiguationData -> Maybe DisambiguationData
forall a. a -> Maybe a
Just
               DisambiguationData :: Maybe Int
-> Map Name NameHints -> Maybe Int -> Bool -> DisambiguationData
DisambiguationData
                 { disambYearSuffix :: Maybe Int
disambYearSuffix  = Maybe Int
forall a. Maybe a
Nothing
                 , disambNameMap :: Map Name NameHints
disambNameMap     = Map Name NameHints
forall a. Monoid a => a
mempty
                 , disambEtAlNames :: Maybe Int
disambEtAlNames   = Maybe Int
forall a. Maybe a
Nothing
                 , disambCondition :: Bool
disambCondition   = Bool
False
               }
             Just DisambiguationData
x  -> DisambiguationData -> Maybe DisambiguationData
forall a. a -> Maybe a
Just DisambiguationData
x }

initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch :: Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
x Name
y =
  case (Name -> Maybe Text
nameGiven Name
x, Name -> Maybe Text
nameGiven Name
y) of
    (Just Text
x', Just Text
y') ->
      Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
x' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==
        Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False Text
"" Text
y'
    (Maybe Text, Maybe Text)
_ -> Bool
False

addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint Maybe Lang
mblang [Name]
names (ItemId
item, Name
name) = do
  let familyMatches :: [Name]
familyMatches = [Name
n | Name
n <- [Name]
names
                         , Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
                         , Name -> Maybe Text
nameFamily Name
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Text
nameFamily Name
name]
  case [Name]
familyMatches of
    [] -> Maybe ItemId -> Eval a (Maybe ItemId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemId
forall a. Maybe a
Nothing
    [Name]
_  -> do
      let hint :: NameHints
hint = if (Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe Lang -> Name -> Name -> Bool
initialsMatch Maybe Lang
mblang Name
name) [Name]
familyMatches
                    then NameHints
AddGivenName
                    else NameHints
AddInitials
      (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
        EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap
            (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$ NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
forall a.
NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
setNameHint NameHints
hint Name
name ItemId
item
            (Map ItemId (Reference a) -> Map ItemId (Reference a))
-> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) }
      Maybe ItemId -> Eval a (Maybe ItemId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ItemId -> Eval a (Maybe ItemId))
-> Maybe ItemId -> Eval a (Maybe ItemId)
forall a b. (a -> b) -> a -> b
$ ItemId -> Maybe ItemId
forall a. a -> Maybe a
Just ItemId
item

setNameHint :: NameHints -> Name -> ItemId
            -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setNameHint :: NameHints
-> Name
-> ItemId
-> Map ItemId (Reference a)
-> Map ItemId (Reference a)
setNameHint NameHints
hint Name
name = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambNameMap :: Map Name NameHints
disambNameMap =
                     Name -> NameHints -> Map Name NameHints -> Map Name NameHints
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
name NameHints
hint
                     (DisambiguationData -> Map Name NameHints
disambNameMap DisambiguationData
d) }))

setEtAlNames :: Maybe Int -> ItemId
             -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setEtAlNames :: Maybe Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setEtAlNames Maybe Int
x = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambEtAlNames :: Maybe Int
disambEtAlNames = Maybe Int
x }))

setYearSuffix :: Int -> ItemId
              -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setYearSuffix :: Int
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setYearSuffix Int
x = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambYearSuffix :: Maybe Int
disambYearSuffix = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x }))

setDisambCondition :: Bool -> ItemId
                   -> M.Map ItemId (Reference a) -> M.Map ItemId (Reference a)
setDisambCondition :: Bool
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
setDisambCondition Bool
x = (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust
       ((DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
forall a.
(DisambiguationData -> DisambiguationData)
-> Reference a -> Reference a
alterReferenceDisambiguation
         (\DisambiguationData
d -> DisambiguationData
d{ disambCondition :: Bool
disambCondition = Bool
x }))

getAmbiguities :: CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities :: [Output a] -> [[DisambData]]
getAmbiguities =
        ([DisambData] -> Maybe [DisambData])
-> [[DisambData]] -> [[DisambData]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
           (\[DisambData]
zs ->
               case [DisambData]
zs of
                 []     -> Maybe [DisambData]
forall a. Maybe a
Nothing
                 [DisambData
_]    -> Maybe [DisambData]
forall a. Maybe a
Nothing
                 (DisambData
z:[DisambData]
_) ->
                   case DisambData -> Text
ddRendered DisambData
z of
                     Text
"" -> Maybe [DisambData]
forall a. Maybe a
Nothing
                     Text
_  -> case (DisambData -> ItemId) -> [DisambData] -> [DisambData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn DisambData -> ItemId
ddItem [DisambData]
zs of
                             ys :: [DisambData]
ys@(DisambData
_:DisambData
_:[DisambData]
_) -> [DisambData] -> Maybe [DisambData]
forall a. a -> Maybe a
Just [DisambData]
ys -- > 1 ambiguous entry
                             [DisambData]
_          -> Maybe [DisambData]
forall a. Maybe a
Nothing)
      ([[DisambData]] -> [[DisambData]])
-> ([Output a] -> [[DisambData]]) -> [Output a] -> [[DisambData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisambData -> DisambData -> Bool)
-> [DisambData] -> [[DisambData]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\DisambData
x DisambData
y -> DisambData -> Text
ddRendered DisambData
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== DisambData -> Text
ddRendered DisambData
y)
      ([DisambData] -> [[DisambData]])
-> ([Output a] -> [DisambData]) -> [Output a] -> [[DisambData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisambData -> Text) -> [DisambData] -> [DisambData]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DisambData -> Text
ddRendered
      ([DisambData] -> [DisambData])
-> ([Output a] -> [DisambData]) -> [Output a] -> [DisambData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> DisambData) -> [Output a] -> [DisambData]
forall a b. (a -> b) -> [a] -> [b]
map Output a -> DisambData
forall a. CiteprocOutput a => Output a -> DisambData
toDisambData

toDisambData :: CiteprocOutput a => Output a -> DisambData
toDisambData :: Output a -> DisambData
toDisambData (Tagged (TagItem CitationItemType
NormalCite ItemId
iid) Output a
x) =
  let xs :: [Output a]
xs = Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x
      ns' :: [Name]
ns' = [Output a] -> [Name]
forall a. [Output a] -> [Name]
getNames [Output a]
xs
      ds' :: [Date]
ds' = [Output a] -> [Date]
forall a. [Output a] -> [Date]
getDates [Output a]
xs
      t :: Text
t   = Output a -> Text
forall a. CiteprocOutput a => Output a -> Text
outputToText Output a
x
   in ItemId -> [Name] -> [Date] -> Text -> DisambData
DisambData ItemId
iid [Name]
ns' [Date]
ds' Text
t
 where
  getNames :: [Output a] -> [Name]
  getNames :: [Output a] -> [Name]
getNames (Tagged (TagNames Variable
_ NamesFormat
_ [Name]
ns) Output a
_ : [Output a]
xs)
                  = [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Output a] -> [Name]
forall a. [Output a] -> [Name]
getNames [Output a]
xs
  getNames (Output a
_ : [Output a]
xs)   = [Output a] -> [Name]
forall a. [Output a] -> [Name]
getNames [Output a]
xs
  getNames []         = []

  getDates :: [Output a] -> [Date]
  getDates :: [Output a] -> [Date]
getDates (Tagged (TagDate Date
d) Output a
_ : [Output a]
xs)
                  = Date
d Date -> [Date] -> [Date]
forall a. a -> [a] -> [a]
: [Output a] -> [Date]
forall a. [Output a] -> [Date]
getDates [Output a]
xs
  getDates (Output a
_ : [Output a]
xs)   = [Output a] -> [Date]
forall a. [Output a] -> [Date]
getDates [Output a]
xs
  getDates []         = []
toDisambData Output a
_ = String -> DisambData
forall a. HasCallStack => String -> a
error String
"toDisambData called without tagged item"


--
-- Grouping and collapsing
--

groupAndCollapseCitations :: forall a . CiteprocOutput a
                          => Text
                          -> Maybe Text
                          -> Maybe Text
                          -> Maybe Collapsing
                          -> Output a
                          -> Output a
groupAndCollapseCitations :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Collapsing
-> Output a
-> Output a
groupAndCollapseCitations Text
citeGroupDelim Maybe Text
yearSuffixDelim Maybe Text
afterCollapseDelim
  Maybe Collapsing
collapsing (Formatted Formatting
f [Output a]
xs) =
   case Maybe Collapsing
collapsing of
      Just Collapsing
CollapseCitationNumber ->
        Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
forall a. Maybe a
Nothing } ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
            ([Output a] -> [Output a] -> [Output a])
-> [Output a] -> [[Output a]] -> [Output a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Output a] -> [Output a] -> [Output a]
collapseRange []
                  ((Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive Output a -> Output a -> Bool
isAdjacentCitationNumber [Output a]
xs)
      Just Collapsing
collapseType ->
          Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
forall a. Maybe a
Nothing } ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
            ([Output a] -> [Output a] -> [Output a])
-> [Output a] -> [[Output a]] -> [Output a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Collapsing -> [Output a] -> [Output a] -> [Output a]
collapseGroup Collapsing
collapseType) [] ((Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupWith Output a -> Output a -> Bool
sameNames [Output a]
xs)
      Maybe Collapsing
Nothing ->
          Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
             ([Output a] -> Output a) -> [[Output a]] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
citeGroupDelim })
                 ((Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupWith Output a -> Output a -> Bool
sameNames [Output a]
xs)
 where
  --   Note that we cannot assume we've sorted by name,
  --   so we can't just use Data.ListgroupBy
  groupWith :: (b -> b -> Bool) -> [b] -> [[b]]
  groupWith :: (b -> b -> Bool) -> [b] -> [[b]]
groupWith b -> b -> Bool
_ [] = []
  groupWith b -> b -> Bool
isMatched (b
z:[b]
zs) =
    (b
z b -> [b] -> [b]
forall a. a -> [a] -> [a]
: (b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> b -> Bool
isMatched b
z) [b]
zs) [b] -> [[b]] -> [[b]]
forall a. a -> [a] -> [a]
:
         (b -> b -> Bool) -> [b] -> [[b]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupWith b -> b -> Bool
isMatched ((b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (b -> Bool) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> Bool
isMatched b
z) [b]
zs)

  collapseRange :: [Output a] -> [Output a] -> [Output a]
  collapseRange :: [Output a] -> [Output a] -> [Output a]
collapseRange [Output a]
ys [Output a]
zs
    | [Output a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
ys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
    , Just Output a
yhead <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
headMay [Output a]
ys
    , Just Output a
ylast <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
lastMay [Output a]
ys
      = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash }
                  [Output a
yhead, Output a
ylast] Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
                  if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
                     then []
                     else Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Maybe Text
afterCollapseDelim Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
zs
  collapseRange [Output a]
ys [Output a]
zs =
    Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Formatting -> Maybe Text
formatDelimiter Formatting
f } [Output a]
ys Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:
      if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
         then []
         else Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal (Formatting -> Maybe Text
formatDelimiter Formatting
f) Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
zs

  collapseGroup :: Collapsing -> [Output a] -> [Output a] -> [Output a]
  collapseGroup :: Collapsing -> [Output a] -> [Output a] -> [Output a]
collapseGroup Collapsing
_ [] [Output a]
zs = [Output a]
zs
  collapseGroup Collapsing
collapseType (Output a
y:[Output a]
ys) [Output a]
zs =
    let ys' :: [Output a]
ys' = Output a
y Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform Output a -> Output a
forall a. Output a -> Output a
removeNames) [Output a]
ys
        ws :: [Output a]
ws = Collapsing -> [Output a] -> [Output a]
collapseYearSuffix Collapsing
collapseType [Output a]
ys'
        noCollapse :: Bool
noCollapse = [Output a]
ws [Output a] -> [Output a] -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
yOutput a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[Output a]
ys
        noYearSuffixCollapse :: Bool
noYearSuffixCollapse = [Output a]
ws [Output a] -> [Output a] -> Bool
forall a. Eq a => a -> a -> Bool
== [Output a]
ys'
        hasLocator :: Output a -> Bool
hasLocator Output a
u = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a
x | x :: Output a
x@(Tagged Tag
TagLocator Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
u]
        anyHasLocator :: Bool
anyHasLocator = (Output a -> Bool) -> [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Output a -> Bool
forall a. Output a -> Bool
hasLocator [Output a]
ws
        -- https://github.com/citation-style-language/test-suite/issues/36 :
        flippedAfterCollapseDelim :: Bool
flippedAfterCollapseDelim = Collapsing
collapseType Collapsing -> Collapsing -> Bool
forall a. Eq a => a -> a -> Bool
== Collapsing
CollapseYear
        addCGDelim :: Output a -> [Output a] -> [Output a]
addCGDelim Output a
u [] = [Output a
u]
        addCGDelim Output a
u [Output a]
us =
          Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix =
                              if Bool
noCollapse Bool -> Bool -> Bool
|| Bool
noYearSuffixCollapse Bool -> Bool -> Bool
&&
                                 Bool -> Bool
not (Bool
flippedAfterCollapseDelim Bool -> Bool -> Bool
&&
                                      Bool
anyHasLocator)
                                 then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
citeGroupDelim
                                 else Maybe Text
afterCollapseDelim Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                      Formatting -> Maybe Text
formatDelimiter Formatting
f } [Output a
u] Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
us
     in Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
forall a. Maybe a
Nothing
                        , formatSuffix :: Maybe Text
formatSuffix =
                            if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
zs
                               then Maybe Text
forall a. Maybe a
Nothing
                               else if Bool
noCollapse Bool -> Bool -> Bool
&&
                                          Bool -> Bool
not Bool
flippedAfterCollapseDelim
                                       then Formatting -> Maybe Text
formatDelimiter Formatting
f
                                       else Maybe Text
afterCollapseDelim Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                            Formatting -> Maybe Text
formatDelimiter Formatting
f }
                               ((Output a -> [Output a] -> [Output a])
-> [Output a] -> [Output a] -> [Output a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Output a -> [Output a] -> [Output a]
forall a. Output a -> [Output a] -> [Output a]
addCGDelim [] [Output a]
ws) Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
zs
  collapseRanges :: [Output a] -> [Output a]
collapseRanges = ([Output a] -> Output a) -> [[Output a]] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map [Output a] -> Output a
rangifyGroup ([[Output a]] -> [Output a])
-> ([Output a] -> [[Output a]]) -> [Output a] -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive Output a -> Output a -> Bool
forall a a. Output a -> Output a -> Bool
isSuccessive
  isSuccessive :: Output a -> Output a -> Bool
isSuccessive Output a
x Output a
y
    = case ([Int
c | Tagged (TagYearSuffix Int
c) Output a
_ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x],
            [Int
d | Tagged (TagYearSuffix Int
d) Output a
_ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
y]) of
        ([Int
c],[Int
d]) -> Int
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        ([Int], [Int])
_   -> Bool
False

  rangifyGroup :: [Output a] -> Output a
  rangifyGroup :: [Output a] -> Output a
rangifyGroup [Output a]
zs
    | [Output a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
zs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
    , Just Output a
zhead <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
headMay [Output a]
zs
    , Just Output a
zlast <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
lastMay [Output a]
zs
    = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
enDash) }
                [Output a
zhead, Output a
zlast]
  rangifyGroup [Output a
z] = Output a
z
  rangifyGroup [Output a]
zs = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
yearSuffixDelim
                                    } [Output a]
zs

  yearSuffixGroup :: Bool -> [Output a] -> Output a
  yearSuffixGroup :: Bool -> [Output a] -> Output a
yearSuffixGroup Bool
_ [Output a
x] = Output a
x
  yearSuffixGroup Bool
useRanges [Output a]
zs  =
    Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
yearSuffixDelim }
      ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$ if Bool
useRanges then [Output a] -> [Output a]
collapseRanges [Output a]
zs else [Output a]
zs

  collapseYearSuffix :: Collapsing -> [Output a] -> [Output a]
  collapseYearSuffix :: Collapsing -> [Output a] -> [Output a]
collapseYearSuffix Collapsing
CollapseYearSuffix [Output a]
zs =
    [Output a] -> [Output a]
forall a. [a] -> [a]
reverse ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall a b. (a -> b) -> a -> b
$ Bool -> [Output a] -> Output a
yearSuffixGroup Bool
False [Output a]
cur Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
items
   where
     ([Output a]
cur, [Output a]
items) = (([Output a], [Output a]) -> Output a -> ([Output a], [Output a]))
-> ([Output a], [Output a])
-> [Output a]
-> ([Output a], [Output a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
False) ([], []) [Output a]
zs
  collapseYearSuffix Collapsing
CollapseYearSuffixRanged [Output a]
zs =
    [Output a] -> [Output a]
forall a. [a] -> [a]
reverse ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall a b. (a -> b) -> a -> b
$ Bool -> [Output a] -> Output a
yearSuffixGroup Bool
True [Output a]
cur Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
items
   where
     ([Output a]
cur, [Output a]
items) = (([Output a], [Output a]) -> Output a -> ([Output a], [Output a]))
-> ([Output a], [Output a])
-> [Output a]
-> ([Output a], [Output a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
True) ([], []) [Output a]
zs
  collapseYearSuffix Collapsing
_ [Output a]
zs = [Output a]
zs

  getDates :: Output a -> [Date]
  getDates :: Output a -> [Date]
getDates Output a
x = [Date
d | Tagged (TagDate Date
d) Output a
_ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x]

  getYears :: Output a -> [[Maybe Int]]
  getYears :: Output a -> [[Maybe Int]]
getYears Output a
x = [(DateParts -> Maybe Int) -> [DateParts] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (\case
                        DateParts (Int
y:[Int]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
                        DateParts
_               -> Maybe Int
forall a. Maybe a
Nothing) (Date -> [DateParts]
dateParts Date
d)
                | Date
d <- Output a -> [Date]
getDates Output a
x
                , Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Date -> Maybe Text
dateLiteral Date
d)]

  goYearSuffix :: Bool -> ([Output a], [Output a]) -> Output a
               -> ([Output a], [Output a])
  goYearSuffix :: Bool
-> ([Output a], [Output a]) -> Output a -> ([Output a], [Output a])
goYearSuffix Bool
useRanges ([Output a]
cur, [Output a]
items) Output a
item =
    case [Output a]
cur of
      []     -> ([Output a
item], [Output a]
items)
      (Output a
z:[Output a]
zs)
        | Output a -> [[Maybe Int]]
getYears Output a
z [[Maybe Int]] -> [[Maybe Int]] -> Bool
forall a. Eq a => a -> a -> Bool
== Output a -> [[Maybe Int]]
getYears Output a
item
          -> (Output a
zOutput a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[Output a]
zs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a
x | x :: Output a
x@(Tagged (TagYearSuffix Int
_) Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
item],
              [Output a]
items)
        | Bool
otherwise -> ([Output a
item], Bool -> [Output a] -> Output a
yearSuffixGroup Bool
useRanges (Output a
zOutput a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[Output a]
zs) Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
items)

  isAdjacentCitationNumber :: Output a -> Output a -> Bool
  isAdjacentCitationNumber :: Output a -> Output a -> Bool
isAdjacentCitationNumber
     (Tagged (TagItem CitationItemType
_ ItemId
_)
       (Formatted Formatting
_f1 [Tagged (TagCitationNumber Int
n1) Output a
_xs1]))
     (Tagged (TagItem CitationItemType
_ ItemId
_)
       (Formatted Formatting
_f2 [Tagged (TagCitationNumber Int
n2) Output a
_xs2]))
    = Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  isAdjacentCitationNumber
     (Tagged (TagItem CitationItemType
_ ItemId
_) (Tagged (TagCitationNumber Int
n1) Output a
_xs1))
     (Tagged (TagItem CitationItemType
_ ItemId
_) (Tagged (TagCitationNumber Int
n2) Output a
_xs2))
    = Int
n2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  isAdjacentCitationNumber Output a
_ Output a
_ = Bool
False

  sameNames :: Output a -> Output a -> Bool
  sameNames :: Output a -> Output a -> Bool
sameNames Output a
x Output a
y =
    case (Output a -> Maybe (Output a)
extractTagged Output a
x, Output a -> Maybe (Output a)
extractTagged Output a
y) of
      (Just (Tagged (TagNames Variable
t1 NamesFormat
_nf1 [Name]
ns1) Output a
ws1),
       Just (Tagged (TagNames Variable
t2 NamesFormat
_nf2 [Name]
ns2) Output a
ws2))
        -> Variable
t1 Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
t2 Bool -> Bool -> Bool
&& (if [Name]
ns1 [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== [Name]
ns2
                           then Bool -> Bool
not ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns1) Bool -> Bool -> Bool
|| Output a
ws1 Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
ws2
                           else Output a
ws1 Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
ws2)
      -- case where it's just a date with no name or anything;
      -- we treat this as same name e.g. (1955a,b)
      (Just (Tagged TagDate{} Output a
_), Just (Tagged TagDate{} Output a
_))
        -> Bool
True
          -- case where title is substituted
      (Maybe (Output a), Maybe (Output a))
_ -> Bool
False

  extractTagged :: Output a -> Maybe (Output a)
  extractTagged :: Output a -> Maybe (Output a)
extractTagged Output a
x =
    let items :: [Output a]
items = [Output a
y | y :: Output a
y@(Tagged (TagItem CitationItemType
ty ItemId
_) Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x
                   , CitationItemType
ty CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
/= CitationItemType
AuthorOnly]
        names :: [Output a]
names = [Output a
y | y :: Output a
y@(Tagged TagNames{} Output a
_) <- (Output a -> [Output a]) -> [Output a] -> [Output a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe [Output a]
items]
        dates :: [Output a]
dates = [Output a
y | y :: Output a
y@(Tagged TagDate{} Output a
_) <- (Output a -> [Output a]) -> [Output a] -> [Output a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe [Output a]
items]
    in  if [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output a]
items
           then Maybe (Output a)
forall a. Maybe a
Nothing
           else [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
listToMaybe [Output a]
names Maybe (Output a) -> Maybe (Output a) -> Maybe (Output a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
listToMaybe [Output a]
dates

groupAndCollapseCitations Text
_ Maybe Text
_ Maybe Text
_ Maybe Collapsing
_ Output a
x = Output a
x

takeSeq :: Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq :: (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent (a
x1 : a
x2 : [a]
rest)
  | a -> a -> Bool
isAdjacent a
x1 a
x2 = (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
  where ([a]
ys, [a]
zs) = (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent (a
x2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
takeSeq a -> a -> Bool
_ (a
y:[a]
ys) = ([a
y], [a]
ys)
takeSeq a -> a -> Bool
_ []     = ([], [])

groupSuccessive :: Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive :: (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive a -> a -> Bool
isAdjacent [a]
zs =
  case (a -> a -> Bool) -> [a] -> ([a], [a])
forall a. Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq a -> a -> Bool
isAdjacent [a]
zs of
    ([],[a]
_)  -> []
    ([a]
xs,[a]
ys) -> [a]
xs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
forall a. Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive a -> a -> Bool
isAdjacent [a]
ys

--
-- Sorting
--

evalSortKeys :: CiteprocOutput a
             => Layout a
             -> ItemId
             -> Eval a [SortKeyValue]
evalSortKeys :: Layout a -> ItemId -> Eval a [SortKeyValue]
evalSortKeys Layout a
layout ItemId
citeId =
  (Context a -> EvalState a -> (Context a, EvalState a))
-> Eval a [SortKeyValue] -> Eval a [SortKeyValue]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST (\Context a
ctx EvalState a
st -> (Context a
ctx{ contextInSortKey :: Bool
contextInSortKey = Bool
True }, EvalState a
st)) (Eval a [SortKeyValue] -> Eval a [SortKeyValue])
-> Eval a [SortKeyValue] -> Eval a [SortKeyValue]
forall a b. (a -> b) -> a -> b
$
    (SortKey a
 -> RWST (Context a) (Set Text) (EvalState a) Identity SortKeyValue)
-> [SortKey a] -> Eval a [SortKeyValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ItemId
-> SortKey a
-> RWST (Context a) (Set Text) (EvalState a) Identity SortKeyValue
forall a.
CiteprocOutput a =>
ItemId -> SortKey a -> Eval a SortKeyValue
evalSortKey ItemId
citeId) (Layout a -> [SortKey a]
forall a. Layout a -> [SortKey a]
layoutSortKeys Layout a
layout)

evalSortKey :: CiteprocOutput a
            => ItemId
            -> SortKey a
            -> Eval a SortKeyValue
evalSortKey :: ItemId -> SortKey a -> Eval a SortKeyValue
evalSortKey ItemId
citeId (SortKeyMacro SortDirection
sortdir [Element a]
elts) = do
  ReferenceMap a
refmap <- (EvalState a -> ReferenceMap a)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap
  case ItemId -> ReferenceMap a -> Maybe (Reference a)
forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference ItemId
citeId ReferenceMap a
refmap of
    Maybe (Reference a)
Nothing  -> SortKeyValue -> Eval a SortKeyValue
forall (m :: * -> *) a. Monad m => a -> m a
return (SortKeyValue -> Eval a SortKeyValue)
-> SortKeyValue -> Eval a SortKeyValue
forall a b. (a -> b) -> a -> b
$ SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir Maybe [Text]
forall a. Maybe a
Nothing
    Just Reference a
ref -> do
        [Text]
k <- Text -> [Text]
normalizeSortKey (Text -> [Text]) -> ([Output a] -> Text) -> [Output a] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. CiteprocOutput a => a -> Text
toText (a -> Text) -> ([Output a] -> a) -> [Output a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              CiteprocOptions -> Output a -> a
forall a. CiteprocOutput a => CiteprocOptions -> Output a -> a
renderOutput CiteprocOptions
defaultCiteprocOptions (Output a -> a) -> ([Output a] -> Output a) -> [Output a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> Output a
forall a. [Output a] -> Output a
grouped
              ([Output a] -> [Text])
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Context a -> EvalState a -> (Context a, EvalState a))
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall r' s r w a.
(r' -> s -> (r, s)) -> RWS r w s a -> RWS r' w s a
withRWS Context a -> EvalState a -> (Context a, EvalState a)
forall a. a -> EvalState a -> (a, EvalState a)
newContext ([[Output a]] -> [Output a]
forall a. Monoid a => [a] -> a
mconcat ([[Output a]] -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element a
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Output a])
-> [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element a
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
elts)
        SortKeyValue -> Eval a SortKeyValue
forall (m :: * -> *) a. Monad m => a -> m a
return (SortKeyValue -> Eval a SortKeyValue)
-> SortKeyValue -> Eval a SortKeyValue
forall a b. (a -> b) -> a -> b
$ SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
k)
     where
      newContext :: a -> EvalState a -> (a, EvalState a)
newContext a
oldContext EvalState a
s =
        (a
oldContext, EvalState a
s{ stateReference :: Reference a
stateReference = Reference a
ref })
evalSortKey ItemId
citeId (SortKeyVariable SortDirection
sortdir Variable
var) = do
  ReferenceMap a
refmap <- (EvalState a -> ReferenceMap a)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap
  SortDirection -> Maybe [Text] -> SortKeyValue
SortKeyValue SortDirection
sortdir (Maybe [Text] -> SortKeyValue)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
-> Eval a SortKeyValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case ItemId -> ReferenceMap a -> Maybe (Reference a)
forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference ItemId
citeId ReferenceMap a
refmap Maybe (Reference a)
-> (Reference a -> Maybe (Val a)) -> Maybe (Val a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
var of
      Maybe (Val a)
Nothing           -> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
forall a. Maybe a
Nothing
      Just (TextVal Text
t)  -> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Text]
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe [Text]))
-> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
normalizeSortKey Text
t
      Just (NumVal  Int
i)  -> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Text]
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe [Text]))
-> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%09d" Int
i]
      Just (FancyVal a
x) -> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Text]
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe [Text]))
-> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
normalizeSortKey (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x
      Just (NamesVal [Name]
ns) ->
        [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text])
-> ([[Text]] -> [Text]) -> [[Text]] -> Maybe [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
normalizeSortKey (Text -> [Text]) -> ([[Text]] -> Text) -> [[Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([[Text]] -> [Text]) -> [[Text]] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"," ([Text] -> [Text]) -> ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Text
T.unwords
             ([[Text]] -> Maybe [Text])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Text]]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Name -> RWST (Context a) (Set Text) (EvalState a) Identity [Text])
-> [Name]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Text]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> RWST (Context a) (Set Text) (EvalState a) Identity [Text]
forall a. Name -> Eval a [Text]
getNamePartSortOrder [Name]
ns
      Just (DateVal Date
d)  -> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Text]
 -> RWST
      (Context a) (Set Text) (EvalState a) Identity (Maybe [Text]))
-> Maybe [Text]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Date -> Text
dateToText Date
d]

normalizeSortKey :: Text -> [Text]
normalizeSortKey :: Text -> [Text]
normalizeSortKey = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isWordSep
 where
  isWordSep :: Char -> Bool
isWordSep Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'’' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
||
                Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'ʾ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'ʿ' -- ayn/hamza in transliterated arabic

-- absence should sort AFTER all values
-- see sort_StatusFieldAscending.txt, sort_StatusFieldDescending.txt
compSortKeyValue :: (Text -> Text -> Ordering)
                 -> SortKeyValue
                 -> SortKeyValue
                 -> Ordering
compSortKeyValue :: (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue Text -> Text -> Ordering
collate SortKeyValue
sk1 SortKeyValue
sk2 =
  case (SortKeyValue
sk1, SortKeyValue
sk2) of
    (SortKeyValue SortDirection
_ Maybe [Text]
Nothing, SortKeyValue SortDirection
_ Maybe [Text]
Nothing) -> Ordering
EQ
    (SortKeyValue SortDirection
_ Maybe [Text]
Nothing, SortKeyValue SortDirection
_ (Just [Text]
_)) -> Ordering
GT
    (SortKeyValue SortDirection
_ (Just [Text]
_), SortKeyValue SortDirection
_ Maybe [Text]
Nothing) -> Ordering
LT
    (SortKeyValue SortDirection
Ascending (Just [Text]
t1), SortKeyValue SortDirection
Ascending (Just [Text]
t2)) ->
      [Text] -> [Text] -> Ordering
collateKey [Text]
t1 [Text]
t2
    (SortKeyValue SortDirection
Descending (Just [Text]
t1), SortKeyValue SortDirection
Descending (Just [Text]
t2))->
      [Text] -> [Text] -> Ordering
collateKey [Text]
t2 [Text]
t1
    (SortKeyValue, SortKeyValue)
_ -> Ordering
EQ
 where
  collateKey :: [Text] -> [Text] -> Ordering
  collateKey :: [Text] -> [Text] -> Ordering
collateKey [] [] = Ordering
EQ
  collateKey [] (Text
_:[Text]
_) = Ordering
LT
  collateKey (Text
_:[Text]
_) [] = Ordering
GT
  collateKey (Text
x:[Text]
xs) (Text
y:[Text]
ys) =
    case Text -> Text -> Ordering
collate Text
x Text
y of
      Ordering
EQ -> [Text] -> [Text] -> Ordering
collateKey [Text]
xs [Text]
ys
      Ordering
GT -> Ordering
GT
      Ordering
LT -> Ordering
LT

compSortKeyValues :: (Text -> Text -> Ordering)
                  -> [SortKeyValue]
                  -> [SortKeyValue]
                  -> Ordering
compSortKeyValues :: (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues Text -> Text -> Ordering
_ [] [] = Ordering
EQ
compSortKeyValues Text -> Text -> Ordering
_ [] (SortKeyValue
_:[SortKeyValue]
_) = Ordering
LT
compSortKeyValues Text -> Text -> Ordering
_ (SortKeyValue
_:[SortKeyValue]
_) [] = Ordering
GT
compSortKeyValues Text -> Text -> Ordering
collate (SortKeyValue
x:[SortKeyValue]
xs) (SortKeyValue
y:[SortKeyValue]
ys) =
  case (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue Text -> Text -> Ordering
collate SortKeyValue
x SortKeyValue
y of
    Ordering
EQ -> (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues Text -> Text -> Ordering
collate [SortKeyValue]
xs [SortKeyValue]
ys
    Ordering
GT -> Ordering
GT
    Ordering
LT -> Ordering
LT

-- Note!  This prints negative (BC) dates as N(999,999,999 + y)
-- and positive (AD) dates as Py so they sort properly.  (Note that
-- our unicode sorting ignores punctuation, so we use a letter
-- rather than -.) Do not use out of context of sort keys.
dateToText :: Date -> Text
dateToText :: Date -> Text
dateToText = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Date -> [Text]) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateParts -> Text) -> [DateParts] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (DateParts -> String) -> DateParts -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String
go ([Int] -> String) -> (DateParts -> [Int]) -> DateParts -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateParts -> [Int]
coerce) ([DateParts] -> [Text]) -> (Date -> [DateParts]) -> Date -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> [DateParts]
dateParts
 where
  go :: [Int] -> String
  go :: [Int] -> String
go [] = String
""
  go [Int
y] = Int -> String
toYear Int
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"0000"
  go [Int
y,Int
m] = Int -> String
toYear Int
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"00"
  go (Int
y:Int
m:Int
d:[Int]
_) = Int -> String
toYear Int
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
d
  toYear :: Int -> String
  toYear :: Int -> String
toYear Int
y
    | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"N%09d" (Int
999999999 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
    | Bool
otherwise = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"P%09d" Int
y


evalLayout :: CiteprocOutput a
            => Layout a
            -> (Int, Citation a)
            -> Eval a (Output a)
evalLayout :: Layout a -> (Int, Citation a) -> Eval a (Output a)
evalLayout Layout a
layout (Int
citationGroupNumber, Citation a
citation) = do
  -- this is a hack to ensure that "ibid" detection will work
  -- correctly in a citation starting with an author-only:
  -- the combination AuthorOnly [SuppressAuthor] should not
  -- count against a later Ibid citation.
  let positionsInCitation :: [Int]
positionsInCitation =
        case Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation of
          (CitationItem a
c:[CitationItem a]
_) | CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
c CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly -> [Int
0..]
          [CitationItem a]
_ -> [Int
1..]

  [Output a]
items <- ((Int, CitationItem a) -> Eval a (Output a))
-> [(Int, CitationItem a)]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, CitationItem a) -> Eval a (Output a)
evalItem' ([Int] -> [CitationItem a] -> [(Int, CitationItem a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
positionsInCitation (Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation))

  -- see display_SecondFieldAlignMigratePunctuation.txt
  let moveSuffixInsideDisplay :: [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
zs =
        case ([Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
lastMay [Output a]
zs, Formatting -> Maybe Text
formatSuffix Formatting
formatting) of
          (Just (Tagged (TagItem CitationItemType
ct ItemId
id') (Formatted Formatting
f [Output a]
ys)), Just Text
_) ->
            (\[Output a]
ys' -> [Output a] -> [Output a]
forall a. [a] -> [a]
initSafe [Output a]
zs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                      [Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem CitationItemType
ct ItemId
id') (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
ys')]) ([Output a] -> [Output a]) -> Maybe [Output a] -> Maybe [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                        [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
ys
          (Just (Formatted Formatting
f [Output a]
ys), Just Text
suff)
            | Maybe DisplayStyle -> Bool
forall a. Maybe a -> Bool
isJust (Formatting -> Maybe DisplayStyle
formatDisplay Formatting
f) ->
                [Output a] -> Maybe [Output a]
forall a. a -> Maybe a
Just ([Output a] -> Maybe [Output a]) -> [Output a] -> Maybe [Output a]
forall a b. (a -> b) -> a -> b
$ [Output a] -> [Output a]
forall a. [a] -> [a]
initSafe [Output a]
zs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                     [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = Text -> Maybe Text
forall a. a -> Maybe a
Just
                          (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Formatting -> Maybe Text
formatSuffix Formatting
f) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff) } [Output a]
ys]
            | Bool
otherwise -> (\[Output a]
ys' -> [Output a] -> [Output a]
forall a. [a] -> [a]
initSafe [Output a]
zs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
ys']) ([Output a] -> [Output a]) -> Maybe [Output a] -> Maybe [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
ys
          (Maybe (Output a), Maybe Text)
_ -> Maybe [Output a]
forall a. Maybe a
Nothing
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
    case [Output a] -> Maybe [Output a]
forall a. [Output a] -> Maybe [Output a]
moveSuffixInsideDisplay [Output a]
items of
      Maybe [Output a]
Nothing     -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
items
      Just [Output a]
items' -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing } [Output a]
items'
 where
  formatting :: Formatting
formatting = Layout a -> Formatting
forall a. Layout a -> Formatting
layoutFormatting Layout a
layout

  secondFieldAlign :: [Output a] -> [Output a]
secondFieldAlign (Output a
x:[Output a]
xs) =
    Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDisplay :: Maybe DisplayStyle
formatDisplay = DisplayStyle -> Maybe DisplayStyle
forall a. a -> Maybe a
Just DisplayStyle
DisplayLeftMargin } [Output a
x]
    Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDisplay :: Maybe DisplayStyle
formatDisplay = DisplayStyle -> Maybe DisplayStyle
forall a. a -> Maybe a
Just DisplayStyle
DisplayRightInline } [Output a]
xs]
  secondFieldAlign [] = []

  evalItem' :: (Int, CitationItem a) -> Eval a (Output a)
evalItem' (Int
positionInCitation :: Int, CitationItem a
item) = do
    Bool
isBibliography  <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInBibliography

    StyleOptions
styleOpts <- (Context a -> StyleOptions)
-> RWST (Context a) (Set Text) (EvalState a) Identity StyleOptions
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions
    let isNote :: Bool
isNote = StyleOptions -> Bool
styleIsNoteStyle StyleOptions
styleOpts
    [Position]
position <- Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
forall a.
Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition Int
citationGroupNumber (Citation a -> Maybe Int
forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation)
                     CitationItem a
item Int
positionInCitation

    [Output a]
xs <- Layout a
-> ([Position], CitationItem a)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a.
CiteprocOutput a =>
Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem Layout a
layout ([Position]
position, CitationItem a
item)
    -- we only update the map in the citations section
    Bool
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBibliography (RWST (Context a) (Set Text) (EvalState a) Identity ()
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ do
      Int
-> Citation a
-> CitationItem a
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap Int
citationGroupNumber Citation a
citation CitationItem a
item
      Int
-> Int
-> Citation a
-> CitationItem a
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap Int
citationGroupNumber Int
positionInCitation Citation a
citation CitationItem a
item

    Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
          (Output a -> Output a)
-> (a -> Output a -> Output a) -> Maybe a -> Output a -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a -> Output a
forall a. a -> a
id (\a
pref Output a
x -> [Output a] -> Output a
forall a. [Output a] -> Output a
grouped [a -> Output a
forall a. a -> Output a
Literal a
pref, Output a
x])
                (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
item)
        (Output a -> Output a)
-> ([Output a] -> Output a) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> Output a)
-> (a -> Output a -> Output a) -> Maybe a -> Output a -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a -> Output a
forall a. a -> a
id (\a
suff Output a
x -> [Output a] -> Output a
forall a. [Output a] -> Output a
grouped [Output a
x, a -> Output a
forall a. a -> Output a
Literal a
suff])
                   (CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemSuffix CitationItem a
item)
        (Output a -> Output a)
-> ([Output a] -> Output a) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Output a
x -> case Output a
x of
                   Output a
NullOutput -> Output a
x
                   Output a
_          -> Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (CitationItemType -> ItemId -> Tag
TagItem (CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item)
                                                  (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)) Output a
x)
        (Output a -> Output a)
-> ([Output a] -> Output a) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
        ([Output a] -> Output a)
-> ([Output a] -> [Output a]) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
              then (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> ([Output a] -> Output a) -> [Output a] -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a
forall a. Output a -> Output a
getAuthors (Output a -> Output a)
-> ([Output a] -> Output a) -> [Output a] -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty
              else [Output a] -> [Output a]
forall a. a -> a
id)
        ([Output a] -> [Output a])
-> ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case CitationItem a -> Maybe a
forall a. CitationItem a -> Maybe a
citationItemPrefix CitationItem a
item of
             Just a
t | Bool
isNote
                    , Text
". " Text -> Text -> Bool
`T.isSuffixOf` a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
t
                    , Text -> Text -> Int
T.count Text
" " (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -- exclude single word
                                 -> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
capitalizeInitialTerm
             Maybe a
_                   -> [Output a] -> [Output a]
forall a. a -> a
id)
        ([Output a] -> [Output a])
-> ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
isBibliography
              then
                case StyleOptions -> Maybe SecondFieldAlign
styleSecondFieldAlign StyleOptions
styleOpts of
                  Just SecondFieldAlign
SecondFieldAlignFlush  -> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
secondFieldAlign
                  Just SecondFieldAlign
SecondFieldAlignMargin -> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
secondFieldAlign -- TODO?
                  Maybe SecondFieldAlign
Nothing -> [Output a] -> [Output a]
forall a. a -> a
id
              else [Output a] -> [Output a]
forall a. a -> a
id)
        ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$ [Output a]
xs

evalItem :: CiteprocOutput a
         => Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem :: Layout a -> ([Position], CitationItem a) -> Eval a [Output a]
evalItem Layout a
layout ([Position]
position, CitationItem a
item) = do
  ReferenceMap a
refmap <- (EvalState a -> ReferenceMap a)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (ReferenceMap a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap

  let addLangToFormatting :: Lang -> Output a -> Output a
addLangToFormatting Lang
lang (Formatted Formatting
f [Output a]
xs) =
        Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatLang :: Maybe Lang
formatLang = Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
lang } [Output a]
xs
      addLangToFormatting Lang
_ Output a
x = Output a
x

  case ItemId -> ReferenceMap a -> Maybe (Reference a)
forall a. ItemId -> ReferenceMap a -> Maybe (Reference a)
lookupReference (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) ReferenceMap a
refmap of
    Just Reference a
ref -> (Context a -> EvalState a -> (Context a, EvalState a))
-> Eval a [Output a] -> Eval a [Output a]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST
      (\Context a
ctx EvalState a
st ->
       (Context a
ctx{ contextLocator :: Maybe Text
contextLocator = CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item
           , contextLabel :: Maybe Text
contextLabel = CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item
           , contextPosition :: [Position]
contextPosition = [Position]
position
           },
        EvalState a
st{ stateReference :: Reference a
stateReference = Reference a
ref
          , stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
False
          , stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
False
          , stateUsedTitle :: Bool
stateUsedTitle = Bool
False
          }))
        (Eval a [Output a] -> Eval a [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$ do [Output a]
xs <- [[Output a]] -> [Output a]
forall a. Monoid a => [a] -> a
mconcat ([[Output a]] -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element a -> Eval a [Output a])
-> [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element a -> Eval a [Output a]
forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement (Layout a -> [Element a]
forall a. Layout a -> [Element a]
layoutElements Layout a
layout)

             -- find identifiers that can be used to hyperlink the title 
             let mbident :: Maybe Identifier
mbident = 
                    (Maybe Identifier -> Maybe Identifier -> Maybe Identifier)
-> Maybe Identifier -> [Maybe Identifier] -> Maybe Identifier
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Maybe Identifier -> Maybe Identifier -> Maybe Identifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe Identifier
forall a. Maybe a
Nothing
                      [ Text -> Identifier
IdentDOI   (Text -> Identifier) -> Maybe Text -> Maybe Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val a -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText (Val a -> Maybe Text) -> Maybe (Val a) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"DOI" Reference a
ref)
                      , Text -> Identifier
IdentPMCID (Text -> Identifier) -> Maybe Text -> Maybe Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val a -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText (Val a -> Maybe Text) -> Maybe (Val a) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"PMCID" Reference a
ref)
                      , Text -> Identifier
IdentPMID  (Text -> Identifier) -> Maybe Text -> Maybe Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val a -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText (Val a -> Maybe Text) -> Maybe (Val a) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"PMID" Reference a
ref)
                      , Text -> Identifier
IdentURL   (Text -> Identifier) -> Maybe Text -> Maybe Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val a -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText (Val a -> Maybe Text) -> Maybe (Val a) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"URL" Reference a
ref)
                      ]
             let mburl :: Maybe Text
mburl = Identifier -> Text
identifierToURL (Identifier -> Text) -> Maybe Identifier -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Identifier
mbident
            
             -- hyperlink any titles in the output
             let linkTitle :: Text -> Output a -> Output a
linkTitle Text
url (Tagged Tag
TagTitle Output a
x) = Text -> [Output a] -> Output a
forall a. Text -> [Output a] -> Output a
Linked Text
url [Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagTitle Output a
x]
                 linkTitle Text
_ Output a
x = Output a
x
             
             Bool
usedLink  <- (EvalState a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Bool
forall a. EvalState a -> Bool
stateUsedIdentifier
             Bool
usedTitle <- (EvalState a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Bool
forall a. EvalState a -> Bool
stateUsedTitle
             Bool
inBiblio  <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInBibliography 

             -- when no links were rendered for a bibliography item, hyperlink
             -- the title, if it exists, otherwise hyperlink the whole item
             let xs' :: [Output a]
xs' =
                   if Bool
usedLink Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
inBiblio
                     then [Output a]
xs
                   else case Maybe Text
mburl of
                         Maybe Text
Nothing  -> [Output a]
xs
                         Just Text
url -> if Bool
usedTitle
                                        -- hyperlink the title
                                        then (Output a -> Output a) -> [Output a] -> [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Text -> Output a -> Output a
forall a. Text -> Output a -> Output a
linkTitle Text
url)) [Output a]
xs
                                        -- hyperlink the entire bib item
                                        else [Text -> [Output a] -> Output a
forall a. Text -> [Output a] -> Output a
Linked Text
url [Output a]
xs] 

             let mblang :: Maybe Lang
mblang = Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"language" Reference a
ref
                          Maybe (Val a) -> (Val a -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Val a -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText
                          Maybe Text -> (Text -> Maybe Lang) -> Maybe Lang
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Maybe Lang)
-> (Lang -> Maybe Lang) -> Either String Lang -> Maybe Lang
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Lang -> String -> Maybe Lang
forall a b. a -> b -> a
const Maybe Lang
forall a. Maybe a
Nothing) Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Either String Lang -> Maybe Lang)
-> (Text -> Either String Lang) -> Text -> Maybe Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String Lang
parseLang
             [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a] -> Eval a [Output a])
-> [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
               case Maybe Lang
mblang of
                 Maybe Lang
Nothing   -> [Output a]
xs'
                 Just Lang
lang -> (Output a -> Output a) -> [Output a] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map
                     ((Output a -> Output a) -> Output a -> Output a
forall on. Uniplate on => (on -> on) -> on -> on
transform (Lang -> Output a -> Output a
forall a. Lang -> Output a -> Output a
addLangToFormatting Lang
lang)) [Output a]
xs'
    Maybe (Reference a)
Nothing -> do
      Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"citation " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ItemId -> Text
unItemId (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
             Text
" not found"
      [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ FontWeight -> a -> a
forall a. CiteprocOutput a => FontWeight -> a -> a
addFontWeight FontWeight
BoldWeight
         (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ ItemId -> Text
unItemId (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"?"]



updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap Int
citationGroupNumber Citation a
citation CitationItem a
item = do
  Bool
isNote <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleIsNoteStyle (StyleOptions -> Bool)
-> (Context a -> StyleOptions) -> Context a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
  Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap <- (EvalState a
 -> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text))
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap
  let notenum :: Val a
notenum = Int -> Val a
forall a. Int -> Val a
NumVal (Int -> Val a) -> Int -> Val a
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
citationGroupNumber (Citation a -> Maybe Int
forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation)
  -- keep track of how many citations in each note.
  -- two citations from the same note don't count as "alone"
  -- for ibid purposes. See citation-style-language/documentation#121
  case Citation a -> Maybe Int
forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation of
    Maybe Int
Nothing -> () -> Eval a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Int
n  -> (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
                   EvalState a
st{ stateNoteMap :: Map Int (Set ItemId)
stateNoteMap = (Maybe (Set ItemId) -> Maybe (Set ItemId))
-> Int -> Map Int (Set ItemId) -> Map Int (Set ItemId)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter
                        (Maybe (Set ItemId)
-> (Set ItemId -> Maybe (Set ItemId))
-> Maybe (Set ItemId)
-> Maybe (Set ItemId)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                          (Set ItemId -> Maybe (Set ItemId)
forall a. a -> Maybe a
Just (ItemId -> Set ItemId
forall a. a -> Set a
Set.singleton (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)))
                          (Set ItemId -> Maybe (Set ItemId)
forall a. a -> Maybe a
Just (Set ItemId -> Maybe (Set ItemId))
-> (Set ItemId -> Set ItemId) -> Set ItemId -> Maybe (Set ItemId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Set ItemId -> Set ItemId
forall a. Ord a => a -> Set a -> Set a
Set.insert (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)))
                        Int
n
                        (EvalState a -> Map Int (Set ItemId)
forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap EvalState a
st) }
  case ItemId
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap of
    Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
Nothing | Bool
isNote -> -- first citation
      (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
        EvalState a
st{ stateRefMap :: ReferenceMap a
stateRefMap = Map ItemId (Reference a) -> ReferenceMap a
forall a. Map ItemId (Reference a) -> ReferenceMap a
ReferenceMap (Map ItemId (Reference a) -> ReferenceMap a)
-> Map ItemId (Reference a) -> ReferenceMap a
forall a b. (a -> b) -> a -> b
$
                (Reference a -> Reference a)
-> ItemId -> Map ItemId (Reference a) -> Map ItemId (Reference a)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (\Reference a
ref -> Reference a
ref{ referenceVariables :: Map Variable (Val a)
referenceVariables =
                  Variable -> Val a -> Map Variable (Val a) -> Map Variable (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Variable
"first-reference-note-number" Val a
forall a. Val a
notenum
                             (Reference a -> Map Variable (Val a)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref)})
                  (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)
               (ReferenceMap a -> Map ItemId (Reference a)
forall a. ReferenceMap a -> Map ItemId (Reference a)
unReferenceMap (ReferenceMap a -> Map ItemId (Reference a))
-> ReferenceMap a -> Map ItemId (Reference a)
forall a b. (a -> b) -> a -> b
$ EvalState a -> ReferenceMap a
forall a. EvalState a -> ReferenceMap a
stateRefMap EvalState a
st) }
    Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
_  -> () -> Eval a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateLastCitedMap :: Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap :: Int -> Int -> Citation a -> CitationItem a -> Eval a ()
updateLastCitedMap Int
citationGroupNumber Int
positionInCitation Citation a
citation CitationItem a
item = do
  Bool -> Eval a () -> Eval a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
item CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly) (Eval a () -> Eval a ()) -> Eval a () -> Eval a ()
forall a b. (a -> b) -> a -> b
$
    (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->
      EvalState a
st{ stateLastCitedMap :: Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap =
        ItemId
-> (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item)
          (Int
citationGroupNumber, Citation a -> Maybe Int
forall a. Citation a -> Maybe Int
citationNoteNumber Citation a
citation,
           Int
positionInCitation,
           (case Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation of
              [CitationItem a
_]   -> Bool
True
              [CitationItem a
x,CitationItem a
y] -> CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
x ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
y
                      Bool -> Bool -> Bool
&& CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
x CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
                      Bool -> Bool -> Bool
&& CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
y CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
SuppressAuthor
              [CitationItem a]
_     -> Bool
False),
           CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item,
           CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item)
        (Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
 -> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text))
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap EvalState a
st }


-- | The first-occurring element tagged as Names will be
-- treated as the "author"; generally that is the author
-- but it might be the editor if it's an edited volume.
getAuthors :: Output a -> Output a
getAuthors :: Output a -> Output a
getAuthors Output a
x =
  Output a -> [Output a] -> Output a
forall a. a -> [a] -> a
headDef Output a
forall a. Output a
NullOutput [Output a
y | y :: Output a
y@(Tagged TagNames{} Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x]

removeNames :: Output a -> Output a
removeNames :: Output a -> Output a
removeNames (Tagged TagNames{} Output a
_) = Output a
forall a. Output a
NullOutput
removeNames Output a
x = Output a
x

capitalizeInitialTerm :: [Output a] -> [Output a]
capitalizeInitialTerm :: [Output a] -> [Output a]
capitalizeInitialTerm [] = []
capitalizeInitialTerm (Output a
z:[Output a]
zs) = Output a -> Output a
forall a. Output a -> Output a
go Output a
z Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
zs
 where
  go :: Output a -> Output a
go (Tagged Tag
TagTerm Output a
x) =
    Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagTerm
      (Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatTextCase :: Maybe TextCase
formatTextCase = TextCase -> Maybe TextCase
forall a. a -> Maybe a
Just TextCase
CapitalizeFirst } [Output a
x])
  go (Formatted Formatting
f [Output a]
xs) = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f ([Output a] -> [Output a]
forall a. [Output a] -> [Output a]
capitalizeInitialTerm [Output a]
xs)
  go (Tagged Tag
tg Output a
x) = Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
tg (Output a -> Output a
go Output a
x)
  go Output a
x = Output a
x

getPosition :: Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition :: Int -> Maybe Int -> CitationItem a -> Int -> Eval a [Position]
getPosition Int
groupNum Maybe Int
mbNoteNum CitationItem a
item Int
posInGroup = do
  Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap <- (EvalState a
 -> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text))
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall a.
EvalState a
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
stateLastCitedMap
  Map Int (Set ItemId)
noteMap <- (EvalState a -> Map Int (Set ItemId))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map Int (Set ItemId))
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Map Int (Set ItemId)
forall a. EvalState a -> Map Int (Set ItemId)
stateNoteMap
  case ItemId
-> Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
-> Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (CitationItem a -> ItemId
forall a. CitationItem a -> ItemId
citationItemId CitationItem a
item) Map ItemId (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
lastCitedMap of
    Maybe (Int, Maybe Int, Int, Bool, Maybe Text, Maybe Text)
Nothing -> [Position] -> Eval a [Position]
forall (m :: * -> *) a. Monad m => a -> m a
return [Position
FirstPosition]
    Just (Int
prevGroupNum, Maybe Int
mbPrevNoteNum,
           Int
prevPosInGroup, Bool
prevAloneInGroup, Maybe Text
prevLabel, Maybe Text
prevLoc) -> do
      Bool
isNote <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleIsNoteStyle (StyleOptions -> Bool)
-> (Context a -> StyleOptions) -> Context a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
      Int
nearNoteDistance <- Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
5 (Maybe Int -> Int)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Int)
-> RWST (Context a) (Set Text) (EvalState a) Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           (Context a -> Maybe Int)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Int)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Maybe Int
styleNearNoteDistance (StyleOptions -> Maybe Int)
-> (Context a -> StyleOptions) -> Context a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
      let noteNum :: Int
noteNum = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
groupNum Maybe Int
mbNoteNum
      let prevNoteNum :: Int
prevNoteNum = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
prevGroupNum Maybe Int
mbPrevNoteNum
      let prevAloneInNote :: Bool
prevAloneInNote =
            case Int -> Map Int (Set ItemId) -> Maybe (Set ItemId)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
prevNoteNum Map Int (Set ItemId)
noteMap of
              Maybe (Set ItemId)
Nothing -> Bool
True
              Just Set ItemId
s  -> Set ItemId -> Int
forall a. Set a -> Int
Set.size Set ItemId
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
      let prevAlone :: Bool
prevAlone = Bool
prevAloneInGroup Bool -> Bool -> Bool
&& Bool
prevAloneInNote
      [Position] -> Eval a [Position]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Position] -> Eval a [Position])
-> [Position] -> Eval a [Position]
forall a b. (a -> b) -> a -> b
$
        (if Bool
isNote Bool -> Bool -> Bool
&& Int
noteNum Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prevNoteNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
nearNoteDistance
            then (Position
NearNote Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
            else [Position] -> [Position]
forall a. a -> a
id) ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (if (Int
groupNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prevGroupNum Bool -> Bool -> Bool
&&
             Int
posInGroup Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prevPosInGroup Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Bool -> Bool -> Bool
||
            (Int
groupNum Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prevGroupNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Bool -> Bool -> Bool
&&
              (((-) (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
mbNoteNum Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int
mbPrevNoteNum) Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Bool -> Bool -> Bool
&&
             Int
posInGroup Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&&
             Bool
prevAlone)
             then case (Maybe Text
prevLoc, CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLocator CitationItem a
item) of
                    (Maybe Text
Nothing, Just Text
_)  -> (Position
IbidWithLocator Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:) ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
Ibid Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
                    (Maybe Text
Nothing, Maybe Text
Nothing) -> (Position
Ibid Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
                    (Just Text
_, Maybe Text
Nothing)   -> [Position] -> [Position]
forall a. a -> a
id
                    (Just Text
l1, Just Text
l2)
                      | Text
l1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
l2
                      , CitationItem a -> Maybe Text
forall a. CitationItem a -> Maybe Text
citationItemLabel CitationItem a
item Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
prevLabel -> (Position
Ibid Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
                      | Bool
otherwise -> (Position
IbidWithLocator Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:) ([Position] -> [Position])
-> ([Position] -> [Position]) -> [Position] -> [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position
Ibid Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
             else [Position] -> [Position]
forall a. a -> a
id)
        ([Position] -> [Position]) -> [Position] -> [Position]
forall a b. (a -> b) -> a -> b
$ [Position
Subsequent]

eElement :: CiteprocOutput a => Element a -> Eval a [Output a]
eElement :: Element a -> Eval a [Output a]
eElement (Element ElementType a
etype Formatting
formatting) =
  case ElementType a
etype of
    EText TextType
textType ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
formatting (TextType
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a. CiteprocOutput a => TextType -> Eval a (Output a)
eText TextType
textType)
    ENumber Variable
var NumberForm
nform ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
formatting (Variable
-> NumberForm
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Variable -> NumberForm -> Eval a (Output a)
eNumber Variable
var NumberForm
nform)
    EGroup Bool
isMacro [Element a]
els ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> Formatting
-> [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup Bool
isMacro Formatting
formatting [Element a]
els
    EChoose [(Match, [Condition], [Element a])]
chooseParts -> [(Match, [Condition], [Element a])] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
[(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [(Match, [Condition], [Element a])]
chooseParts
    ELabel Variable
var TermForm
termform Pluralize
pluralize ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Variable
-> TermForm
-> Pluralize
-> Formatting
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
formatting
    EDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Variable
-> DateType
-> Maybe ShowDateParts
-> [DP]
-> Formatting
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
Variable
-> DateType
-> Maybe ShowDateParts
-> [DP]
-> Formatting
-> Eval a (Output a)
eDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps Formatting
formatting
    ENames [Variable]
vars NamesFormat
namesFormat [Element a]
subst ->
      (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Variable]
-> NamesFormat
-> [Element a]
-> Formatting
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
[Variable]
-> NamesFormat -> [Element a] -> Formatting -> Eval a (Output a)
eNames [Variable]
vars NamesFormat
namesFormat [Element a]
subst Formatting
formatting

withFormatting :: CiteprocOutput a
               => Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting :: Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting (Formatting Maybe Lang
Nothing Maybe FontStyle
Nothing Maybe FontVariant
Nothing Maybe FontWeight
Nothing Maybe TextDecoration
Nothing Maybe VerticalAlign
Nothing
                           Maybe Text
Nothing Maybe Text
Nothing Maybe DisplayStyle
Nothing Maybe TextCase
Nothing Maybe Text
Nothing
                           Bool
False Bool
False Bool
False) Eval a (Output a)
p
                          = Eval a (Output a)
p
withFormatting Formatting
formatting Eval a (Output a)
p = do
  -- Title case conversion only affects English-language items.
  Maybe Lang
lang <- (Context a -> Maybe Lang)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Lang)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage (Locale -> Maybe Lang)
-> (Context a -> Locale) -> Context a -> Maybe Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
  Reference a
ref <- (EvalState a -> Reference a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Reference a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference
  let reflang :: Maybe Lang
reflang = case Variable -> Map Variable (Val a) -> Maybe (Val a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"language" (Reference a -> Map Variable (Val a)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref) of
                  Just (TextVal Text
t)  ->
                    (String -> Maybe Lang)
-> (Lang -> Maybe Lang) -> Either String Lang -> Maybe Lang
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Lang -> String -> Maybe Lang
forall a b. a -> b -> a
const Maybe Lang
forall a. Maybe a
Nothing) Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Either String Lang -> Maybe Lang)
-> Either String Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Either String Lang
parseLang Text
t
                  Just (FancyVal a
x) ->
                    (String -> Maybe Lang)
-> (Lang -> Maybe Lang) -> Either String Lang -> Maybe Lang
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Lang -> String -> Maybe Lang
forall a b. a -> b -> a
const Maybe Lang
forall a. Maybe a
Nothing) Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Either String Lang -> Maybe Lang)
-> Either String Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Text -> Either String Lang
parseLang (Text -> Either String Lang) -> Text -> Either String Lang
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x
                  Maybe (Val a)
_                 -> Maybe Lang
forall a. Maybe a
Nothing
  let mainLangIsEn :: Maybe Lang -> Bool
mainLangIsEn Maybe Lang
Nothing = Bool
False
      mainLangIsEn (Just Lang
l) = Lang -> Text
langLanguage Lang
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"en"
  let isEnglish :: Bool
isEnglish = case Maybe Lang
reflang of
                    Just Lang
l  -> Maybe Lang -> Bool
mainLangIsEn (Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
l)
                    Maybe Lang
Nothing -> Maybe Lang -> Bool
mainLangIsEn Maybe Lang
lang
  let formatting' :: Formatting
formatting' = if Formatting -> Maybe TextCase
formatTextCase Formatting
formatting Maybe TextCase -> Maybe TextCase -> Bool
forall a. Eq a => a -> a -> Bool
== TextCase -> Maybe TextCase
forall a. a -> Maybe a
Just TextCase
TitleCase Bool -> Bool -> Bool
&&
                       Bool -> Bool
not Bool
isEnglish
                       then Formatting
formatting{ formatTextCase :: Maybe TextCase
formatTextCase = Maybe TextCase
forall a. Maybe a
Nothing }
                       else Formatting
formatting
  Output a
res <- Eval a (Output a)
p
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting' [Output a
res]

lookupTerm :: Term -> Eval a [(Term, Text)]
lookupTerm :: Term -> Eval a [(Term, Text)]
lookupTerm Term
term = do
  Map Text [(Term, Text)]
terms <- (Context a -> Map Text [(Term, Text)])
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map Text [(Term, Text)])
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Map Text [(Term, Text)]
localeTerms (Locale -> Map Text [(Term, Text)])
-> (Context a -> Locale) -> Context a -> Map Text [(Term, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
  case Text -> Map Text [(Term, Text)] -> Maybe [(Term, Text)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Term -> Text
termName Term
term) Map Text [(Term, Text)]
terms of
     Just [(Term, Text)]
ts -> [(Term, Text)] -> Eval a [(Term, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Term, Text)] -> Eval a [(Term, Text)])
-> [(Term, Text)] -> Eval a [(Term, Text)]
forall a b. (a -> b) -> a -> b
$ [(Term
term',Text
t)
                         | (Term
term',Text
t) <- [(Term, Text)]
ts
                         , Term
term Term -> Term -> Bool
forall a. Ord a => a -> a -> Bool
<= Term
term'
                         ]
     Maybe [(Term, Text)]
Nothing -> [(Term, Text)] -> Eval a [(Term, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return []

lookupTerm' :: CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' :: Term -> Eval a (Output a)
lookupTerm' Term
term = Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
term Eval a [(Term, Text)]
-> ([(Term, Text)] -> Eval a (Output a)) -> Eval a (Output a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Term, Text)] -> Eval a (Output a)
forall a a. CiteprocOutput a => [(a, Text)] -> Eval a (Output a)
f
 where
   f :: [(a, Text)] -> Eval a (Output a)
f []  =
     --  “verb-short” first falls back to “verb”, “symbol”
     --  first falls back to “short”, and “verb” and “short”
     --  both fall back to “long”.
     case Term -> TermForm
termForm Term
term of
       TermForm
VerbShort -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Verb }
       TermForm
Symbol    -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Short }
       TermForm
Verb      -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
       TermForm
Short     -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
       TermForm
_         -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
   f [(a, Text)]
xs  = case [(a, Text)]
xs of
             []        -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
             ((a
_,Text
t):[(a, Text)]
_) -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                            if Text -> Bool
T.null Text
t
                               then Output a
forall a. Output a
NullOutput
                               else a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t

pageRange :: CiteprocOutput a => Text -> Eval a (Output a)
pageRange :: Text -> Eval a (Output a)
pageRange Text
x = do
  Output a
pageDelim <- Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm'
                  Term
emptyTerm{ termName :: Text
termName = Text
"page-range-delimiter" }
  Maybe PageRangeFormat
mbPageRangeFormat <- (Context a -> Maybe PageRangeFormat)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe PageRangeFormat)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Maybe PageRangeFormat
stylePageRangeFormat (StyleOptions -> Maybe PageRangeFormat)
-> (Context a -> StyleOptions)
-> Context a
-> Maybe PageRangeFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
  let ranges :: [Text]
ranges = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy
               (\Char
c Char
d -> Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&'))
               Text
x
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
" " }
         ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$ (Text -> Output a) -> [Text] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe PageRangeFormat -> Output a -> Text -> Output a
forall a.
CiteprocOutput a =>
Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange Maybe PageRangeFormat
mbPageRangeFormat
            (case Output a
pageDelim of
               Output a
NullOutput -> Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal (Text -> Output a) -> Text -> Output a
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash
               Output a
delim      -> Output a
delim)) [Text]
ranges

enDash :: Char
enDash :: Char
enDash = Char
'\x2013'

formatPageRange :: CiteprocOutput a
                => Maybe PageRangeFormat
                -> Output a
                -> Text
                -> Output a
formatPageRange :: Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange Maybe PageRangeFormat
_ Output a
_ Text
"&" = Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
"&"
formatPageRange Maybe PageRangeFormat
_ Output a
_ Text
"," = Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
","
formatPageRange Maybe PageRangeFormat
mbPageRangeFormat Output a
delim Text
t =
  let isDash :: Char -> Bool
isDash Char
'-' = Bool
True
      isDash Char
'\x2013' = Bool
True
      isDash Char
_ = Bool
False
      rangeParts :: [Text]
rangeParts = if Text
"\\-" Text -> Text -> Bool
`T.isInfixOf` Text
t
                      then [Text -> Text -> Text -> Text
T.replace Text
"\\-" Text
"-" Text
t]
                      else (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.strip ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isDash Text
t
      inRange :: Text -> [Text] -> Output a
inRange Text
pref [Text]
xs
        | Text -> Bool
T.null Text
pref = [Output a] -> Output a
forall a. [Output a] -> Output a
grouped (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
intersperse Output a
delim ((Text -> Output a) -> [Text] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal [Text]
xs))
        | Bool
otherwise = [Output a] -> Output a
forall a. [Output a] -> Output a
grouped
            (Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
pref Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
intersperse Output a
delim ((Text -> Output a) -> [Text] -> [Output a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal [Text]
xs))
      changedDigits :: String -> String -> Int
changedDigits String
xs String
ys =
        [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
not ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> String -> String -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ') String
ys
      minimal :: Int -> Text -> Text -> Text -> Output a
minimal Int
threshold Text
pref Text
x Text
y =
        case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
y of
             Just (Text
_comm, Text
_erstx, Text
resty) ->
                 if Text -> Int
T.length Text
resty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
threshold Bool -> Bool -> Bool
&& Text -> Int
T.length Text
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
threshold
                    then Text -> [Text] -> Output a
inRange Text
pref [Text
x, Int -> Text -> Text
T.takeEnd Int
threshold Text
y]
                    else Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
resty]
             Maybe (Text, Text, Text)
Nothing -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y]
   in case [Text]
rangeParts of
        []     -> Output a
forall a. Output a
NullOutput
        [Text
w]    -> Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
w
        [Text
w,Text
v]
          | Maybe PageRangeFormat
Nothing <- Maybe PageRangeFormat
mbPageRangeFormat -> Text -> [Text] -> Output a
inRange Text
forall a. Monoid a => a
mempty [Text
w,Text
v]
          | Just PageRangeFormat
fmt <- Maybe PageRangeFormat
mbPageRangeFormat -> do
            let wPrefix :: Text
wPrefix = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isDigit Text
w
            let vPrefix :: Text
vPrefix = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isDigit Text
v
            if Text
wPrefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
vPrefix
               then do
                 let pref :: Text
pref = Text
wPrefix
                 let x :: Text
x = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
wPrefix) Text
w
                 let y :: Text
y = Int -> Text -> Text
T.drop (Text -> Int
T.length Text
vPrefix) Text
v
                 let xlen :: Int
xlen = Text -> Int
T.length Text
x
                 let ylen :: Int
ylen = Text -> Int
T.length Text
y
                 let y' :: Text
y'   = if Int
ylen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
xlen
                               then Int -> Text -> Text
T.take (Int
xlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ylen) Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y
                               else Text
y
                 case PageRangeFormat
fmt of
                   PageRangeFormat
PageRangeChicago
                       | Int
xlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3  -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Text
"00" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Int -> Text -> Text
T.take Int
1 (Int -> Text -> Text
T.takeEnd Int
2 Text
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"0"
                         -> Int -> Text -> Text -> Text -> Output a
minimal Int
1 Text
pref Text
x Text
y'
                       | Int
xlen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
                       , String -> String -> Int
changedDigits (Text -> String
T.unpack Text
x) (Text -> String
T.unpack Text
y') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
                         -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
                       | Bool
otherwise -> Int -> Text -> Text -> Text -> Output a
minimal Int
2 Text
pref Text
x Text
y'
                   PageRangeFormat
PageRangeExpanded ->
                       Text -> [Text] -> Output a
inRange Text
forall a. Monoid a => a
mempty [Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x, Text
pref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y']
                   PageRangeFormat
PageRangeMinimal -> Int -> Text -> Text -> Text -> Output a
minimal Int
1 Text
pref Text
x Text
y'
                   PageRangeFormat
PageRangeMinimalTwo -> Int -> Text -> Text -> Text -> Output a
minimal Int
2 Text
pref Text
x Text
y'
               else Text -> [Text] -> Output a
inRange Text
forall a. Monoid a => a
mempty [Text
w,Text
v]
        [Text]
_ -> Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
t

eText :: CiteprocOutput a => TextType -> Eval a (Output a)
eText :: TextType -> Eval a (Output a)
eText (TextVariable VariableForm
varForm Variable
v) = do
  Reference a
ref <- (EvalState a -> Reference a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Reference a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference
  -- Note: we do book keeping on how many variables
  -- have been accessed and how many are nonempty,
  -- in order to properly handle the group element,
  -- which is implicitly conditional.
  case Variable
v of
    Variable
"id"   -> do
      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ ItemId -> Text
coerce (ItemId -> Text) -> ItemId -> Text
forall a b. (a -> b) -> a -> b
$ Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId Reference a
ref
    Variable
"type" -> do
      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText  (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Reference a -> Text
forall a. Reference a -> Text
referenceType Reference a
ref
    Variable
"locator" -> do
        let handleAmpersands :: Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
handleAmpersands (Just Text
t) | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'&') Text
t = do
              [(Term, Text)]
ts <- Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                         , termForm :: TermForm
termForm = TermForm
Symbol }
              case [(Term, Text)]
ts of
                (Term
_,Text
x):[(Term, Text)]
_ -> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"&" Text
x Text
t)
                []      -> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
            handleAmpersands Maybe Text
x = Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
x

        Maybe Text
mbv <- (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLocator RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
-> (Maybe Text
    -> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text))
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall a.
Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
handleAmpersands
        Maybe Text
mbl <- (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLabel
        case Maybe Text
mbv of
          Just Text
x | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
mbl Bool -> Bool -> Bool
|| Maybe Text
mbl Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"page" -> do
                      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
                      Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagLocator (Output a -> Output a) -> Eval a (Output a) -> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange Text
x
                 | Bool
otherwise -> do
                      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
                      Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagLocator (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
                                Maybe PageRangeFormat -> Output a -> Text -> Output a
forall a.
CiteprocOutput a =>
Maybe PageRangeFormat -> Output a -> Text -> Output a
formatPageRange Maybe PageRangeFormat
forall a. Maybe a
Nothing
                                (Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal (Text -> Output a) -> Text -> Output a
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
enDash) Text
x
          Maybe Text
Nothing -> Output a
forall a. Output a
NullOutput Output a -> Eval a () -> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
0

    Variable
"year-suffix" -> do
        Maybe DisambiguationData
disamb <- (EvalState a -> Maybe DisambiguationData)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe DisambiguationData)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation (Reference a -> Maybe DisambiguationData)
-> (EvalState a -> Reference a)
-> EvalState a
-> Maybe DisambiguationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference)
        case Maybe DisambiguationData
disamb Maybe DisambiguationData
-> (DisambiguationData -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambYearSuffix of
          Just Int
x ->
            -- we don't update var count here; this doesn't
            -- count as a variable
            Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagYearSuffix Int
x)
                            (a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Int -> Text
showYearSuffix Int
x)))
          Maybe Int
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput

    Variable
"citation-number" -> do
        Maybe (Val a)
mbv <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        case Maybe (Val a)
mbv of
          Just (NumVal Int
x)  -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                              Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagCitationNumber Int
x) (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
                              a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
x))
          Maybe (Val a)
_ -> do
            Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"citation-number not defined for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      ItemId -> Text
coerce (Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId Reference a
ref)
            Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput

    Variable
"citation-label" -> do  -- these need year suffix too
        Maybe (Val a)
mbv <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        Maybe (Output a)
mbsuff <- Eval a (Maybe (Output a))
forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
        case Maybe (Val a)
mbv of
          Just (TextVal Text
t)  -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                                Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagCitationLabel (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
                                  [Output a] -> Output a
forall a. [Output a] -> Output a
grouped ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
                                  a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t)
                                  Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: Maybe (Output a) -> [Output a]
forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
mbsuff
          Just (FancyVal a
x) -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                                 Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagCitationLabel (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
                                  [Output a] -> Output a
forall a. [Output a] -> Output a
grouped ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
                                  a -> Output a
forall a. a -> Output a
Literal a
x
                                  Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: Maybe (Output a) -> [Output a]
forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
mbsuff
          Maybe (Val a)
_ -> do
            Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"citation-label of unknown type for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                      ItemId -> Text
coerce (Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId Reference a
ref)
            Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput

    Variable
"DOI"   -> (Text -> Text) -> (Text -> Identifier) -> Eval a (Output a)
forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
fixShortDOI Text -> Identifier
IdentDOI
    Variable
"PMCID" -> (Text -> Text) -> (Text -> Identifier) -> Eval a (Output a)
forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
forall a. a -> a
id Text -> Identifier
IdentPMCID
    Variable
"PMID"  -> (Text -> Text) -> (Text -> Identifier) -> Eval a (Output a)
forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
forall a. a -> a
id Text -> Identifier
IdentPMID
    Variable
"URL"   -> (Text -> Text) -> (Text -> Identifier) -> Eval a (Output a)
forall b.
CiteprocOutput b =>
(Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
forall a. a -> a
id Text -> Identifier
IdentURL

    Variable
_ -> do
        Maybe (Val a)
mbv <- if VariableForm
varForm VariableForm -> VariableForm -> Bool
forall a. Eq a => a -> a -> Bool
== VariableForm
ShortForm
                  then do
                    Maybe (Val a)
mbval <- Maybe (Val a) -> Maybe (Val a) -> Maybe (Val a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe (Val a) -> Maybe (Val a) -> Maybe (Val a))
-> Eval a (Maybe (Val a))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe (Val a) -> Maybe (Val a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable (Variable
v Variable -> Variable -> Variable
forall a. Semigroup a => a -> a -> a
<> Variable
"-short")
                                   RWST
  (Context a)
  (Set Text)
  (EvalState a)
  Identity
  (Maybe (Val a) -> Maybe (Val a))
-> Eval a (Maybe (Val a)) -> Eval a (Maybe (Val a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
                    case Maybe (Val a)
mbval of
                      Maybe (Val a)
Nothing -> Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Val a)
forall a. Maybe a
Nothing
                      Just Val a
val -> do
                        Maybe Abbreviations
mbAbbrevs <- (Context a -> Maybe Abbreviations)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe Abbreviations)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Abbreviations
forall a. Context a -> Maybe Abbreviations
contextAbbreviations
                        Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Val a) -> Eval a (Maybe (Val a)))
-> Maybe (Val a) -> Eval a (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Val a -> Maybe (Val a)) -> Val a -> Maybe (Val a)
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a) -> Val a
forall a. a -> Maybe a -> a
fromMaybe Val a
val
                               (Maybe (Val a) -> Val a) -> Maybe (Val a) -> Val a
forall a b. (a -> b) -> a -> b
$ Maybe Abbreviations
mbAbbrevs Maybe Abbreviations
-> (Abbreviations -> Maybe (Val a)) -> Maybe (Val a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Variable -> Val a -> Abbreviations -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Val a -> Abbreviations -> Maybe (Val a)
lookupAbbreviation Variable
v Val a
val
                  else Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        Output a
res <- case Maybe (Val a)
mbv of
                 Just (TextVal Text
x)
                   | Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"page" -> Text -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange Text
x
                   | Bool
otherwise   -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
x
                 Just (FancyVal a
x)
                   | Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"page" -> Text -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Eval a (Output a)
pageRange (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x)
                   | Bool
otherwise   -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal a
x
                 Just (NumVal Int
x) -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal
                                           (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
x))
                 Maybe (Val a)
_ -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
        Eval a ()
forall a. Eval a ()
handleSubst
        if Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"title" Bool -> Bool -> Bool
&& Output a
res Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
/= Output a
forall a. Output a
NullOutput
            then do
              (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify (\EvalState a
st -> EvalState a
st { stateUsedTitle :: Bool
stateUsedTitle = Bool
True })
              -- tag title so we can hyperlink it later
              Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagTitle Output a
res
            else Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
res
    where
      handleIdent :: CiteprocOutput b => (Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
      handleIdent :: (Text -> Text) -> (Text -> Identifier) -> Eval b (Output b)
handleIdent Text -> Text
f Text -> Identifier
identConstr = do
        Maybe (Val b)
mbv <- Variable -> Eval b (Maybe (Val b))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
v
        Eval b ()
forall a. Eval a ()
handleSubst
        case Text -> Text
f (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val b -> Maybe Text
forall a. CiteprocOutput a => Val a -> Maybe Text
valToText (Val b -> Maybe Text) -> Maybe (Val b) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Val b)
mbv) of
          Maybe Text
Nothing -> Output b -> Eval b (Output b)
forall (m :: * -> *) a. Monad m => a -> m a
return Output b
forall a. Output a
NullOutput
          Just Text
t  -> do
            -- create link and remember that we've done so far
            (EvalState b -> EvalState b) -> Eval b ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify (\EvalState b
st -> EvalState b
st { stateUsedIdentifier :: Bool
stateUsedIdentifier = Bool
True })
            let url :: Text
url = Identifier -> Text
identifierToURL (Text -> Identifier
identConstr Text
t)
            Output b -> Eval b (Output b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output b -> Eval b (Output b)) -> Output b -> Eval b (Output b)
forall a b. (a -> b) -> a -> b
$ Text -> [Output b] -> Output b
forall a. Text -> [Output a] -> Output a
Linked Text
url [b -> Output b
forall a. a -> Output a
Literal (b -> Output b) -> b -> Output b
forall a b. (a -> b) -> a -> b
$ Text -> b
forall a. CiteprocOutput a => Text -> a
fromText Text
t]
      handleSubst :: Eval a ()
      handleSubst :: Eval a ()
handleSubst = do Bool
inSubst <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInSubstitute 
                       Bool -> Eval a () -> Eval a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inSubst (Eval a () -> Eval a ()) -> Eval a () -> Eval a ()
forall a b. (a -> b) -> a -> b
$
                         (EvalState a -> EvalState a) -> Eval a ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a) -> Eval a ())
-> (EvalState a -> EvalState a) -> Eval a ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st -> -- delete variable so it isn't used again...
                           EvalState a
st{ stateReference :: Reference a
stateReference =
                                 let Reference ItemId
id' Text
type' Maybe DisambiguationData
d' Map Variable (Val a)
m' = EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference EvalState a
st
                                  in ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
id' Text
type' Maybe DisambiguationData
d' (Variable -> Map Variable (Val a) -> Map Variable (Val a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Variable
v Map Variable (Val a)
m') }
eText (TextMacro Text
name) = do
  Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"encountered unexpanded macro " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
eText (TextValue Text
t) = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t
eText (TextTerm Term
term) = do
  Output a
t' <- Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term
  Output a
t'' <- if Term -> Text
termName Term
term Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"no date"
            then do
              Maybe (Output a)
mbsuff <- Eval a (Maybe (Output a))
forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
              case Maybe (Output a)
mbsuff of
                Maybe (Output a)
Nothing  -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
t'
                Just Output a
suff
                  | Term -> TermForm
termForm Term
term TermForm -> TermForm -> Bool
forall a. Eq a => a -> a -> Bool
== TermForm
Long
                    -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ [Output a] -> Output a
forall a. [Output a] -> Output a
grouped [Output a
t', a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
" "), Output a
suff]
                  | Bool
otherwise -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ [Output a] -> Output a
forall a. [Output a] -> Output a
grouped [Output a
t', Output a
suff]
            else Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
t'
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagTerm Output a
t''


-- Numbers with prefixes or suffixes are never ordinalized
-- or rendered in roman numerals (e.g. “2E” remains “2E).
-- Numbers without affixes are individually transformed
-- (“2, 3” can become “2nd, 3rd”, “second, third” or “ii, iii”).
-- So, first we split on punctuation and spaces:
splitNums :: Text -> [Val a]
splitNums :: Text -> [Val a]
splitNums = (Text -> Val a) -> [Text] -> [Val a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Val a
forall a. Text -> Val a
go ([Text] -> [Val a]) -> (Text -> [Text]) -> Text -> [Val a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy Char -> Char -> Bool
sameClass
 where
  go :: Text -> Val a
go Text
t = case Text -> Maybe Int
readAsInt Text
t of
           Just Int
i  -> Int -> Val a
forall a. Int -> Val a
NumVal Int
i
           Maybe Int
Nothing -> Text -> Val a
forall a. Text -> Val a
TextVal (Text -> Val a) -> Text -> Val a
forall a b. (a -> b) -> a -> b
$ if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"-"
                                   then Char -> Text
T.singleton Char
enDash
                                   else Text
t
  sameClass :: Char -> Char -> Bool
sameClass Char
c Char
d = (Char -> Bool
isSepPunct Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==
                  (Char -> Bool
isSepPunct Char
d Bool -> Bool -> Bool
|| Char -> Bool
isSpace Char
d)

--- punctuation that separates pages in a range
isSepPunct :: Char -> Bool
isSepPunct :: Char -> Bool
isSepPunct Char
',' = Bool
True
isSepPunct Char
';' = Bool
True
isSepPunct Char
'-' = Bool
True
isSepPunct Char
'\x2013' = Bool
True
isSepPunct Char
_   = Bool
False

eLabel :: CiteprocOutput a
       => Variable
       -> TermForm
       -> Pluralize
       -> Formatting
       -> Eval a (Output a)
eLabel :: Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
formatting = do
  Reference a
ref <- (EvalState a -> Reference a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Reference a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference
  let getTerm :: CiteprocOutput a
              => Text -> Val a -> Eval a (Output a)
      getTerm :: Text -> Val a -> Eval a (Output a)
getTerm Text
termname Val a
x = do
        let determinePlural :: Text -> TermNumber
determinePlural Text
t
             | Variable
var Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"number-of-volumes"
             , Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"1" Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"0"      = TermNumber
Plural
             | Text
"\\-" Text -> Text -> Bool
`T.isInfixOf` Text
t     = TermNumber
Singular
             | [Val Any] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Val Any]
forall a. Text -> [Val a]
splitNums Text
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1  = TermNumber
Plural
               -- see label_CollapsedPageNumberPluralDetection.txt
             | Bool
otherwise                 = TermNumber
Singular
        let number :: TermNumber
number = case Pluralize
pluralize of
                         Pluralize
AlwaysPluralize     -> TermNumber
Plural
                         Pluralize
NeverPluralize      -> TermNumber
Singular
                         Pluralize
ContextualPluralize ->
                          case Val a
x of
                            TextVal Text
t   -> Text -> TermNumber
determinePlural Text
t
                            FancyVal a
w  -> Text -> TermNumber
determinePlural (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
w)
                            NamesVal [Name]
ns -> if [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                              then TermNumber
Plural
                                              else TermNumber
Singular
                            Val a
_ -> TermNumber
Singular
        let term :: Term
term = Term
emptyTerm{ termName :: Text
termName = Text
termname
                            , termForm :: TermForm
termForm = TermForm
termform
                            , termNumber :: Maybe TermNumber
termNumber = TermNumber -> Maybe TermNumber
forall a. a -> Maybe a
Just TermNumber
number }
        Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term
  Maybe Text
locator <- (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLocator
  Maybe Text
label <- (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLabel
  let var' :: Variable
var' = if Variable
var Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"editortranslator" then Variable
"editor" else Variable
var
  Output a
term' <- case (Variable
var, Maybe Text
locator, Maybe Text
label) of
             (Variable
"locator", Just Text
loc, Just Text
lab) -> Text -> Val a -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
lab (Text -> Val a
forall a. Text -> Val a
TextVal Text
loc)
             (Variable
"locator", Just Text
loc, Maybe Text
Nothing)
                | Text -> Bool
beginsWithSpace Text
loc -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
                | Text
". " Text -> Text -> Bool
`T.isPrefixOf` (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isLetter Text
loc
                                         -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
                | Bool
otherwise              -> Text -> Val a -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
"page" (Text -> Val a
forall a. Text -> Val a
TextVal Text
loc)
             (Variable
"page", Just Text
loc, Maybe Text
_) ->
               Text -> Val a -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm Text
"page" (Text -> Val a
forall a. Text -> Val a
TextVal Text
loc)
             (Variable, Maybe Text, Maybe Text)
_ -> case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
var' Reference a
ref of
                         Maybe (Val a)
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
                         Just Val a
x  -> Text -> Val a -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm (Variable -> Text
fromVariable Variable
var) Val a
x

  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
    case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
      Just Text
suff
        | Text
"." Text -> Text -> Bool
`T.isPrefixOf` Text
suff
          -> case Output a
term' of
               Literal a
x
                 | Text
"." Text -> Text -> Bool
`T.isSuffixOf` a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x
                 , Bool -> Bool
not (Formatting -> Bool
formatStripPeriods Formatting
formatting)
                 -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
                     Formatting
formatting{ formatSuffix :: Maybe Text
formatSuffix =
                        if Text -> Int
T.length Text
suff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                           then Maybe Text
forall a. Maybe a
Nothing
                           else Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop Int
1 Text
suff) }
                     [Output a
term']
               Output a
_ -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a
term']
      Maybe Text
_ -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a
term']

eDate :: CiteprocOutput a
       => Variable
       -> DateType
       -> Maybe ShowDateParts
       -> [DP]
       -> Formatting
       -> Eval a (Output a)
eDate :: Variable
-> DateType
-> Maybe ShowDateParts
-> [DP]
-> Formatting
-> Eval a (Output a)
eDate Variable
var DateType
dateType Maybe ShowDateParts
mbShowDateParts [DP]
dps Formatting
formatting
  | Variable
var Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
forall a. Monoid a => a
mempty = do
    Text -> Eval a ()
forall a. Text -> Eval a ()
warn Text
"skipping date element with no variable attribute set"
    Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
  | Bool
otherwise = do
    Maybe (Val a)
datevar <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
var
    Maybe (Element Text)
localeDateElt <- DateType -> Map DateType (Element Text) -> Maybe (Element Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup DateType
dateType (Map DateType (Element Text) -> Maybe (Element Text))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map DateType (Element Text))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe (Element Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Context a -> Map DateType (Element Text))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Map DateType (Element Text))
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Map DateType (Element Text)
localeDate (Locale -> Map DateType (Element Text))
-> (Context a -> Locale)
-> Context a
-> Map DateType (Element Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
    let addOverride :: t DP -> DP -> [DP] -> [DP]
addOverride t DP
newdps DP
olddp [DP]
accum =
          case (DP -> Bool) -> t DP -> Maybe DP
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DP -> DPName
dpName DP
olddp) (DPName -> Bool) -> (DP -> DPName) -> DP -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DP -> DPName
dpName) t DP
newdps of
            Just DP
x  -> DP
x{ dpFormatting :: Formatting
dpFormatting =
                            DP -> Formatting
dpFormatting DP
olddp Formatting -> Formatting -> Formatting
forall a. Semigroup a => a -> a -> a
<> DP -> Formatting
dpFormatting DP
x } DP -> [DP] -> [DP]
forall a. a -> [a] -> [a]
: [DP]
accum
            Maybe DP
Nothing -> DP
olddp DP -> [DP] -> [DP]
forall a. a -> [a] -> [a]
: [DP]
accum
    let useDatePart :: DP -> Bool
useDatePart DP
dp =
          case Maybe ShowDateParts
mbShowDateParts of
            Just ShowDateParts
Year      -> DP -> DPName
dpName DP
dp DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DPName
DPYear
            Just ShowDateParts
YearMonth -> DP -> DPName
dpName DP
dp DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DPName
DPYear Bool -> Bool -> Bool
|| DP -> DPName
dpName DP
dp DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DPName
DPMonth
            Maybe ShowDateParts
_              -> Bool
True
    let ([DP]
dps', Formatting
formatting') =
          case Maybe (Element Text)
localeDateElt of
            Just (Element (EDate Variable
_ DateType
_ Maybe ShowDateParts
_ [DP]
edps) Formatting
f)
              -> ((DP -> Bool) -> [DP] -> [DP]
forall a. (a -> Bool) -> [a] -> [a]
filter DP -> Bool
useDatePart ([DP] -> [DP]) -> [DP] -> [DP]
forall a b. (a -> b) -> a -> b
$ (DP -> [DP] -> [DP]) -> [DP] -> [DP] -> [DP]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([DP] -> DP -> [DP] -> [DP]
forall (t :: * -> *). Foldable t => t DP -> DP -> [DP] -> [DP]
addOverride [DP]
dps) [] [DP]
edps,
                   Formatting
formatting Formatting -> Formatting -> Formatting
forall a. Semigroup a => a -> a -> a
<> Formatting
f)
            Maybe (Element Text)
_ -> ((DP -> Bool) -> [DP] -> [DP]
forall a. (a -> Bool) -> [a] -> [a]
filter DP -> Bool
useDatePart [DP]
dps, Formatting
formatting)
    case Maybe (Val a)
datevar of
      Maybe (Val a)
Nothing ->
        -- warn $ "date element for empty variable " <> var
        Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
      Just (DateVal Date
date) ->
        case Date -> Maybe Text
dateLiteral Date
date of
          Just Text
t -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting' [a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t]
          Maybe Text
Nothing -> do
            let dateparts :: [DateParts]
dateparts = case Date -> Maybe Int
dateSeason Date
date of
                              Just Int
i  ->
                                case Date -> [DateParts]
dateParts Date
date of
                                  [DateParts [Int
y]] ->
                                    [[Int] -> DateParts
DateParts [Int
y, Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i]] -- pseudo-mo
                                  [DateParts]
xs    -> [DateParts]
xs
                              Maybe Int
Nothing -> Date -> [DateParts]
dateParts Date
date
            [Output a]
xs <- [DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
forall a.
CiteprocOutput a =>
[DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts [DP]
dps'
                    ((DateParts, Maybe DateParts) -> Eval a [Output a])
-> (DateParts, Maybe DateParts) -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$ case [DateParts]
dateparts of
                        [] -> ([Int] -> DateParts
DateParts [], Maybe DateParts
forall a. Maybe a
Nothing)
                        [DateParts
d] -> (DateParts
d, Maybe DateParts
forall a. Maybe a
Nothing)
                        (DateParts
d:DateParts
e:[DateParts]
_) -> (DateParts
d, DateParts -> Maybe DateParts
forall a. a -> Maybe a
Just DateParts
e)
            Bool -> Eval a () -> Eval a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Output a -> Bool) -> [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
forall a. Output a
NullOutput) [Output a]
xs) (Eval a () -> Eval a ()) -> Eval a () -> Eval a ()
forall a b. (a -> b) -> a -> b
$
              -- back off on the claim to nonemptiness
              -- when the only match are in date parts that
              -- we aren't printing; see
              -- group_SuppressTermWhenNoOutputFromPartialDate.txt
              Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
0 (-Int
1)

            Maybe (Output a)
yearSuffix <- Eval a (Maybe (Output a))
forall a. CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix
            Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Date -> Tag
TagDate Date
date) (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting'
                      ([Output a]
xs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ Maybe (Output a) -> [Output a]
forall a. Maybe a -> [a]
maybeToList Maybe (Output a)
yearSuffix)
      Just Val a
_ -> do
        Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"date element for variable with non-date value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Variable -> Text
fromVariable Variable
var
        Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput


getYearSuffix :: CiteprocOutput a => Eval a (Maybe (Output a))
getYearSuffix :: Eval a (Maybe (Output a))
getYearSuffix = do
  Maybe DisambiguationData
disamb <- (EvalState a -> Maybe DisambiguationData)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe DisambiguationData)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation (Reference a -> Maybe DisambiguationData)
-> (EvalState a -> Reference a)
-> EvalState a
-> Maybe DisambiguationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference)
  StyleOptions
sopts <- (Context a -> StyleOptions)
-> RWST (Context a) (Set Text) (EvalState a) Identity StyleOptions
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions
  -- we only want year suffix on first occurence of year
  -- in a reference:
  Bool
usedYearSuffix <- (EvalState a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Bool
forall a. EvalState a -> Bool
stateUsedYearSuffix
  case Maybe DisambiguationData
disamb Maybe DisambiguationData
-> (DisambiguationData -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambYearSuffix of
    Just Int
c
      | Bool -> Bool
not (StyleOptions -> Bool
styleUsesYearSuffixVariable StyleOptions
sopts)
      , Bool -> Bool
not Bool
usedYearSuffix
      -> do
        (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st -> EvalState a
st{ stateUsedYearSuffix :: Bool
stateUsedYearSuffix = Bool
True }
        Maybe (Output a) -> Eval a (Maybe (Output a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Output a) -> Eval a (Maybe (Output a)))
-> Maybe (Output a) -> Eval a (Maybe (Output a))
forall a b. (a -> b) -> a -> b
$ Output a -> Maybe (Output a)
forall a. a -> Maybe a
Just (Output a -> Maybe (Output a)) -> Output a -> Maybe (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Int -> Tag
TagYearSuffix Int
c)
                         (a -> Output a
forall a. a -> Output a
Literal (Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Int -> Text
showYearSuffix Int
c)))
      | Bool
otherwise -> Maybe (Output a) -> Eval a (Maybe (Output a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Output a)
forall a. Maybe a
Nothing
    Maybe Int
Nothing  -> Maybe (Output a) -> Eval a (Maybe (Output a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Output a)
forall a. Maybe a
Nothing



formatDateParts :: CiteprocOutput a
          => [DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts :: [DP] -> (DateParts, Maybe DateParts) -> Eval a [Output a]
formatDateParts [DP]
dpSpecs (DateParts
date, Maybe DateParts
mbNextDate) = do
  let (Maybe Int
yr,Maybe Int
mo,Maybe Int
da) = DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
date
  case Maybe DateParts
mbNextDate of
    Maybe DateParts
Nothing -> (DP
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [DP] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe Int, Maybe Int, Maybe Int)
-> DP
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
dpSpecs
    Just DateParts
nextDate -> do
      let (Maybe Int
nextyr,Maybe Int
nextmo,Maybe Int
nextda) = DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
nextDate
      let isOpenRange :: Bool
isOpenRange = Maybe Int
nextyr Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 Bool -> Bool -> Bool
&&
                        Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nextmo Bool -> Bool -> Bool
&&
                        Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
nextda
      -- figure out where the range goes:
      -- first to differ out of the items selected by dpSpecs, in order y->m->d
      let dpToNs :: DPName -> (Maybe Int, Maybe Int)
dpToNs DPName
DPYear  = (Maybe Int
yr, Maybe Int
nextyr)
          dpToNs DPName
DPMonth = (Maybe Int
mo, Maybe Int
nextmo)
          dpToNs DPName
DPDay   = (Maybe Int
da, Maybe Int
nextda)
      let areSame :: [DPName]
areSame = (DPName -> Bool) -> [DPName] -> [DPName]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Maybe Int -> Maybe Int -> Bool) -> (Maybe Int, Maybe Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Maybe Int, Maybe Int) -> Bool)
-> (DPName -> (Maybe Int, Maybe Int)) -> DPName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DPName -> (Maybe Int, Maybe Int)
dpToNs) ([DPName] -> [DPName]) -> [DPName] -> [DPName]
forall a b. (a -> b) -> a -> b
$
                      [DPName] -> [DPName]
forall a. Ord a => [a] -> [a]
sort ([DPName] -> [DPName]) -> [DPName] -> [DPName]
forall a b. (a -> b) -> a -> b
$ (DP -> DPName) -> [DP] -> [DPName]
forall a b. (a -> b) -> [a] -> [b]
map DP -> DPName
dpName [DP]
dpSpecs
      let ([DP]
sames1, [DP]
rest) = (DP -> Bool) -> [DP] -> ([DP], [DP])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\DP
dp -> DP -> DPName
dpName DP
dp DPName -> [DPName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DPName]
areSame) [DP]
dpSpecs
      let ([DP]
diffs, [DP]
sames2) = (DP -> Bool) -> [DP] -> ([DP], [DP])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\DP
dp -> DP -> DPName
dpName DP
dp DPName -> [DPName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [DPName]
areSame) [DP]
rest
      let cleanup :: [Output a] -> [Output a]
cleanup = (Output a -> Bool) -> [Output a] -> [Output a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
/= Output a
forall a. Output a
NullOutput)
      [Output a]
sames1' <- [Output a] -> [Output a]
cleanup ([Output a] -> [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DP
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [DP] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe Int, Maybe Int, Maybe Int)
-> DP
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
sames1
      [Output a]
diffsLeft' <- [Output a] -> [Output a]
cleanup ([Output a] -> [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DP
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [DP] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe Int, Maybe Int, Maybe Int)
-> DP
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
diffs
      [Output a]
diffsRight' <- [Output a] -> [Output a]
cleanup ([Output a] -> [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DP
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [DP] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe Int, Maybe Int, Maybe Int)
-> DP
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
nextyr,Maybe Int
nextmo,Maybe Int
nextda)) [DP]
diffs
      [Output a]
sames2' <- [Output a] -> [Output a]
cleanup ([Output a] -> [Output a])
-> Eval a [Output a] -> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DP
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Output a))
-> [DP] -> Eval a [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe Int, Maybe Int, Maybe Int)
-> DP
-> RWST (Context a) (Set Text) (EvalState a) Identity (Output a)
forall a.
CiteprocOutput a =>
(Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da)) [DP]
sames2
      let rangeDelim :: Maybe Text
rangeDelim = case (DP -> DPName) -> [DP] -> [DP]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DP -> DPName
dpName [DP]
diffs of
                              []     -> Maybe Text
forall a. Maybe a
Nothing
                              (DP
dp:[DP]
_) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ DP -> Text
dpRangeDelimiter DP
dp
      let toRange :: [Output a] -> [Output a] -> [Output a]
toRange [Output a]
xs [Output a]
ys =
            case [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
lastMay [Output a]
xs of
              Just Output a
xlast ->
                   [Output a] -> [Output a]
forall a. [a] -> [a]
initSafe [Output a]
xs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                     [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
rangeDelim }
                     [Output a
xlast, Output a -> [Output a] -> Output a
forall a. a -> [a] -> a
headDef (a -> Output a
forall a. a -> Output a
Literal a
forall a. Monoid a => a
mempty) [Output a]
ys]] [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                   [Output a] -> [Output a]
forall a. [a] -> [a]
tailSafe [Output a]
ys
              Maybe (Output a)
_ -> [Output a]
xs [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a]
ys

      [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output a] -> Eval a [Output a])
-> [Output a] -> Eval a [Output a]
forall a b. (a -> b) -> a -> b
$
        if Bool
isOpenRange
           then [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
rangeDelim }
                    ([Output a] -> [Output a]
forall a. [Output a] -> [Output a]
removeLastSuffix ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall a b. (a -> b) -> a -> b
$ [Output a]
sames1' [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a]
diffsLeft')]
           else [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
removeLastSuffix ([Output a] -> [Output a]) -> [Output a] -> [Output a]
forall a b. (a -> b) -> a -> b
$
                 [Output a]
sames1' [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                 [Output a] -> [Output a] -> [Output a]
forall a. Monoid a => [Output a] -> [Output a] -> [Output a]
toRange ([Output a] -> [Output a]
forall a. [Output a] -> [Output a]
removeLastSuffix [Output a]
diffsLeft')
                         ([Output a] -> [Output a]
forall a. [Output a] -> [Output a]
removeFirstPrefix [Output a]
diffsRight') [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++
                 [Output a]
sames2'

removeFirstPrefix :: [Output a] -> [Output a]
removeFirstPrefix :: [Output a] -> [Output a]
removeFirstPrefix (Formatted Formatting
f [Output a]
xs : [Output a]
rest) =
  Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing } [Output a]
xs Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a]
rest
removeFirstPrefix [Output a]
xs = [Output a]
xs

removeLastSuffix :: [Output a] -> [Output a]
removeLastSuffix :: [Output a] -> [Output a]
removeLastSuffix [] = []
removeLastSuffix [Formatted Formatting
f [Output a]
xs] =
  [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing } [Output a]
xs ]
removeLastSuffix (Output a
x:[Output a]
xs) = Output a
x Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
removeLastSuffix [Output a]
xs

eDP :: CiteprocOutput a
    => (Maybe Int, Maybe Int, Maybe Int) ->  DP -> Eval a (Output a)
eDP :: (Maybe Int, Maybe Int, Maybe Int) -> DP -> Eval a (Output a)
eDP (Maybe Int
yr,Maybe Int
mo,Maybe Int
da) DP
dp = do
  let mbn :: Maybe Int
mbn = case DP -> DPName
dpName DP
dp of
               DPName
DPDay   -> Maybe Int
da
               DPName
DPMonth -> Maybe Int
mo
               DPName
DPYear  -> Maybe Int
yr
  case Maybe Int
mbn of
    Maybe Int
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
    Just Int
0 | DP -> DPName
dpName DP
dp DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DPName
DPYear
            -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal a
forall a. Monoid a => a
mempty -- open date range
    Just Int
n  -> do
      let litStr :: String -> Eval a (Output a)
litStr = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a))
-> (String -> Output a) -> String -> Eval a (Output a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> (String -> a) -> String -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text -> a) -> (String -> Text) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      [Output a]
suffix <- case DP -> DPName
dpName DP
dp of
                  DPName
DPYear
                    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
                      -> (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> Eval a (Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"bc" }
                    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                    , Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1000
                      -> (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> Eval a (Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"ad" }
                    | Bool
otherwise -> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                  DPName
_ -> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      let n' :: Int
n' = case DP -> DPName
dpName DP
dp of
                 DPName
DPYear -> Int -> Int
forall a. Num a => a -> a
abs Int
n
                 DPName
_      -> Int
n
      Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted (DP -> Formatting
dpFormatting DP
dp) ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[Output a]
suffix) (Output a -> Output a) -> Eval a (Output a) -> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          case DP -> DPForm
dpForm DP
dp of
            DPForm
DPNumeric             -> String -> Eval a (Output a)
litStr (Int -> String
forall a. Show a => a -> String
show Int
n')
            DPForm
DPNumericLeadingZeros -> String -> Eval a (Output a)
litStr (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
n')
            DPForm
DPOrdinal             -> do
              Locale
locale <- (Context a -> Locale)
-> RWST (Context a) (Set Text) (EvalState a) Identity Locale
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Locale
forall a. Context a -> Locale
contextLocale
              if Locale -> Maybe Bool
localeLimitDayOrdinalsToDay1 Locale
locale Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Bool -> Bool -> Bool
&& Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
                 then String -> Eval a (Output a)
litStr (Int -> String
forall a. Show a => a -> String
show Int
n')
                 else NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal Maybe TermGender
forall a. Maybe a
Nothing (Int -> Val a
forall a. Int -> Val a
NumVal Int
n')
            DPForm
form -> do
              let termForMonth :: String -> Term
termForMonth String
s = Term
emptyTerm{ termName :: Text
termName = String -> Text
T.pack String
s
                                            , termForm :: TermForm
termForm = if DPForm
form DPForm -> DPForm -> Bool
forall a. Eq a => a -> a -> Bool
== DPForm
DPShort
                                                            then TermForm
Short
                                                            else TermForm
Long }

              case DP -> DPName
dpName DP
dp of
                DPName
DPMonth | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
                        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12 ->
                  Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' (Term -> Eval a (Output a)) -> Term -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"month-%02d" Int
n)
                        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16 -> -- season pseudo-month
                  Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' (Term -> Eval a (Output a)) -> Term -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12))
                        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20 -> -- season pseudo-month
                  Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' (Term -> Eval a (Output a)) -> Term -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
16))
                        | Bool
otherwise -> -- season pseudo-month
                  Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' (Term -> Eval a (Output a)) -> Term -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ String -> Term
termForMonth (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
20))
                DPName
_                 -> String -> Eval a (Output a)
litStr (Int -> String
forall a. Show a => a -> String
show Int
n')


bindDateParts :: DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts :: DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
date =
      case DateParts
date of
        DateParts (Int
y:Int
m:Int
d:[Int]
_) -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y,Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m,Int -> Maybe Int
forall a. a -> Maybe a
Just Int
d)
        DateParts [Int
y,Int
m]     -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y,Int -> Maybe Int
forall a. a -> Maybe a
Just Int
m,Maybe Int
forall a. Maybe a
Nothing)
        DateParts [Int
y]       -> (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y,Maybe Int
forall a. Maybe a
Nothing,Maybe Int
forall a. Maybe a
Nothing)
        DateParts
_                   -> (Maybe Int
forall a. Maybe a
Nothing,Maybe Int
forall a. Maybe a
Nothing,Maybe Int
forall a. Maybe a
Nothing)

eNames :: CiteprocOutput a
        => [Variable]
        -> NamesFormat
        -> [Element a]
        -> Formatting
        -> Eval a (Output a)
eNames :: [Variable]
-> NamesFormat -> [Element a] -> Formatting -> Eval a (Output a)
eNames [Variable]
vars NamesFormat
namesFormat' [Element a]
subst Formatting
formatting = do
  Maybe NamesFormat
substituteNamesForm <- (Context a -> Maybe NamesFormat)
-> RWST
     (Context a) (Set Text) (EvalState a) Identity (Maybe NamesFormat)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe NamesFormat
forall a. Context a -> Maybe NamesFormat
contextSubstituteNamesForm
  Bool
inSortKey <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInSortKey
  let namesFormat :: NamesFormat
namesFormat =
        case Maybe NamesFormat
substituteNamesForm of
          Maybe NamesFormat
Nothing -> NamesFormat
namesFormat'
          Just NamesFormat
subs ->
            NamesFormat :: Maybe (TermForm, Pluralize, Formatting)
-> Maybe (Text, Formatting)
-> Maybe (NameFormat, Formatting)
-> Bool
-> NamesFormat
NamesFormat
            { namesLabel :: Maybe (TermForm, Pluralize, Formatting)
namesLabel           =
                if Bool
inSortKey -- see test/csl/sort_DropNameLabelInSort.txt
                   -- though this doesn't seem to be in the spec
                   then Maybe (TermForm, Pluralize, Formatting)
forall a. Maybe a
Nothing
                   else NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat' Maybe (TermForm, Pluralize, Formatting)
-> Maybe (TermForm, Pluralize, Formatting)
-> Maybe (TermForm, Pluralize, Formatting)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
subs
            , namesEtAl :: Maybe (Text, Formatting)
namesEtAl            = NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
namesFormat' Maybe (Text, Formatting)
-> Maybe (Text, Formatting) -> Maybe (Text, Formatting)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                       NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
subs
            , namesName :: Maybe (NameFormat, Formatting)
namesName            = NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat' Maybe (NameFormat, Formatting)
-> Maybe (NameFormat, Formatting) -> Maybe (NameFormat, Formatting)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                                       NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
subs
            , namesLabelBeforeName :: Bool
namesLabelBeforeName =
                if Maybe (NameFormat, Formatting) -> Bool
forall a. Maybe a -> Bool
isJust (NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat') Bool -> Bool -> Bool
&&
                   Maybe (TermForm, Pluralize, Formatting) -> Bool
forall a. Maybe a -> Bool
isJust (NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat')
                   then NamesFormat -> Bool
namesLabelBeforeName NamesFormat
namesFormat'
                   else NamesFormat -> Bool
namesLabelBeforeName NamesFormat
subs
            }

  [Variable]
vars' <- if Variable
"editor" Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
vars Bool -> Bool -> Bool
&& Variable
"translator" Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
vars
              then do
                Maybe (Val a)
ed <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"editor"
                Maybe (Val a)
tr <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"translator"
                let termform :: TermForm
termform =
                      case NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat of
                        Just (TermForm
termform', Pluralize
_, Formatting
_) -> TermForm
termform'
                        Maybe (TermForm, Pluralize, Formatting)
_ -> TermForm
Long
                Output a
mbterm <- Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm'
                            Term
emptyTerm{ termName :: Text
termName = Text
"editortranslator"
                                     , termForm :: TermForm
termForm = TermForm
termform }
                if Maybe (Val a)
ed Maybe (Val a) -> Maybe (Val a) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Val a)
tr Bool -> Bool -> Bool
&& Output a
mbterm Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
/= Output a
forall a. Output a
NullOutput
                   then [Variable]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Variable]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Variable]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Variable])
-> [Variable]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Variable]
forall a b. (a -> b) -> a -> b
$ Variable
"editortranslator" Variable -> [Variable] -> [Variable]
forall a. a -> [a] -> [a]
:
                        [Variable
v | Variable
v <- [Variable]
vars
                           , Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
/= Variable
"editor"
                           , Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
/= Variable
"translator"]
                   else [Variable]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Variable]
forall (m :: * -> *) a. Monad m => a -> m a
return [Variable]
vars
              else [Variable]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Variable]
forall (m :: * -> *) a. Monad m => a -> m a
return [Variable]
vars
  Bool
inSubstitute <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInSubstitute
  let (NameFormat
nameFormat, Formatting
nameFormatting) =
        (NameFormat, Formatting)
-> Maybe (NameFormat, Formatting) -> (NameFormat, Formatting)
forall a. a -> Maybe a -> a
fromMaybe (NameFormat
defaultNameFormat, Formatting
forall a. Monoid a => a
mempty) (Maybe (NameFormat, Formatting) -> (NameFormat, Formatting))
-> Maybe (NameFormat, Formatting) -> (NameFormat, Formatting)
forall a b. (a -> b) -> a -> b
$ NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat
  [(Variable, Maybe (Val a))]
rawContribs <- (Variable
 -> RWST
      (Context a)
      (Set Text)
      (EvalState a)
      Identity
      (Variable, Maybe (Val a)))
-> [Variable]
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     [(Variable, Maybe (Val a))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Variable
var -> (Variable
var,) (Maybe (Val a) -> (Variable, Maybe (Val a)))
-> Eval a (Maybe (Val a))
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Variable, Maybe (Val a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable
                       (if Variable
var Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"editortranslator"
                           then Variable
"editor"
                           else Variable
var)) [Variable]
vars'
  if ((Variable, Maybe (Val a)) -> Bool)
-> [(Variable, Maybe (Val a))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (Val a) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Val a) -> Bool)
-> ((Variable, Maybe (Val a)) -> Maybe (Val a))
-> (Variable, Maybe (Val a))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Variable, Maybe (Val a)) -> Maybe (Val a)
forall a b. (a, b) -> b
snd) [(Variable, Maybe (Val a))]
rawContribs
     then
       case [Element a]
subst of
         els :: [Element a]
els@(Element a
_:[Element a]
_) | Bool -> Bool
not Bool
inSubstitute -> do
           [Output a]
res <- (Context a -> EvalState a -> (Context a, EvalState a))
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall r' s r w (m :: * -> *) a.
(r' -> s -> (r, s)) -> RWST r w s m a -> RWST r' w s m a
withRWST
                  (\Context a
ctx EvalState a
st -> (Context a
ctx{ contextInSubstitute :: Bool
contextInSubstitute = Bool
True
                                  , contextSubstituteNamesForm :: Maybe NamesFormat
contextSubstituteNamesForm =
                                      NamesFormat -> Maybe NamesFormat
forall a. a -> Maybe a
Just NamesFormat
namesFormat },
                               EvalState a
st)) (RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a b. (a -> b) -> a -> b
$ [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a. CiteprocOutput a => [Element a] -> Eval a [Output a]
eSubstitute [Element a]
els
           Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
             case [Output a]
res of
               (Tagged TagNames{} Output a
_:[Output a]
_) -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
res
               -- important to have title (or whatever) tagged as
               -- substituting for Names, for purposes of
               -- disambiguation:
               [Output a]
_ -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting
                    [Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
"" NamesFormat
namesFormat []) (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$ [Output a] -> Output a
forall a. [Output a] -> Output a
grouped [Output a]
res]
         [Element a]
_ -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
     else do
        [Output a]
xs <- ((Variable, Maybe (Val a)) -> Eval a (Output a))
-> [(Variable, Maybe (Val a))]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NamesFormat
-> NameFormat
-> Formatting
-> (Variable, Maybe (Val a))
-> Eval a (Output a)
forall a.
CiteprocOutput a =>
NamesFormat
-> NameFormat
-> Formatting
-> (Variable, Maybe (Val a))
-> Eval a (Output a)
formatNames NamesFormat
namesFormat NameFormat
nameFormat Formatting
nameFormatting)
               [(Variable, Maybe (Val a))]
rawContribs
        Bool
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
inSubstitute (RWST (Context a) (Set Text) (EvalState a) Identity ()
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$
          (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify ((EvalState a -> EvalState a)
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> (EvalState a -> EvalState a)
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState a
st ->  -- delete variables so they aren't used again...
              EvalState a
st{ stateReference :: Reference a
stateReference =
                  let Reference ItemId
id' Text
type' Maybe DisambiguationData
d' Map Variable (Val a)
m' = EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference EvalState a
st
                   in ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
forall a.
ItemId
-> Text
-> Maybe DisambiguationData
-> Map Variable (Val a)
-> Reference a
Reference ItemId
id' Text
type' Maybe DisambiguationData
d' ((Variable -> Map Variable (Val a) -> Map Variable (Val a))
-> Map Variable (Val a) -> [Variable] -> Map Variable (Val a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Variable -> Map Variable (Val a) -> Map Variable (Val a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Map Variable (Val a)
m'
                                         [Variable
v | (Variable
v, Just Val a
_) <- [(Variable, Maybe (Val a))]
rawContribs ])}

        Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
          case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
             NameForm
CountName -> a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
               [Name
name
                 | Tagged (TagName Name
name) Output a
_ <- (Output a -> [Output a]) -> [Output a] -> [Output a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe [Output a]
xs]
             NameForm
_ -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
xs

eSubstitute :: CiteprocOutput a
            => [Element a]
            -> Eval a [Output a]
eSubstitute :: [Element a] -> Eval a [Output a]
eSubstitute [Element a]
els =
  case [Element a]
els of
    [] -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    (Element a
e:[Element a]
es) -> do
      [Output a]
res <- Element a -> Eval a [Output a]
forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement Element a
e
      case (Output a -> Bool) -> [Output a] -> [Output a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
/= Output a
forall a. Output a
NullOutput) [Output a]
res of
        [] -> [Element a] -> Eval a [Output a]
forall a. CiteprocOutput a => [Element a] -> Eval a [Output a]
eSubstitute [Element a]
es
        [Output a]
xs -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
xs

formatNames :: CiteprocOutput a
            => NamesFormat
            -> NameFormat
            -> Formatting
            -> (Variable, Maybe (Val a))
            -> Eval a (Output a)
formatNames :: NamesFormat
-> NameFormat
-> Formatting
-> (Variable, Maybe (Val a))
-> Eval a (Output a)
formatNames NamesFormat
namesFormat NameFormat
nameFormat Formatting
formatting (Variable
var, Just (NamesVal [Name]
names)) =
  do
  Bool
isSubsequent <- (Position
Subsequent Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Position] -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Position]
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Context a -> [Position])
-> RWST (Context a) (Set Text) (EvalState a) Identity [Position]
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [Position]
forall a. Context a -> [Position]
contextPosition
  Bool
isInBibliography <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInBibliography
  let (Maybe Int
etAlMin, Maybe Int
etAlUseFirst) =
        if Bool -> Bool
not Bool
isInBibliography Bool -> Bool -> Bool
&& Bool
isSubsequent
           then (NameFormat -> Maybe Int
nameEtAlSubsequentMin NameFormat
nameFormat Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameFormat -> Maybe Int
nameEtAlMin NameFormat
nameFormat,
                 NameFormat -> Maybe Int
nameEtAlSubsequentUseFirst NameFormat
nameFormat Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    NameFormat -> Maybe Int
nameEtAlUseFirst NameFormat
nameFormat)
           else (NameFormat -> Maybe Int
nameEtAlMin NameFormat
nameFormat, NameFormat -> Maybe Int
nameEtAlUseFirst NameFormat
nameFormat)
  Bool
inSortKey <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInSortKey
  Maybe DisambiguationData
disamb <- (EvalState a -> Maybe DisambiguationData)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe DisambiguationData)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation (Reference a -> Maybe DisambiguationData)
-> (EvalState a -> Reference a)
-> EvalState a
-> Maybe DisambiguationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference)
  [Output a]
names' <- (Int -> Name -> Eval a (Output a))
-> [Int]
-> [Name]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName NameFormat
nameFormat Formatting
formatting) [Int
1..] [Name]
names
  let delim' :: Text
delim' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (NameFormat -> Text
nameDelimiter NameFormat
nameFormat) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
                 Formatting -> Maybe Text
formatDelimiter Formatting
formatting
  let delim :: Text
delim = case (Text -> Bool
beginsWithSpace (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting -> Maybe Text
formatSuffix Formatting
formatting,
                    Text -> Bool
endsWithSpace (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Formatting -> Maybe Text
formatPrefix Formatting
formatting) of
                    (Just Bool
True, Just Bool
True) -> Text -> Text
T.strip Text
delim'
                    (Just Bool
True, Maybe Bool
_)         -> Text -> Text
T.stripStart Text
delim'
                    (Maybe Bool
_, Just Bool
True)         -> Text -> Text
T.stripEnd Text
delim'
                    (Maybe Bool, Maybe Bool)
_                      -> Text
delim'
  let numnames :: Int
numnames = [Output a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output a]
names'
  [Output a]
label <- case NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat of
             Just (TermForm
termform, Pluralize
pluralize, Formatting
lf) | Bool -> Bool
not Bool
inSortKey ->
               (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> Eval a (Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
forall a.
CiteprocOutput a =>
Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel Variable
var TermForm
termform Pluralize
pluralize Formatting
lf
             Maybe (TermForm, Pluralize, Formatting)
_ -> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Maybe Text
mbAndTerm <- case NameFormat -> Maybe TermForm
nameAndStyle NameFormat
nameFormat of
                  Just TermForm
Symbol -> do
                    [(Term, Text)]
ts <- Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                               , termForm :: TermForm
termForm = TermForm
Symbol }
                    case [(Term, Text)]
ts of
                      (Term
_,Text
x):[(Term, Text)]
_ -> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text))
-> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
                      []      -> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
 -> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text))
-> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"&"
                  Just TermForm
_ -> ((Term, Text) -> Text) -> Maybe (Term, Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Term, Text) -> Text
forall a b. (a, b) -> b
snd (Maybe (Term, Text) -> Maybe Text)
-> ([(Term, Text)] -> Maybe (Term, Text))
-> [(Term, Text)]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Term, Text)] -> Maybe (Term, Text)
forall a. [a] -> Maybe a
listToMaybe ([(Term, Text)] -> Maybe Text)
-> Eval a [(Term, Text)]
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                              Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Text
"and"
                                                   , termForm :: TermForm
termForm = TermForm
Long }
                  Maybe TermForm
Nothing -> Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
  let finalNameIsOthers :: Bool
finalNameIsOthers = ([Name] -> Maybe Name
forall a. [a] -> Maybe a
lastMay [Name]
names Maybe Name -> (Name -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Name -> Maybe Text
nameLiteral) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"others"
        -- bibtex conversions often have this, and we want to render it "et al"
  let etAlUseLast :: Bool
etAlUseLast = NameFormat -> Bool
nameEtAlUseLast NameFormat
nameFormat
  let etAlThreshold :: Maybe Int
etAlThreshold = case Maybe Int
etAlMin of
                        Just Int
x | Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
x
                          -> case (Maybe DisambiguationData
disamb Maybe DisambiguationData
-> (DisambiguationData -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DisambiguationData -> Maybe Int
disambEtAlNames, Maybe Int
etAlUseFirst) of
                               (Just Int
n, Just Int
m) -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
m Int
n)
                               (Maybe Int
_, Maybe Int
y) -> Maybe Int
y
                               | Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x
                               , Bool
finalNameIsOthers -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
numnames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                        Maybe Int
_ -> Maybe Int
forall a. Maybe a
Nothing
  let beforeLastDelim :: Text
beforeLastDelim =
        case Maybe Text
mbAndTerm of
          Maybe Text
Nothing -> Text
delim
          Just Text
_ ->
             case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesLast NameFormat
nameFormat of
                DelimiterPrecedes
PrecedesContextual
                  | Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2          -> Text
delim
                  | Bool
otherwise             -> Text
""
                DelimiterPrecedes
PrecedesAfterInvertedName
                  -> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll -> Text
delim
                       Just NameAsSortOrder
NameAsSortOrderFirst
                         | Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3        -> Text
delim
                       Maybe NameAsSortOrder
_                       -> Text
""
                DelimiterPrecedes
PrecedesAlways            -> Text
delim
                DelimiterPrecedes
PrecedesNever             -> Text
""
  let andPreSpace :: Text
andPreSpace = case Text
beforeLastDelim of
        Text
"" -> case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
                Just Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
                Maybe Text
_ -> Text
" "
        Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
        Text
_  -> Text
" "
  let andPostSpace :: Text
andPostSpace = case Formatting -> Maybe Text
formatPrefix Formatting
formatting of
                       Just Text
t | Text -> Bool
beginsWithSpace Text
t -> Text
""
                       Maybe Text
_ -> Text
" "
  let mbAndDelim :: Maybe Text
mbAndDelim = case Maybe Text
mbAndTerm of
                         Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
                         Just Text
t  -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
andPreSpace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
andPostSpace)
  let etAlPreSpace :: Text
etAlPreSpace = case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
                       Just Text
t | Text -> Bool
endsWithSpace Text
t -> Text
""
                       Maybe Text
_ -> Text
" "
  let beforeEtAl :: Text
beforeEtAl =
        case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesEtAl NameFormat
nameFormat of
            DelimiterPrecedes
PrecedesContextual
              | Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2
              , Maybe Int
etAlThreshold Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1 -> Text
delim
              | Bool
otherwise              -> Text
etAlPreSpace
            DelimiterPrecedes
PrecedesAfterInvertedName
                  -> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll  -> Text
delim
                       Just NameAsSortOrder
NameAsSortOrderFirst
                         | Maybe Int
etAlThreshold Maybe Int -> Maybe Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2 -> Text
delim
                       Maybe NameAsSortOrder
_                          -> Text
etAlPreSpace
            DelimiterPrecedes
PrecedesAlways            -> Text
delim
            DelimiterPrecedes
PrecedesNever             -> Text
etAlPreSpace
  Output a
etAl <- case NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
namesFormat of
                Just (Text
term, Formatting
f) -> Formatting -> Eval a (Output a) -> Eval a (Output a)
forall a.
CiteprocOutput a =>
Formatting -> Eval a (Output a) -> Eval a (Output a)
withFormatting Formatting
f{
                    formatPrefix :: Maybe Text
formatPrefix = Text -> Text
removeDoubleSpaces (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                      Text -> Maybe Text
forall a. a -> Maybe a
Just Text
beforeEtAl Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Formatting -> Maybe Text
formatPrefix Formatting
f } (Eval a (Output a) -> Eval a (Output a))
-> Eval a (Output a) -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                 Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
term }
                Maybe (Text, Formatting)
Nothing
                  | Bool
etAlUseLast ->
                    Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$
                      Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
beforeEtAl }
                        [Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
"\x2026 "] -- ellipses
                  | Bool
otherwise   ->
                      Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
beforeEtAl }
                      ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> Output a) -> Eval a (Output a) -> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
emptyTerm{ termName :: Text
termName = Text
"et-al" }
  let addNameAndDelim :: Output a -> Int -> Output a
addNameAndDelim Output a
name Int
idx
       | Maybe Int
etAlThreshold Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 = Output a
forall a. Output a
NullOutput
       | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    = Output a
name
       | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numnames
       , Bool
etAlUseLast
       , Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Int
etAlThreshold
         = Output a
name
       | Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>) Maybe Int
etAlThreshold = Output a
forall a. Output a
NullOutput
       | Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) Maybe Int
etAlThreshold =
         if Bool
inSortKey
            then Output a
forall a. Output a
NullOutput
            else Output a
etAl
       | Bool
inSortKey = Output a
name
       | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
numnames
         = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix =
                       Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
beforeLastDelim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mbAndDelim) }
            [Output a
name]
       | Bool
otherwise = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
delim } [Output a
name]
  let names'' :: [Output a]
names'' = (Output a -> Int -> Output a) -> [Output a] -> [Int] -> [Output a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Output a -> Int -> Output a
addNameAndDelim [Output a]
names' [Int
1..]
  -- we set delimiter to Nothing because we're handling delim
  -- manually, to allow for things like "and" and no final comma
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Variable -> NamesFormat -> [Name] -> Tag
TagNames Variable
var NamesFormat
namesFormat [Name]
names)
         (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$ [Output a] -> Output a
forall a. [Output a] -> Output a
grouped ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$
           if NamesFormat -> Bool
namesLabelBeforeName NamesFormat
namesFormat
              then [Output a]
label [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a]
names''
              else [Output a]
names'' [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a]
label

formatNames NamesFormat
_ NameFormat
_ Formatting
_ (Variable
var, Just Val a
_) = do
  Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"ignoring non-name value for variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Variable -> Text
fromVariable Variable
var
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
formatNames NamesFormat
_ NameFormat
_ Formatting
_ (Variable
_, Maybe (Val a)
Nothing) = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput

formatName :: CiteprocOutput a
           => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName :: NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
formatName NameFormat
nameFormat Formatting
formatting Int
order Name
name = do
  Maybe DisambiguationData
disamb <- (EvalState a -> Maybe DisambiguationData)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     (Maybe DisambiguationData)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets (Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation (Reference a -> Maybe DisambiguationData)
-> (EvalState a -> Reference a)
-> EvalState a
-> Maybe DisambiguationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference)
  let nameFormat' :: NameFormat
nameFormat' =
        case Name -> Map Name NameHints -> Maybe NameHints
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
name (Map Name NameHints -> Maybe NameHints)
-> (DisambiguationData -> Map Name NameHints)
-> DisambiguationData
-> Maybe NameHints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DisambiguationData -> Map Name NameHints
disambNameMap (DisambiguationData -> Maybe NameHints)
-> Maybe DisambiguationData -> Maybe NameHints
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe DisambiguationData
disamb of
          Maybe NameHints
Nothing -> NameFormat
nameFormat
          Just NameHints
AddInitials
            -> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
          Just NameHints
AddInitialsIfPrimary
            | Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  -> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
            | Bool
otherwise -> NameFormat
nameFormat
          Just NameHints
AddGivenName ->
            NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName
                      , nameInitialize :: Bool
nameInitialize = Bool
False
                      }
          Just NameHints
AddGivenNameIfPrimary
            | Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
               NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName
                         , nameInitialize :: Bool
nameInitialize = Bool
False
                         }
            | Bool
otherwise -> NameFormat
nameFormat
  Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Name -> Tag
TagName Name
name) (Output a -> Output a) -> Eval a (Output a) -> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case Name -> Maybe Text
nameLiteral Name
name of
      Just Text
t  -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting
                        ([Output a] -> Output a) -> [Output a] -> Output a
forall a b. (a -> b) -> a -> b
$ [Output a]
-> (Formatting -> [Output a]) -> Maybe Formatting -> [Output a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
t]
                          (\Formatting
f -> [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
t]])
                          (NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat)
      Maybe Text
Nothing -> NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName NameFormat
nameFormat' Formatting
formatting Int
order Name
name


getNamePartSortOrder :: Name -> Eval a [Text]
getNamePartSortOrder :: Name -> Eval a [Text]
getNamePartSortOrder Name
name = do
  DemoteNonDroppingParticle
demoteNonDroppingParticle <-
    (Context a -> DemoteNonDroppingParticle)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     DemoteNonDroppingParticle
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> DemoteNonDroppingParticle
styleDemoteNonDroppingParticle (StyleOptions -> DemoteNonDroppingParticle)
-> (Context a -> StyleOptions)
-> Context a
-> DemoteNonDroppingParticle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
  (Maybe Text -> Text) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty) ([Maybe Text] -> [Text])
-> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text]
-> Eval a [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    case Name -> Maybe Text
nameLiteral Name
name of
      Maybe Text
Nothing
        | Name -> Bool
isByzantineName Name
name
           -> [Maybe Text]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe Text]
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text])
-> [Maybe Text]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text]
forall a b. (a -> b) -> a -> b
$
                   case DemoteNonDroppingParticle
demoteNonDroppingParticle of
                     DemoteNonDroppingParticle
DemoteNever ->
                           [Name -> Maybe Text
nameNonDroppingParticle Name
name Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> Name -> Maybe Text
nameFamily Name
name,
                            Name -> Maybe Text
nameDroppingParticle Name
name,
                            Name -> Maybe Text
nameGiven Name
name,
                            Name -> Maybe Text
nameSuffix Name
name]
                     DemoteNonDroppingParticle
_ ->  [Name -> Maybe Text
nameFamily Name
name,
                            Name -> Maybe Text
nameDroppingParticle Name
name Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<>
                              Name -> Maybe Text
nameNonDroppingParticle Name
name,
                            Name -> Maybe Text
nameGiven Name
name,
                            Name -> Maybe Text
nameSuffix Name
name]
        | Bool
otherwise
           -> [Maybe Text]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name -> Maybe Text
nameFamily Name
name,
                      Name -> Maybe Text
nameGiven Name
name]
      Just Text
n -> [Maybe Text]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Maybe Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n]

literal :: CiteprocOutput a => Text -> Output a
literal :: Text -> Output a
literal = a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> (Text -> a) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
forall a. CiteprocOutput a => Text -> a
fromText

showYearSuffix :: Int -> Text
showYearSuffix :: Int -> Text
showYearSuffix Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
27    = Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Bool
otherwise =
      let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
       in String -> Text
T.pack [Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
26)),
                  Int -> Char
chr (Char -> Int
ord Char
'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26))]

initialize :: Maybe Lang
           -> Bool       -- ^ initialize
           -> Bool       -- ^ with hyphen
           -> Text       -- ^ initialize with (suffix)
           -> Text
           -> Text
initialize :: Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
makeInitials Bool
useHyphen Text
initializeWith =
   Text -> Text
stripSpaces (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
" -" Text
"-" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Text Text -> Text) -> [Either Text Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Either Text Text -> Text
initializeWord ([Either Text Text] -> [Text])
-> (Text -> [Either Text Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Either Text Text]
splitWords
  where
   stripSpaces :: Text -> Text
stripSpaces = (Char -> Bool) -> Text -> Text
T.dropWhile (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
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') -- preserve nbsp
   -- Left values are already initials
   -- Right values are not
   splitWords :: Text -> [Either Text Text]
splitWords =
     [Either Text Text] -> [Either Text Text]
forall a. [a] -> [a]
reverse ([Either Text Text] -> [Either Text Text])
-> (Text -> [Either Text Text]) -> Text -> [Either Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Either Text Text]
ws,String
cs) ->
                  case String
cs of
                    [] -> [Either Text Text]
ws
                    [Char
d] -> Text -> Either Text Text
forall a b. a -> Either a b
Left (Char -> Text
T.singleton Char
d) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws
                    String
_   -> Text -> Either Text Text
forall a b. b -> Either a b
Right (String -> Text
T.pack (ShowS
forall a. [a] -> [a]
reverse String
cs)) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws) (([Either Text Text], String) -> [Either Text Text])
-> (Text -> ([Either Text Text], String))
-> Text
-> [Either Text Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (([Either Text Text], String)
 -> Char -> ([Either Text Text], String))
-> ([Either Text Text], String)
-> Text
-> ([Either Text Text], String)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl'
     (\([Either Text Text]
ws, String
cs) Char
c ->
       case Char
c of
         Char
'.' | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs   -> ([Either Text Text]
ws, [])
             | Bool
otherwise -> (Text -> Either Text Text
forall a b. a -> Either a b
Left (String -> Text
T.pack (ShowS
forall a. [a] -> [a]
reverse String
cs)) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
         Char
'-' | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs   -> ([Either Text Text]
ws, [Char
'-'])
             | Bool
otherwise -> (Text -> Either Text Text
forall a b. b -> Either a b
Right (String -> Text
T.pack (ShowS
forall a. [a] -> [a]
reverse String
cs)) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [Char
'-'])
         Char
' ' -> case String
cs of
                  []  -> ([Either Text Text]
ws, String
cs)
                  [Char
d] -> (Text -> Either Text Text
forall a b. a -> Either a b
Left (Char -> Text
T.singleton Char
d) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
                  String
_   -> (Text -> Either Text Text
forall a b. b -> Either a b
Right (String -> Text
T.pack (ShowS
forall a. [a] -> [a]
reverse String
cs)) Either Text Text -> [Either Text Text] -> [Either Text Text]
forall a. a -> [a] -> [a]
: [Either Text Text]
ws, [])
         Char
_   -> ([Either Text Text]
ws, Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs))
     ([], String
forall a. Monoid a => a
mempty)
   addSuffix :: Text -> Text
addSuffix Text
t
     | Text -> Bool
T.null Text
t  = Text
forall a. Monoid a => a
mempty
     | Bool
otherwise = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
initializeWith
   toInitial :: Text -> Text
toInitial Text
t =
       case Text -> Maybe (Char, Text)
T.uncons Text
t of
         Just (Char
'-', Text
t') ->
           case Text -> Maybe (Char, Text)
T.uncons Text
t' of
             Just (Char
c, Text
_)
               | Char -> Bool
isUpper Char
c
               , Bool
useHyphen -> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Lang -> Text -> Text
Unicode.toUpper Maybe Lang
mblang (Char -> Text
T.singleton Char
c)
               | Char -> Bool
isUpper Char
c -> Maybe Lang -> Text -> Text
Unicode.toUpper Maybe Lang
mblang (Char -> Text
T.singleton Char
c)
             Maybe (Char, Text)
_ -> Text
forall a. Monoid a => a
mempty  -- e.g. Ji-ping -> J. not J.-p.
         Just (Char
c, Text
t')
           | Char -> Bool
isUpper Char
c ->
             case Text -> Maybe (Char, Text)
T.uncons Text
t' of
               Just (Char
d, Text
t'')
                 | Char -> Bool
isUpper Char
d  -- see test/csl/name_LongAbbreviation.txt
                 , Bool -> Bool
not (Text -> Bool
T.null Text
t'')
                 , (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
t''
                 -> Char -> Text
T.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower (Char -> Text
T.singleton Char
d)
               Maybe (Char, Text)
_ -> Char -> Text
T.singleton Char
c
         Maybe (Char, Text)
_ -> Text
t
   initializeWord :: Either Text Text -> Text
initializeWord (Left Text
t) -- Left values already initialized
     = Text -> Text
addSuffix Text
t
   initializeWord (Right Text
t) -- Right values not already initialized
     | (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isLower Text
t = if Text -> Bool
endsWithSpace Text
initializeWith
                            then Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                            else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
     | Bool
makeInitials    = (Text -> Text
addSuffix (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toInitial) Text
t
     | Bool
otherwise       = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "

getDisplayName :: CiteprocOutput a
               => NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName :: NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName NameFormat
nameFormat Formatting
formatting Int
order Name
name = do
  Bool
inSortKey <- (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Bool
forall a. Context a -> Bool
contextInSortKey
  DemoteNonDroppingParticle
demoteNonDroppingParticle <-
    (Context a -> DemoteNonDroppingParticle)
-> RWST
     (Context a)
     (Set Text)
     (EvalState a)
     Identity
     DemoteNonDroppingParticle
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> DemoteNonDroppingParticle
styleDemoteNonDroppingParticle (StyleOptions -> DemoteNonDroppingParticle)
-> (Context a -> StyleOptions)
-> Context a
-> DemoteNonDroppingParticle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
  Bool
initializeWithHyphen <-
    (Context a -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (StyleOptions -> Bool
styleInitializeWithHyphen (StyleOptions -> Bool)
-> (Context a -> StyleOptions) -> Context a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> StyleOptions
forall a. Context a -> StyleOptions
contextStyleOptions)
  Maybe Lang
mblang <- (Context a -> Maybe Lang)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Lang)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks (Locale -> Maybe Lang
localeLanguage (Locale -> Maybe Lang)
-> (Context a -> Locale) -> Context a -> Maybe Lang
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Locale
forall a. Context a -> Locale
contextLocale)
  let initialize' :: Text -> Text
initialize' =
        case Name -> Maybe Text
nameFamily Name
name of
          Maybe Text
Nothing -> Text -> Text
forall a. a -> a
id
          Just Text
_ ->
            case NameFormat -> Maybe Text
nameInitializeWith NameFormat
nameFormat of
              Just Text
initializeWith ->
                Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize
                Maybe Lang
mblang
                (NameFormat -> Bool
nameInitialize NameFormat
nameFormat)
                Bool
initializeWithHyphen
                Text
initializeWith
              Maybe Text
Nothing -> Text -> Text
forall a. a -> a
id
  let separator :: Text
separator = NameFormat -> Text
nameSortSeparator NameFormat
nameFormat
  let Output a
x <+> :: Output a -> Output a -> Output a
<+> Output a
NullOutput = Output a
x
      Output a
NullOutput <+> Output a
x = Output a
x
      Literal a
x <+> Output a
y =
        case Text -> Maybe (Text, Char)
T.unsnoc (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x) of
          Just (Text
_, Char
c) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'’' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2013' Bool -> Bool -> Bool
||
                        Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\xa0' ->
               Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty [a -> Output a
forall a. a -> Output a
Literal a
x, Output a
y]
          Maybe (Text, Char)
_ | Name -> Bool
isByzantineName Name
name ->
               Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
" " } [a -> Output a
forall a. a -> Output a
Literal a
x, Output a
y]
            | Bool
otherwise -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty [a -> Output a
forall a. a -> Output a
Literal a
x, Output a
y]
      Formatted Formatting
f [Output a]
x <+> Output a
y =
        Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter =
                            case Formatting -> Maybe Text
formatSuffix Formatting
f of
                              Just Text
t | Text -> Bool
endsWithSpace Text
t -> Maybe Text
forall a. Maybe a
Nothing
                              Maybe Text
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
" " } [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
x, Output a
y]
      Linked Text
i [Output a]
x <+> Output a
y =
        Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
" " } [Text -> [Output a] -> Output a
forall a. Text -> [Output a] -> Output a
Linked Text
i [Output a]
x, Output a
y]
      Tagged Tag
_ Output a
x <+> Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
      InNote Output a
x <+> Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
  let Output a
x <:> :: Output a -> Output a -> Output a
<:> Output a
NullOutput = Output a
x
      Output a
NullOutput <:> Output a
x = Output a
x
      Literal a
x <:> Output a
y =
        Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
separator } [a -> Output a
forall a. a -> Output a
Literal a
x, Output a
y]
      Formatted Formatting
f [Output a]
x <:> Output a
y = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
        (Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
separator }) [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
Formatted Formatting
f [Output a]
x, Output a
y]
      Linked Text
i [Output a]
x <:> Output a
y = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
        (Formatting
forall a. Monoid a => a
mempty{ formatDelimiter :: Maybe Text
formatDelimiter = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
separator }) [Text -> [Output a] -> Output a
forall a. Text -> [Output a] -> Output a
Linked Text
i [Output a]
x, Output a
y]
      Tagged Tag
_ Output a
x <:> Output a
y = Output a
x Output a -> Output a -> Output a
<:> Output a
y
      InNote Output a
x <:> Output a
y = Output a
x Output a -> Output a -> Output a
<:> Output a
y

  let familyAffixes :: [Output a] -> Output a
familyAffixes = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> Formatting
forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
f
                              , formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
f })
  let givenAffixes :: [Output a] -> Output a
givenAffixes = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameGivenFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> Formatting
forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
forall a. Monoid a => a
mempty{ formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
f
                              , formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
f })
  let familyFormatting :: [Output a] -> Output a
familyFormatting = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameFamilyFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> Formatting
forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing
                         , formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing })
  let givenFormatting :: [Output a] -> Output a
givenFormatting = Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted
          (case NameFormat -> Maybe Formatting
nameGivenFormatting NameFormat
nameFormat of
             Maybe Formatting
Nothing -> Formatting
forall a. Monoid a => a
mempty
             Just Formatting
f  -> Formatting
f{ formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing
                         , formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing })
  let nonDroppingParticle :: Output a
nonDroppingParticle =
        Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput ([Output a] -> Output a
forall a. [Output a] -> Output a
familyFormatting ([Output a] -> Output a)
-> (Text -> [Output a]) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> (Text -> Output a) -> Text -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal) (Maybe Text -> Output a) -> Maybe Text -> Output a
forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameNonDroppingParticle Name
name
  let droppingParticle :: Output a
droppingParticle =
        Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput ([Output a] -> Output a
forall a. [Output a] -> Output a
givenFormatting ([Output a] -> Output a)
-> (Text -> [Output a]) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> (Text -> Output a) -> Text -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal) (Maybe Text -> Output a) -> Maybe Text -> Output a
forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameDroppingParticle Name
name
  let given :: Output a
given =
        Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput ([Output a] -> Output a
forall a. [Output a] -> Output a
givenFormatting ([Output a] -> Output a)
-> (Text -> [Output a]) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> (Text -> Output a) -> Text -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal (Text -> Output a) -> (Text -> Text) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
initialize') (Maybe Text -> Output a) -> Maybe Text -> Output a
forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameGiven Name
name
  let family :: Output a
family =
        Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput ([Output a] -> Output a
forall a. [Output a] -> Output a
familyFormatting ([Output a] -> Output a)
-> (Text -> [Output a]) -> Text -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> [Output a])
-> (Text -> Output a) -> Text -> [Output a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal) (Maybe Text -> Output a) -> Maybe Text -> Output a
forall a b. (a -> b) -> a -> b
$
          Name -> Maybe Text
nameFamily Name
name
  let suffix :: Output a
suffix = Output a -> (Text -> Output a) -> Maybe Text -> Output a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Output a
forall a. Output a
NullOutput Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal (Maybe Text -> Output a) -> Maybe Text -> Output a
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Text
nameSuffix Name
name
  let useSortOrder :: Bool
useSortOrder = Bool
inSortKey Bool -> Bool -> Bool
||
                     case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
                       Just NameAsSortOrder
NameAsSortOrderAll -> Bool
True
                       Just NameAsSortOrder
NameAsSortOrderFirst -> Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                       Maybe NameAsSortOrder
_ -> Bool
False
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting ([Output a] -> Output a)
-> (Output a -> [Output a]) -> Output a -> Output a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
:[]) (Output a -> Output a) -> Output a -> Output a
forall a b. (a -> b) -> a -> b
$
    if Name -> Bool
isByzantineName Name
name
       then
         case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
              NameForm
LongName
                | DemoteNonDroppingParticle
demoteNonDroppingParticle DemoteNonDroppingParticle -> DemoteNonDroppingParticle -> Bool
forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteNever Bool -> Bool -> Bool
||
                  DemoteNonDroppingParticle
demoteNonDroppingParticle DemoteNonDroppingParticle -> DemoteNonDroppingParticle -> Bool
forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteSortOnly
                , Bool
useSortOrder->
                      [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
nonDroppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family ] Output a -> Output a -> Output a
forall a. Output a -> Output a -> Output a
<:>
                      [Output a] -> Output a
forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
droppingParticle ] Output a -> Output a -> Output a
forall a. Output a -> Output a -> Output a
<:>
                      Output a
suffix
                | DemoteNonDroppingParticle
demoteNonDroppingParticle DemoteNonDroppingParticle -> DemoteNonDroppingParticle -> Bool
forall a. Eq a => a -> a -> Bool
== DemoteNonDroppingParticle
DemoteDisplayAndSort
                , Bool
useSortOrder->
                      [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
family ] Output a -> Output a -> Output a
forall a. Output a -> Output a -> Output a
<:>
                      [Output a] -> Output a
forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
droppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle ] Output a -> Output a -> Output a
forall a. Output a -> Output a -> Output a
<:>
                      Output a
suffix
                | Name -> Bool
nameCommaSuffix Name
name ->
                      [Output a] -> Output a
forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given ] Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                      [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
droppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family Output a -> Output a -> Output a
forall a. Output a -> Output a -> Output a
<:>
                        Output a
suffix ]
                | Bool
otherwise ->
                      [Output a] -> Output a
forall a. [Output a] -> Output a
givenAffixes
                      [ Output a
given ] Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                      [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
droppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
nonDroppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
suffix ]
              NameForm
ShortName ->
                      [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                      [ Output a
nonDroppingParticle Output a -> Output a -> Output a
forall a. CiteprocOutput a => Output a -> Output a -> Output a
<+>
                        Output a
family ]
              NameForm
CountName -> Output a
forall a. Output a
NullOutput
       else
         case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
              NameForm
LongName  -> [Output a] -> Output a
forall a. [Output a] -> Output a
grouped
                [ [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                  [ Output a
family ]
                , [Output a] -> Output a
forall a. [Output a] -> Output a
givenAffixes
                  [ Output a
given ] ]
              NameForm
ShortName -> [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
                             [ Output a
family ]
              NameForm
CountName -> Output a
forall a. Output a
NullOutput


eGroup :: CiteprocOutput a
          => Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup :: Bool -> Formatting -> [Element a] -> Eval a (Output a)
eGroup Bool
isMacro Formatting
formatting [Element a]
els = do
  -- A group is suppressed if it directly or indirectly
  -- calls at least one variable but all of the variables
  -- it calls are empty.
  VarCount Int
oldVars Int
oldNonempty <- (EvalState a -> VarCount)
-> RWST (Context a) (Set Text) (EvalState a) Identity VarCount
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount
  [Output a]
xs <- [[Output a]] -> [Output a]
forall a. Monoid a => [a] -> a
mconcat ([[Output a]] -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element a
 -> RWST (Context a) (Set Text) (EvalState a) Identity [Output a])
-> [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element a
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
els
  VarCount Int
newVars Int
newNonempty <- (EvalState a -> VarCount)
-> RWST (Context a) (Set Text) (EvalState a) Identity VarCount
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount
  -- see
  -- https://github.com/citation-style-language/documentation/blob/master/specification.rst#group
  -- "When a cs:group contains a child cs:macro, if the cs:macro is
  -- non-empty, it is treated as a non-empty variable for the purposes of
  -- determining suppression of the outer cs:group."
  Bool
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isMacro Bool -> Bool -> Bool
&& Bool -> Bool
not ((Output a -> Bool) -> [Output a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Output a -> Output a -> Bool
forall a. Eq a => a -> a -> Bool
== Output a
forall a. Output a
NullOutput) [Output a]
xs)) (RWST (Context a) (Set Text) (EvalState a) Identity ()
 -> RWST (Context a) (Set Text) (EvalState a) Identity ())
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a b. (a -> b) -> a -> b
$
    Int -> Int -> RWST (Context a) (Set Text) (EvalState a) Identity ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ if Int
oldVars Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
newVars Bool -> Bool -> Bool
|| Int
newNonempty Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
oldNonempty
              then Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
xs
              else Output a
forall a. Output a
NullOutput

eChoose :: CiteprocOutput a
        => [(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose :: [(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [] = [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
eChoose ((Match
match, [Condition]
conditions, [Element a]
els):[(Match, [Condition], [Element a])]
rest) = do
  Reference a
ref <- (EvalState a -> Reference a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Reference a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference
  Maybe Text
label <- (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLabel
  let disambiguate :: Bool
disambiguate = Bool
-> (DisambiguationData -> Bool) -> Maybe DisambiguationData -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False
                      DisambiguationData -> Bool
disambCondition (Reference a -> Maybe DisambiguationData
forall a. Reference a -> Maybe DisambiguationData
referenceDisambiguation Reference a
ref)
  [Position]
positions <- (Context a -> [Position])
-> RWST (Context a) (Set Text) (EvalState a) Identity [Position]
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> [Position]
forall a. Context a -> [Position]
contextPosition
  Bool
hasLocator <- Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Text -> Bool)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Context a -> Maybe Text)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
asks Context a -> Maybe Text
forall a. Context a -> Maybe Text
contextLocator
  let isNumeric :: Text -> Bool
isNumeric Text
t = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
        (\Text
chunk -> (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isDigit Text
chunk Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
chunk)) ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$
        (Char -> Bool) -> Text -> [Text]
T.split (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'&')
         (Text -> Text -> Text -> Text
T.replace Text
", " Text
"," (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"& " Text
"&" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
", " Text
"," (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t)
  let testCondition :: Condition -> Bool
testCondition Condition
cond =
        case Condition
cond of
           HasVariable Variable
"locator" -> Bool
hasLocator
           HasVariable Variable
t ->
             case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
               Just Val a
x  -> Val a -> Bool
forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty Val a
x
               Maybe (Val a)
Nothing -> Bool
False
           HasType Text
t -> Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
"type" Reference a
ref Maybe (Val a) -> Maybe (Val a) -> Bool
forall a. Eq a => a -> a -> Bool
== Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Text -> Val a
forall a. Text -> Val a
TextVal Text
t)
           IsUncertainDate Variable
t -> case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
                                  Just (DateVal Date
d) -> Date -> Bool
dateCirca Date
d
                                  Maybe (Val a)
_                -> Bool
False
           IsNumeric Variable
t -> case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
t Reference a
ref of
                            Just (NumVal Int
_)   -> Bool
True
                            Just (TextVal Text
x)  -> Text -> Bool
isNumeric Text
x
                            Just (FancyVal a
x) -> Text -> Bool
isNumeric (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x)
                            Maybe (Val a)
_                 -> Bool
False
           HasLocatorType Variable
t -> case Maybe Text
label of
                                 Just Text
"sub verbo" -> Variable
t Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"sub-verbo"
                                 Just Text
x -> Text -> Variable
toVariable Text
x Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
t
                                 Maybe Text
Nothing -> Variable
t Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
"page"
           HasPosition Position
pos -> Position
pos Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Position]
positions
           Condition
WouldDisambiguate -> Bool
disambiguate
  let matched :: Bool
matched = (case Match
match of
                   Match
MatchAll  -> (Condition -> Bool) -> [Condition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Condition -> Bool
testCondition
                   Match
MatchAny  -> (Condition -> Bool) -> [Condition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition -> Bool
testCondition
                   Match
MatchNone -> Bool -> Bool
not (Bool -> Bool) -> ([Condition] -> Bool) -> [Condition] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Condition -> Bool) -> [Condition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition -> Bool
testCondition) [Condition]
conditions
  if Bool
matched
     then [[Output a]] -> [Output a]
forall a. Monoid a => [a] -> a
mconcat ([[Output a]] -> [Output a])
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
-> Eval a [Output a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element a -> Eval a [Output a])
-> [Element a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [[Output a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element a -> Eval a [Output a]
forall a. CiteprocOutput a => Element a -> Eval a [Output a]
eElement [Element a]
els
     else [(Match, [Condition], [Element a])] -> Eval a [Output a]
forall a.
CiteprocOutput a =>
[(Match, [Condition], [Element a])] -> Eval a [Output a]
eChoose [(Match, [Condition], [Element a])]
rest


eNumber :: CiteprocOutput a => Variable -> NumberForm -> Eval a (Output a)
eNumber :: Variable -> NumberForm -> Eval a (Output a)
eNumber Variable
var NumberForm
nform = do
  Maybe (Val a)
mbv <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
var
  [(Term, Text)]
varTerms <- Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = Variable -> Text
fromVariable Variable
var }
  let mbGender :: Maybe TermGender
mbGender = case [(Term, Text)]
varTerms of
                   [] -> Maybe TermGender
forall a. Maybe a
Nothing
                   ((Term
t,Text
_):[(Term, Text)]
_) -> Term -> Maybe TermGender
termGender Term
t
  let nparts :: [Val a]
nparts = case Maybe (Val a)
mbv of
                 Just x :: Val a
x@NumVal{}   -> [Val a
x]
                 Just (FancyVal a
x) -> Text -> [Val a]
forall a. Text -> [Val a]
splitNums (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x)
                 Just (TextVal Text
t)  -> Text -> [Val a]
forall a. Text -> [Val a]
splitNums Text
t
                 Maybe (Val a)
_                 -> []
  [Output a] -> Output a
forall a. [Output a] -> Output a
grouped ([Output a] -> Output a)
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
-> Eval a (Output a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Val a -> Eval a (Output a))
-> [Val a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
nform Maybe TermGender
mbGender) [Val a]
nparts

evalNumber :: CiteprocOutput a
           => NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber :: NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
form Maybe TermGender
mbGender (NumVal Int
i) = do
  let numterm :: String -> t -> Term
numterm String
s t
x = Term
emptyTerm { termName :: Text
termName = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
s t
x
                              , termGenderForm :: Maybe TermGender
termGenderForm = Maybe TermGender
mbGender }
  let dectext :: Text
dectext = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
  let twomatch :: Term
twomatch = String -> Int -> Term
forall t. PrintfArg t => String -> t -> Term
numterm String
"ordinal-%02d" (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100)
  let onematch :: Term
onematch = String -> Int -> Term
forall t. PrintfArg t => String -> t -> Term
numterm String
"ordinal-%02d" (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10)
  let fallback :: Term
fallback = Term
emptyTerm { termName :: Text
termName = Text
"ordinal" }
  case NumberForm
form of
    NumberForm
NumberNumeric -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
dectext
    NumberForm
NumberOrdinal -> do
      [(Term, Text)]
res <- (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
99
                 then ((Term, Text) -> Bool) -> [(Term, Text)] -> [(Term, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Term
t,Text
_) -> Term -> Maybe TermMatch
termMatch Term
t Maybe TermMatch -> Maybe TermMatch -> Bool
forall a. Eq a => a -> a -> Bool
/= TermMatch -> Maybe TermMatch
forall a. a -> Maybe a
Just TermMatch
WholeNumber)
                 else [(Term, Text)] -> [(Term, Text)]
forall a. a -> a
id) ([(Term, Text)] -> [(Term, Text)])
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
twomatch
      case [(Term, Text)]
res of
        ((Term
_,Text
suff):[(Term, Text)]
_) ->
          Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff)
        [] -> do -- not an exact match
          [(Term, Text)]
res' <- (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10
                      then ((Term, Text) -> Bool) -> [(Term, Text)] -> [(Term, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Term
t,Text
_) ->
                             Maybe TermMatch -> Bool
forall a. Maybe a -> Bool
isNothing (Term -> Maybe TermMatch
termMatch Term
t) Bool -> Bool -> Bool
||
                             Term -> Maybe TermMatch
termMatch Term
t Maybe TermMatch -> Maybe TermMatch -> Bool
forall a. Eq a => a -> a -> Bool
== TermMatch -> Maybe TermMatch
forall a. a -> Maybe a
Just TermMatch
LastDigit)
                      else [(Term, Text)] -> [(Term, Text)]
forall a. a -> a
id) ([(Term, Text)] -> [(Term, Text)])
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
onematch
          case [(Term, Text)]
res' of
            ((Term
_,Text
suff):[(Term, Text)]
_) ->
              Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff)
            [] -> do
              [(Term, Text)]
res'' <- Term
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
fallback
              case [(Term, Text)]
res'' of
                ((Term
_,Text
suff):[(Term, Text)]
_) ->
                  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text
dectext Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff)
                [] -> do
                  Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text
"no ordinal suffix found for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dectext
                  Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i))
    NumberForm
NumberLongOrdinal
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
      , Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 -> do
        [(Term, Text)]
res <- Term
-> RWST
     (Context a) (Set Text) (EvalState a) Identity [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm (String -> Int -> Term
forall t. PrintfArg t => String -> t -> Term
numterm String
"long-ordinal-%02d" Int
i)
        case [(Term, Text)]
res of
          ((Term
_,Text
t):[(Term, Text)]
_) -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t
          []        -> NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal Maybe TermGender
mbGender (Int -> Val a
forall a. Int -> Val a
NumVal Int
i)
      | Bool
otherwise -> NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
forall a.
CiteprocOutput a =>
NumberForm -> Maybe TermGender -> Val a -> Eval a (Output a)
evalNumber NumberForm
NumberOrdinal Maybe TermGender
mbGender (Int -> Val a
forall a. Int -> Val a
NumVal Int
i)
    NumberForm
NumberRoman -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Int -> Text
toRomanNumeral Int
i
evalNumber NumberForm
_ Maybe TermGender
_ (TextVal Text
t) = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal (a -> Output a) -> a -> Output a
forall a b. (a -> b) -> a -> b
$ Text -> a
forall a. CiteprocOutput a => Text -> a
fromText Text
t
evalNumber NumberForm
_ Maybe TermGender
_ (FancyVal a
t) = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Output a -> Eval a (Output a)) -> Output a -> Eval a (Output a)
forall a b. (a -> b) -> a -> b
$ a -> Output a
forall a. a -> Output a
Literal a
t
evalNumber NumberForm
_ Maybe TermGender
_ Val a
_ = Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput


warn :: Text -> Eval a ()
warn :: Text -> Eval a ()
warn Text
t = Set Text -> Eval a ()
forall w (m :: * -> *) r s.
(Monoid w, Monad m) =>
w -> RWST r w s m ()
tell (Set Text -> Eval a ()) -> Set Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ Text -> Set Text
forall a. a -> Set a
Set.singleton Text
t

-- | Convert number < 4000 to lowercase roman numeral.
toRomanNumeral :: Int -> Text
toRomanNumeral :: Int -> Text
toRomanNumeral Int
x
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
x)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 = Text
"m" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1000)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
900  = Text
"cm" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
900)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
500  = Text
"d" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
500)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
400  = Text
"cd" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
400)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100  = Text
"c" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
90   = Text
"xc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
90)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50   = Text
"l"  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
40   = Text
"xl" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
40)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10   = Text
"x" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9    = Text
"ix"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5    = Text
"v" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = Text
"iv"
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = Text
"i" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
toRomanNumeral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Text
""
  | Bool
otherwise = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
x)

-- Gets variable while updating var count.
askVariable :: CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable :: Variable -> Eval a (Maybe (Val a))
askVariable Variable
"page-first" = do
  Maybe (Val a)
res <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable Variable
"page"
  case Maybe (Val a)
res of
    Just (TextVal Text
t)  ->
      Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Val a) -> Eval a (Maybe (Val a)))
-> Maybe (Val a) -> Eval a (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Val a -> Maybe (Val a)) -> Val a -> Maybe (Val a)
forall a b. (a -> b) -> a -> b
$ Text -> Val a
forall a. Text -> Val a
TextVal (Text -> Val a) -> Text -> Val a
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSepPunct) Text
t
    Just (FancyVal a
x) ->
      Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Val a) -> Eval a (Maybe (Val a)))
-> Maybe (Val a) -> Eval a (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Val a -> Maybe (Val a)) -> Val a -> Maybe (Val a)
forall a b. (a -> b) -> a -> b
$ Text -> Val a
forall a. Text -> Val a
TextVal (Text -> Val a) -> Text -> Val a
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSepPunct) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x
    Just (NumVal Int
n)   -> Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Val a) -> Eval a (Maybe (Val a)))
-> Maybe (Val a) -> Eval a (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just (Val a -> Maybe (Val a)) -> Val a -> Maybe (Val a)
forall a b. (a -> b) -> a -> b
$ Int -> Val a
forall a. Int -> Val a
NumVal Int
n
    Maybe (Val a)
_                 -> Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Val a)
forall a. Maybe a
Nothing
askVariable Variable
v = do
  Reference a
ref <- (EvalState a -> Reference a)
-> RWST (Context a) (Set Text) (EvalState a) Identity (Reference a)
forall (m :: * -> *) s a r w. Monad m => (s -> a) -> RWST r w s m a
gets EvalState a -> Reference a
forall a. EvalState a -> Reference a
stateReference
  case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
v Reference a
ref of
    Just Val a
x | Val a -> Bool
forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty Val a
x -> do
      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
1
      Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Val a) -> Eval a (Maybe (Val a)))
-> Maybe (Val a) -> Eval a (Maybe (Val a))
forall a b. (a -> b) -> a -> b
$ Val a -> Maybe (Val a)
forall a. a -> Maybe a
Just Val a
x
    Maybe (Val a)
_ -> do
      Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount Int
1 Int
0
      Maybe (Val a) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Val a)
forall a. Maybe a
Nothing

isNonEmpty :: CiteprocOutput a => Val a -> Bool
isNonEmpty :: Val a -> Bool
isNonEmpty (TextVal Text
t) = Bool -> Bool
not (Text -> Bool
T.null Text
t)
isNonEmpty (FancyVal a
x) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Monoid a => a
mempty
isNonEmpty (NamesVal []) = Bool
False
isNonEmpty (DateVal (Date [] Bool
_ Maybe Int
Nothing Maybe Text
Nothing)) = Bool
False
isNonEmpty Val a
_       = Bool
True

citationLabel :: Reference a -> Val a
citationLabel :: Reference a -> Val a
citationLabel Reference a
ref = Text -> Val a
forall a. Text -> Val a
TextVal Text
trigraph
 where
  trigraph :: Text
trigraph = Text
namepart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
datepart
  datepart :: Text
datepart = case Variable -> Map Variable (Val a) -> Maybe (Val a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
"issued" Map Variable (Val a)
varmap of
               Just (DateVal Date
d) -> Date -> Text
getYear Date
d
               Maybe (Val a)
_ -> Text
""
  namepart :: Text
namepart = if Variable
"author" Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
namevars
                then Variable -> Text
getNames Variable
"author"
                else case [Variable]
namevars of
                       (Variable
n:[Variable]
_) -> Variable -> Text
getNames Variable
n
                       [Variable]
_     -> Text
"Xyz"
  varmap :: Map Variable (Val a)
varmap = Reference a -> Map Variable (Val a)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref
  vars :: [Variable]
vars = Map Variable (Val a) -> [Variable]
forall k a. Map k a -> [k]
M.keys Map Variable (Val a)
varmap
  namevars :: [Variable]
namevars = [Variable
v | Variable
v <- [Variable]
vars, Variable -> VariableType
variableType Variable
v VariableType -> VariableType -> Bool
forall a. Eq a => a -> a -> Bool
== VariableType
NameVariable]
  getNames :: Variable -> Text
getNames Variable
var = case Variable -> Map Variable (Val a) -> Maybe (Val a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Variable
var Map Variable (Val a)
varmap of
                   Just (NamesVal [Name]
ns) ->
                     let x :: Int
x = case [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns of
                               Int
1  -> Int
4
                               Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 -> Int
1
                                 | Bool
otherwise -> Int
2
                     in [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                        (Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.take Int
x (Text -> Text) -> (Name -> Text) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (Name -> Maybe Text) -> Name -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Name -> Maybe Text
nameFamily)
                        (Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
take Int
4 [Name]
ns)
                   Maybe (Val a)
_ -> Text
""
  getYear :: Date -> Text
getYear Date
d = case Date -> [DateParts]
dateParts Date
d of
                (DateParts (Int
x:[Int]
_):[DateParts]
_) ->
                  String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100)
                [DateParts]
_ -> Text
""

removeDoubleSpaces :: Text -> Text
removeDoubleSpaces :: Text -> Text
removeDoubleSpaces = Text -> Text -> Text -> Text
T.replace Text
"  " Text
" "

endsWithSpace :: Text -> Bool
endsWithSpace :: Text -> Bool
endsWithSpace Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Text -> Char
T.last Text
t)

beginsWithSpace :: Text -> Bool
beginsWithSpace :: Text -> Bool
beginsWithSpace Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Text -> Char
T.head Text
t)