{-# 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)
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
}
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)
, EvalState a -> Map Int (Set ItemId)
stateNoteMap :: M.Map Int (Set.Set ItemId)
, EvalState a -> ReferenceMap a
stateRefMap :: ReferenceMap a
, EvalState a -> Reference a
stateReference :: Reference a
, EvalState a -> Bool
stateUsedYearSuffix :: Bool
, EvalState a -> Bool
stateUsedIdentifier :: Bool
, EvalState a -> Bool
stateUsedTitle :: Bool
} 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{ variablesAccessed :: VarCount -> Int
variablesAccessed = Int
total
, variablesNonempty :: VarCount -> Int
variablesNonempty = Int
nonempty } = EvalState a -> VarCount
forall a. EvalState a -> VarCount
stateVarCount EvalState a
st
in EvalState a
st{ stateVarCount :: VarCount
stateVarCount =
VarCount :: Int -> Int -> VarCount
VarCount { variablesAccessed :: Int
variablesAccessed = Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
total',
variablesNonempty :: Int
variablesNonempty = Int
nonempty Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nonempty' } }
evalStyle :: CiteprocOutput a
=> Style a
-> Maybe Lang
-> [Reference a]
-> [Citation a]
-> ([Output a], [(Text, Output a)], [Text])
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
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)
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
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
| 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
[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
[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)
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
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
[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 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
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)
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
(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
(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'
[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
$
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
_)
| 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
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)]
let removeAffix :: CitationItem a -> CitationItem a
removeAffix CitationItem a
item = CitationItem a
item{ citationItemLabel :: Maybe Text
citationItemLabel = Maybe Text
forall a. Maybe a
Nothing
, citationItemLocator :: Maybe Text
citationItemLocator = Maybe Text
forall a. Maybe a
Nothing
, citationItemPrefix :: Maybe a
citationItemPrefix = Maybe a
forall a. Maybe a
Nothing
, citationItemSuffix :: Maybe a
citationItemSuffix = Maybe a
forall a. Maybe a
Nothing }
let cleanCitation :: Citation a -> Citation a
cleanCitation (Citation Maybe Text
a Maybe Int
b (CitationItem a
i1:CitationItem a
i2:[CitationItem a]
is))
| CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i1 CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly
, CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
i2 CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
SuppressAuthor
= Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b
((CitationItem a -> CitationItem a)
-> [CitationItem a] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> CitationItem a
forall a a. CitationItem a -> CitationItem a
removeAffix (CitationItem a
i2{ citationItemType :: CitationItemType
citationItemType = CitationItemType
NormalCite }CitationItem a -> [CitationItem a] -> [CitationItem a]
forall a. a -> [a] -> [a]
:[CitationItem a]
is))
cleanCitation (Citation Maybe Text
a Maybe Int
b [CitationItem a]
is)
= Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
a Maybe Int
b ((CitationItem a -> CitationItem a)
-> [CitationItem a] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map CitationItem a -> CitationItem a
forall a a. CitationItem a -> CitationItem a
removeAffix [CitationItem a]
is)
let citations' :: [Citation a]
citations' = (Citation a -> Citation a) -> [Citation a] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map Citation a -> Citation a
forall a a. Citation a -> Citation a
cleanCitation [Citation a]
citations [Citation a] -> [Citation a] -> [Citation a]
forall a. [a] -> [a] -> [a]
++
[Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
forall a. Maybe Text -> Maybe Int -> [CitationItem a] -> Citation a
Citation Maybe Text
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ((ItemId -> CitationItem a) -> [ItemId] -> [CitationItem a]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> CitationItem a
forall a. ItemId -> CitationItem a
basicItem [ItemId]
ghostItems)]
[Output a]
allCites <- [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
forall a. [Citation a]
citations'
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
Just GivenNameDisambiguationRule
rule -> do
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
(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 }
[Citation a] -> Eval a [Output a]
renderCitations [Citation a]
forall a. [Citation a]
citations'
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
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
forall a. [Citation a]
citations' [[DisambData]]
ambiguities
[Citation a] -> Eval a [Output a]
renderCitations [Citation a]
citations
where
renderCitations :: [Citation a] -> Eval a [Output a]
renderCitations :: [Citation a] -> Eval a [Output a]
renderCitations [Citation a]
cs =
(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]
cs)
refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities :: [Citation a] -> Eval a [[DisambData]]
refreshAmbiguities = ([Output a] -> [[DisambData]])
-> Eval a [Output a] -> Eval a [[DisambData]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Output a] -> [[DisambData]]
forall a. CiteprocOutput a => [Output a] -> [[DisambData]]
getAmbiguities (Eval a [Output a] -> Eval a [[DisambData]])
-> ([Citation a] -> Eval a [Output a])
-> [Citation a]
-> Eval a [[DisambData]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Citation a] -> Eval a [Output a]
renderCitations
analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> Eval a ()
analyzeAmbiguities :: Maybe Lang
-> DisambiguationStrategy
-> [Citation a]
-> [[DisambData]]
-> RWST (Context a) (Set Text) (EvalState a) Identity ()
analyzeAmbiguities Maybe Lang
mblang DisambiguationStrategy
strategy [Citation a]
cs [[DisambData]]
ambiguities = do
[[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
[Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
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
[Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
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
[Citation a] -> Eval a [[DisambData]]
refreshAmbiguities [Citation a]
cs
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
-> [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
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
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
[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
. ((ItemId, Output a) -> DisambData)
-> [(ItemId, Output a)] -> [DisambData]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, Output a) -> DisambData
forall a. CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData
([(ItemId, Output a)] -> [DisambData])
-> ([Output a] -> [(ItemId, Output a)])
-> [Output a]
-> [DisambData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output a] -> [(ItemId, Output a)]
forall a. [Output a] -> [(ItemId, Output a)]
extractTagItems
extractTagItems :: [Output a] -> [(ItemId, Output a)]
[Output a]
xs =
[(ItemId
iid, Output a
x) | Tagged (TagItem CitationItemType
NormalCite ItemId
iid) Output a
x <- (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
, Bool -> Bool
not (Output a -> Bool
forall a. Output a -> Bool
hasIbid Output a
x)]
where
hasIbid :: Output a -> Bool
hasIbid Output a
x = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Term] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ Term
trm | Tagged (TagTerm Term
trm) Output a
_ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x
, Term -> Text
termName Term
trm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ibid" ]
toDisambData :: CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData :: (ItemId, Output a) -> DisambData
toDisambData (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 DisambData :: ItemId -> [Name] -> [Date] -> Text -> DisambData
DisambData { ddItem :: ItemId
ddItem = ItemId
iid
, ddNames :: [Name]
ddNames = [Name]
ns'
, ddDates :: [Date]
ddDates = [Date]
ds'
, ddRendered :: Text
ddRendered = 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 [] = []
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]]
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]]
groupWith Output a -> Output a -> Bool
sameNames [Output a]
xs)
where
groupWith :: (Output a -> Output a -> Bool)
-> [Output a]
-> [[Output a]]
groupWith :: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
_ [] = []
groupWith Output a -> Output a -> Bool
isMatched (Output a
z:[Output a]
zs)
| Output a -> Bool
hasSuffix Output a
z = [Output a
z] [Output a] -> [[Output a]] -> [[Output a]]
forall a. a -> [a] -> [a]
: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched [Output a]
zs
| Bool
otherwise =
case (Output a -> Bool) -> [Output a] -> ([Output a], [Output a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Output a -> Bool
hasNoPrefixOrSuffix [Output a]
zs of
([],[Output a]
ys) -> [Output a
z] [Output a] -> [[Output a]] -> [[Output a]]
forall a. a -> [a] -> [a]
: (Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched [Output a]
ys
([Output a]
ws,[Output a]
ys) ->
(Output a
z Output a -> [Output a] -> [Output a]
forall a. a -> [a] -> [a]
: (Output a -> Bool) -> [Output a] -> [Output a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Output a -> Output a -> Bool
isMatched Output a
z) [Output a]
ws) [Output a] -> [[Output a]] -> [[Output a]]
forall a. a -> [a] -> [a]
:
(Output a -> Output a -> Bool) -> [Output a] -> [[Output a]]
groupWith Output a -> Output a -> Bool
isMatched ((Output a -> Bool) -> [Output a] -> [Output a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Output a -> Bool) -> Output a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output a -> Output a -> Bool
isMatched Output a
z) [Output a]
ws [Output a] -> [Output a] -> [Output a]
forall a. [a] -> [a] -> [a]
++ [Output a]
ys)
hasNoPrefixOrSuffix :: Output a -> Bool
hasNoPrefixOrSuffix :: Output a -> Bool
hasNoPrefixOrSuffix Output a
x = Bool -> Bool
not (Output a -> Bool
hasPrefix Output a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (Output a -> Bool
hasSuffix Output a
x)
hasPrefix :: Output a -> Bool
hasPrefix :: Output a -> Bool
hasPrefix Output a
x = 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
y | y :: Output a
y@(Tagged Tag
TagPrefix Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x]
hasSuffix :: Output a -> Bool
hasSuffix :: Output a -> Bool
hasSuffix Output a
x = 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
y | y :: Output a
y@(Tagged Tag
TagSuffix Output a
_) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x]
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
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)
(Just (Tagged TagDate{} Output a
_), Just (Tagged TagDate{} Output a
_))
-> Bool
True
(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
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 (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toCaseFold
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
'ʿ'
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
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
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))
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)
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 -> Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagPrefix ([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 -> Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged Tag
TagSuffix ([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
-> [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
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)
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
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
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
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
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)
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 ->
(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 }
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 (TagTerm Term
t) Output a
x) =
Tag -> Output a -> Output a
forall a. Tag -> Output a -> Output a
Tagged (Term -> Tag
TagTerm Term
t)
(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
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 [] =
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)
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
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
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 ->
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
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 })
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
(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 ->
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 (Term -> Tag
TagTerm Term
term) Output a
t''
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)
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
| 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 ->
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]]
[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
$
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
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
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
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 ->
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 ->
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 ->
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
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) (NamesFormat -> Maybe (NameFormat, Formatting)
namesName NamesFormat
namesFormat)
let nameFormatting :: Formatting
nameFormatting = Formatting
nameFormatting' Formatting -> Formatting -> Formatting
forall a. Semigroup a => a -> a -> a
<>
Formatting
formatting{ formatPrefix :: Maybe Text
formatPrefix = Maybe Text
forall a. Maybe a
Nothing
, formatSuffix :: Maybe Text
formatSuffix = Maybe Text
forall a. Maybe a
Nothing
, formatDelimiter :: Maybe Text
formatDelimiter = Maybe Text
forall a. Maybe a
Nothing }
[(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
[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 ->
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
forall a. Monoid a => a
mempty{ formatPrefix :: Maybe Text
formatPrefix = Formatting -> Maybe Text
formatPrefix Formatting
formatting
, formatSuffix :: Maybe Text
formatSuffix = Formatting -> Maybe Text
formatSuffix Formatting
formatting
, formatDelimiter :: Maybe Text
formatDelimiter =
Formatting -> Maybe Text
formatDelimiter 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"
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 "]
| 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..]
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
-> Bool
-> Text
-> 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
' ')
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
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
, 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)
= Text -> Text
addSuffix Text
t
initializeWord (Right Text
t)
| (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
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
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
[(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
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)
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)