{-# 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 total' :: Int
total' nonempty' :: 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
$ \st :: 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 =
$WVarCount :: 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 :: Style a
style mblang :: Maybe Lang
mblang refs' :: [Reference a]
refs' citations :: [Citation a]
citations =
([Output a]
citationOs, [(Text, Output a)]
bibliographyOs, Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
warnings)
where
(refs :: [Reference a]
refs, refmap :: ReferenceMap a
refmap) = [Reference a] -> ([Reference a], ReferenceMap a)
forall a. [Reference a] -> ([Reference a], ReferenceMap a)
makeReferenceMap [Reference a]
refs'
((citationOs :: [Output a]
citationOs, bibliographyOs :: [(Text, Output a)]
bibliographyOs), warnings :: 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
$WContext :: 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 = \xs :: [SortKeyValue]
xs ys :: [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
}
$WEvalState :: 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 0 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 sortedIds :: [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
$ \st :: 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'
(\m :: Map ItemId (Reference a)
m (citeId :: ItemId
citeId, num :: 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 (\ref :: 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 "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))
"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 [1..]) }
addIfMissing :: a -> Maybe a -> Maybe a
addIfMissing x :: a
x Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
x
addIfMissing _ (Just x :: 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)
[(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 x :: Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
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 ", "
| 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
(bibCitations :: [Citation a]
bibCitations, bibSortKeyMap :: Map ItemId [SortKeyValue]
bibSortKeyMap) <-
case Style a -> Maybe (Layout a)
forall a. Style a -> Maybe (Layout a)
styleBibliography Style a
style of
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 biblayout :: 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
((\citeId :: 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
(\x :: ItemId
x y :: 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 Descending "citation-number":_)
-> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
(SortKeyMacro Descending
(Element (ENumber "citation-number" _) _:_) : _)
-> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
(SortKeyMacro Descending
(Element (EText (TextVariable _ "citation-number")) _:_): _)
-> [ItemId] -> [ItemId]
forall a. [a] -> [a]
reverse [ItemId]
sortedIds
_ -> [ItemId]
sortedIds
let bibCitations :: [Citation a]
bibCitations = (ItemId -> Citation a) -> [ItemId] -> [Citation a]
forall a b. (a -> b) -> [a] -> [b]
map (\ident :: 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 (\m :: Map ItemId [SortKeyValue]
m citeId :: 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 i1 :: CitationItem a
i1 i2 :: 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' :: 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
(\item1 :: CitationItem a
item1 item2 :: 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
Nothing -> [Output a]
cs
Just citeGroupDelim :: 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 x :: Output a
x y :: 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 SuppressAuthor cid' :: ItemId
cid') x :: 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 x :: 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 formattedCit :: Output a
formattedCit =
case Output a
formattedCit of
Formatted f :: Formatting
f
(x :: Output a
x@(Tagged (TagItem AuthorOnly _) _):xs :: [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 " "),
Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
xs])
Formatted f :: Formatting
f
(Formatted f' :: Formatting
f'
(x :: Output a
x@(Tagged (TagItem AuthorOnly _) _):xs :: [Output a]
xs) : ys :: [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 " "),
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
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 biblayout :: 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 :: 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 [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
>>= \bs :: [Output a]
bs ->
case StyleOptions -> Maybe SubsequentAuthorSubstitute
styleSubsequentAuthorSubstitute
(Style a -> StyleOptions
forall a. Style a -> StyleOptions
styleOptions Style a
style) of
Nothing -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
bs
Just subs :: 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
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
Nothing -> []
Just _ ->
[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 "" (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 t :: Text
t rule :: 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 (x :: Output a
x:xs :: [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 _ (x :: Output a
x:_)) =
case [([Name]
ns,Output a
r) | (Tagged (TagNames _ _ ns :: [Name]
ns) r :: Output a
r) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x] of
((ns :: [Name]
ns,r :: Output a
r) : _) -> ([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 _ = 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 _ _ _ [] = []
replaceMatch rule :: SubsequentAuthorSubstituteRule
rule replacement :: a
replacement (names :: [Name]
names, raw :: Output a
raw) (z :: Output a
z:zs :: [Output a]
zs) =
case Output a -> Maybe (Output a)
go Output a
z of
Nothing -> []
Just z' :: 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{} y :: 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 f :: Formatting
f (y :: Output a
y:ys :: [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 _ _ ns :: [Name]
ns) r :: 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
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
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
PartialEach ->
case [Name] -> [Name] -> Int
forall a p. (Eq a, Num p) => [a] -> [a] -> p
numberOfMatches [Name]
ns [Name]
names of
num :: Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
PartialFirst ->
case [Name] -> [Name] -> Int
forall a p. (Eq a, Num p) => [a] -> [a] -> p
numberOfMatches [Name]
ns [Name]
names of
num :: Int
num | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (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 1) Output a
y
_ -> Maybe (Output a)
forall a. Maybe a
Nothing
go _ = Maybe (Output a)
forall a. Maybe a
Nothing
replaceAll :: Output a -> Output a
replaceAll (Tagged (TagNames t' :: Variable
t' nf :: NamesFormat
nf ns' :: [Name]
ns') x :: 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 f' :: Formatting
f' xs :: [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)
_ -> a -> Output a
forall a. a -> Output a
Literal a
replacement
replaceAll x :: Output a
x = Output a
x
removeName :: Output a -> Output a
removeName (Tagged (TagName _) _) = Output a
forall a. Output a
NullOutput
removeName x :: Output a
x = Output a
x
replaceEach :: Output a -> Output a
replaceEach (Tagged (TagName n :: Name
n) _)
| 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 x :: Output a
x = Output a
x
replaceFirst :: Int -> Output a -> Output a
replaceFirst num :: Int
num x :: Output a
x@(Tagged (TagNames _ _ ns' :: [Name]
ns') _)
| 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 _num :: Int
_num x :: Output a
x = Output a
x
replaceName :: Name -> Output a -> Output a
replaceName name :: Name
name (Tagged (TagName n :: Name
n) _)
| 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 _ x :: Output a
x = Output a
x
numberOfMatches :: [a] -> [a] -> p
numberOfMatches (a :: a
a:as :: [a]
as) (b :: a
b:bs :: [a]
bs)
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = 1 p -> p -> p
forall a. Num a => a -> a -> a
+ [a] -> [a] -> p
numberOfMatches [a]
as [a]
bs
| Bool
otherwise = 0
numberOfMatches _ _ = 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 :: Style a
style bibSortKeyMap :: Map ItemId [SortKeyValue]
bibSortKeyMap citations :: [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 item :: 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 a :: Maybe Text
a b :: Maybe Int
b (i1 :: CitationItem a
i1:i2 :: CitationItem a
i2:is :: [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 a :: Maybe Text
a b :: Maybe Int
b is :: [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 _ _ ns :: [Name]
ns) _ <-
(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 1) [[Name]]
allNameGroups
[Output a]
allCites' <-
case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
Nothing -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites
Just ByCite -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output a]
allCites
Just rule :: GivenNameDisambiguationRule
rule -> do
let relevantNames :: [Name]
relevantNames =
case GivenNameDisambiguationRule
rule of
PrimaryNameWithInitials -> [Name]
primaryNames
PrimaryName -> [Name]
primaryNames
_ -> [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 (\name :: 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 names :: [Name]
names name :: 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
AllNamesWithInitials -> Maybe NameHints
forall a. Maybe a
Nothing
PrimaryNameWithInitials -> Maybe NameHints
forall a. Maybe a
Nothing
PrimaryName -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenNameIfPrimary
_ -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddGivenName
else
case GivenNameDisambiguationRule
rule of
PrimaryNameWithInitials -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
PrimaryName -> NameHints -> Maybe NameHints
forall a. a -> Maybe a
Just NameHints
AddInitialsIfPrimary
_ -> 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
(\names :: [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
> 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
name ->
case [Name] -> Name -> Maybe NameHints
toHint [Name]
names Name
name of
Just x :: 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
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
$ \st :: 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
(\d :: 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 ()
ambiguities :: [[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 cs :: [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 (\ctx :: Context a
ctx st :: 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 [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 mblang :: Maybe Lang
mblang strategy :: DisambiguationStrategy
strategy cs :: [Citation a]
cs ambiguities :: [[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
>>= (\as :: [[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
>>= (\as :: [[DisambData]]
as ->
(case DisambiguationStrategy -> Maybe GivenNameDisambiguationRule
disambiguateAddGivenNames DisambiguationStrategy
strategy of
Just 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
_ -> [[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
>>= (\as :: [[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 iid :: ItemId
iid = $WCitationItem :: 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 mblang :: Maybe Lang
mblang mbrule :: Maybe GivenNameDisambiguationRule
mbrule etAlMin :: Int
etAlMin xs :: [DisambData]
xs x :: DisambData
x =
(DisambData -> Bool) -> [DisambData] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\y :: 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 AllNames -> [Name] -> [Name]
forall a. a -> a
id
Just AllNamesWithInitials ->
(Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\name :: 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) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Maybe Text
nameGiven Name
name })
Just PrimaryName ->
\case
[] -> []
(z :: Name
z:zs :: [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
name{ nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing }) [Name]
zs
Just PrimaryNameWithInitials ->
\case
[] -> []
(z :: Name
z:zs :: [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) -> 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
name{ nameGiven :: Maybe Text
nameGiven = Maybe Text
forall a. Maybe a
Nothing }) [Name]
zs
Just ByCite -> [Name] -> [Name]
forall a. a -> a
id
_ -> (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (\name :: 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 mblang :: Maybe Lang
mblang mbrule :: Maybe GivenNameDisambiguationRule
mbrule bs :: [DisambData]
bs =
(case Maybe GivenNameDisambiguationRule
mbrule of
Just 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
_ -> [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 1
where
maxnames :: [DisambData] -> Int
maxnames = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 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 n :: Int
n as :: [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
+ 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
$ \st :: 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
+ 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 mblang :: Maybe Lang
mblang as :: [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 [] _ = [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 (\x :: 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 bibSortKeyMap' :: Map ItemId [SortKeyValue]
bibSortKeyMap' as :: [[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 a :: DisambData
a =
(DisambData -> DisambData -> Ordering)
-> [DisambData] -> [DisambData]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
(\item1 :: DisambData
item1 item2 :: 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 item :: ItemId
item suff :: 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
$ \st :: 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_ (\xs :: [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) [1..]) Set [DisambData]
groups
tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition :: [DisambData] -> Eval a ()
tryDisambiguateCondition as :: [DisambData]
as =
case [DisambData]
as of
[] -> () -> Eval a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
xs :: [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
$ \st :: 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 f :: DisambiguationData -> DisambiguationData
f r :: 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
Nothing -> DisambiguationData -> Maybe DisambiguationData
forall a. a -> Maybe a
Just
$WDisambiguationData :: 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 x :: 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 mblang :: Maybe Lang
mblang x :: Name
x y :: Name
y =
case (Name -> Maybe Text
nameGiven Name
x, Name -> Maybe Text
nameGiven Name
y) of
(Just x' :: Text
x', Just y' :: Text
y') ->
Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize Maybe Lang
mblang Bool
True Bool
False "" 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
y'
_ -> Bool
False
addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint :: Maybe Lang -> [Name] -> (ItemId, Name) -> Eval a (Maybe ItemId)
addNameHint mblang :: Maybe Lang
mblang names :: [Name]
names (item :: ItemId
item, name :: 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
_ -> 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
$ \st :: 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 hint :: NameHints
hint name :: 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
(\d :: 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 x :: 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
(\d :: 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 x :: 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
(\d :: 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 x :: 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
(\d :: 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
(\zs :: [DisambData]
zs ->
case [DisambData]
zs of
[] -> Maybe [DisambData]
forall a. Maybe a
Nothing
[_] -> Maybe [DisambData]
forall a. Maybe a
Nothing
(z :: DisambData
z:_) ->
case DisambData -> Text
ddRendered DisambData
z of
"" -> Maybe [DisambData]
forall a. Maybe a
Nothing
_ -> 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] -> Maybe [DisambData]
forall a. a -> Maybe a
Just [DisambData]
ys
_ -> 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 (\x :: DisambData
x y :: 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)]
xs :: [Output a]
xs =
[(ItemId
iid, Output a
x) | Tagged (TagItem NormalCite iid :: ItemId
iid) x :: 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 x :: 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 trm :: Term
trm) _ <- 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
== "ibid" ]
toDisambData :: CiteprocOutput a => (ItemId, Output a) -> DisambData
toDisambData :: (ItemId, Output a) -> DisambData
toDisambData (iid :: ItemId
iid, x :: 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 $WDisambData :: 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 _ _ ns :: [Name]
ns) _ : xs :: [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 (_ : xs :: [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 d :: Date
d) _ : xs :: [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 (_ : xs :: [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 citeGroupDelim :: Text
citeGroupDelim yearSuffixDelim :: Maybe Text
yearSuffixDelim afterCollapseDelim :: Maybe Text
afterCollapseDelim
collapsing :: Maybe Collapsing
collapsing (Formatted f :: Formatting
f xs :: [Output a]
xs) =
case Maybe Collapsing
collapsing of
Just 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 collapseType :: 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)
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 _ [] = []
groupWith isMatched :: Output a -> Output a -> Bool
isMatched (z :: Output a
z:zs :: [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
([],ys :: [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
(ws :: [Output a]
ws,ys :: [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 x :: 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 x :: 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 TagPrefix _) <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x]
hasSuffix :: Output a -> Bool
hasSuffix :: Output a -> Bool
hasSuffix x :: 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 TagSuffix _) <- 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 ys :: [Output a]
ys zs :: [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
>= 3
, Just yhead :: Output a
yhead <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
headMay [Output a]
ys
, Just ylast :: 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 ys :: [Output a]
ys zs :: [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 _ [] zs :: [Output a]
zs = [Output a]
zs
collapseGroup collapseType :: Collapsing
collapseType (y :: Output a
y:ys :: [Output a]
ys) zs :: [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 u :: 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 TagLocator _) <- 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 u :: Output a
u [] = [Output a
u]
addCGDelim u :: Output a
u us :: [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 x :: Output a
x y :: Output a
y
= case ([Int
c | Tagged (TagYearSuffix c :: Int
c) _ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
x],
[Int
d | Tagged (TagYearSuffix d :: Int
d) _ <- Output a -> [Output a]
forall on. Uniplate on => on -> [on]
universe Output a
y]) of
([c :: Int
c],[d :: 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
+ 1
_ -> Bool
False
rangifyGroup :: [Output a] -> Output a
rangifyGroup :: [Output a] -> Output a
rangifyGroup zs :: [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
>= 3
, Just zhead :: Output a
zhead <- [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
headMay [Output a]
zs
, Just zlast :: 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 [z :: Output a
z] = Output a
z
rangifyGroup zs :: [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 _ [x :: Output a
x] = Output a
x
yearSuffixGroup useRanges :: Bool
useRanges zs :: [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 CollapseYearSuffix zs :: [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
(cur :: [Output a]
cur, items :: [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 CollapseYearSuffixRanged zs :: [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
(cur :: [Output a]
cur, items :: [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 _ zs :: [Output a]
zs = [Output a]
zs
getDates :: Output a -> [Date]
getDates :: Output a -> [Date]
getDates x :: Output a
x = [Date
d | Tagged (TagDate d :: Date
d) _ <- 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 x :: Output a
x = [(DateParts -> Maybe Int) -> [DateParts] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (\case
DateParts (y :: Int
y:_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
y
_ -> 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 useRanges :: Bool
useRanges (cur :: [Output a]
cur, items :: [Output a]
items) item :: Output a
item =
case [Output a]
cur of
[] -> ([Output a
item], [Output a]
items)
(z :: Output a
z:zs :: [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 _) _) <- 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 _ _)
(Formatted _f1 :: Formatting
_f1 [Tagged (TagCitationNumber n1 :: Int
n1) _xs1 :: Output a
_xs1]))
(Tagged (TagItem _ _)
(Formatted _f2 :: Formatting
_f2 [Tagged (TagCitationNumber n2 :: Int
n2) _xs2 :: 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
+ 1
isAdjacentCitationNumber
(Tagged (TagItem _ _) (Tagged (TagCitationNumber n1 :: Int
n1) _xs1 :: Output a
_xs1))
(Tagged (TagItem _ _) (Tagged (TagCitationNumber n2 :: Int
n2) _xs2 :: 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
+ 1
isAdjacentCitationNumber _ _ = Bool
False
sameNames :: Output a -> Output a -> Bool
sameNames :: Output a -> Output a -> Bool
sameNames x :: Output a
x y :: 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 t1 :: Variable
t1 _nf1 :: NamesFormat
_nf1 ns1 :: [Name]
ns1) ws1 :: Output a
ws1),
Just (Tagged (TagNames t2 :: Variable
t2 _nf2 :: NamesFormat
_nf2 ns2 :: [Name]
ns2) ws2 :: 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{} _), Just (Tagged TagDate{} _))
-> Bool
True
_ -> Bool
False
extractTagged :: Output a -> Maybe (Output a)
extractTagged :: Output a -> Maybe (Output a)
extractTagged x :: Output a
x =
let items :: [Output a]
items = [Output a
y | y :: Output a
y@(Tagged (TagItem ty :: CitationItemType
ty _) _) <- 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]
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]
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 _ _ _ _ x :: Output a
x = Output a
x
takeSeq :: Show a => (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq :: (a -> a -> Bool) -> [a] -> ([a], [a])
takeSeq isAdjacent :: a -> a -> Bool
isAdjacent (x1 :: a
x1 : x2 :: a
x2 : rest :: [a]
rest)
| a -> a -> Bool
isAdjacent a
x1 a
x2 = (a
x1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
where (ys :: [a]
ys, zs :: [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 _ (y :: a
y:ys :: [a]
ys) = ([a
y], [a]
ys)
takeSeq _ [] = ([], [])
groupSuccessive :: Show a => (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive :: (a -> a -> Bool) -> [a] -> [[a]]
groupSuccessive isAdjacent :: a -> a -> Bool
isAdjacent zs :: [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
([],_) -> []
(xs :: [a]
xs,ys :: [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 :: Layout a
layout citeId :: 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 (\ctx :: Context a
ctx st :: 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 citeId :: ItemId
citeId (SortKeyMacro sortdir :: SortDirection
sortdir elts :: [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
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 ref :: 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 oldContext :: a
oldContext s :: EvalState a
s =
(a
oldContext, EvalState a
s{ stateReference :: Reference a
stateReference = Reference a
ref })
evalSortKey citeId :: ItemId
citeId (SortKeyVariable sortdir :: SortDirection
sortdir var :: 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
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 t :: 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 i :: 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 "%09d" Int
i]
Just (FancyVal x :: 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 ns :: [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]
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 d :: 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 c :: Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '’' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'ʾ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== 'ʿ'
compSortKeyValue :: (Text -> Text -> Ordering)
-> SortKeyValue
-> SortKeyValue
-> Ordering
compSortKeyValue :: (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue collate :: Text -> Text -> Ordering
collate sk1 :: SortKeyValue
sk1 sk2 :: SortKeyValue
sk2 =
case (SortKeyValue
sk1, SortKeyValue
sk2) of
(SortKeyValue _ Nothing, SortKeyValue _ Nothing) -> Ordering
EQ
(SortKeyValue _ Nothing, SortKeyValue _ (Just _)) -> Ordering
GT
(SortKeyValue _ (Just _), SortKeyValue _ Nothing) -> Ordering
LT
(SortKeyValue Ascending (Just t1 :: [Text]
t1), SortKeyValue Ascending (Just t2 :: [Text]
t2)) ->
[Text] -> [Text] -> Ordering
collateKey [Text]
t1 [Text]
t2
(SortKeyValue Descending (Just t1 :: [Text]
t1), SortKeyValue Descending (Just t2 :: [Text]
t2))->
[Text] -> [Text] -> Ordering
collateKey [Text]
t2 [Text]
t1
_ -> Ordering
EQ
where
collateKey :: [Text] -> [Text] -> Ordering
collateKey :: [Text] -> [Text] -> Ordering
collateKey [] [] = Ordering
EQ
collateKey [] (_:_) = Ordering
LT
collateKey (_:_) [] = Ordering
GT
collateKey (x :: Text
x:xs :: [Text]
xs) (y :: Text
y:ys :: [Text]
ys) =
case Text -> Text -> Ordering
collate Text
x Text
y of
EQ -> [Text] -> [Text] -> Ordering
collateKey [Text]
xs [Text]
ys
GT -> Ordering
GT
LT -> Ordering
LT
compSortKeyValues :: (Text -> Text -> Ordering)
-> [SortKeyValue]
-> [SortKeyValue]
-> Ordering
compSortKeyValues :: (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues _ [] [] = Ordering
EQ
compSortKeyValues _ [] (_:_) = Ordering
LT
compSortKeyValues _ (_:_) [] = Ordering
GT
compSortKeyValues collate :: Text -> Text -> Ordering
collate (x :: SortKeyValue
x:xs :: [SortKeyValue]
xs) (y :: SortKeyValue
y:ys :: [SortKeyValue]
ys) =
case (Text -> Text -> Ordering)
-> SortKeyValue -> SortKeyValue -> Ordering
compSortKeyValue Text -> Text -> Ordering
collate SortKeyValue
x SortKeyValue
y of
EQ -> (Text -> Text -> Ordering)
-> [SortKeyValue] -> [SortKeyValue] -> Ordering
compSortKeyValues Text -> Text -> Ordering
collate [SortKeyValue]
xs [SortKeyValue]
ys
GT -> Ordering
GT
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]
forall a b. Coercible a b => a -> b
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 [] = ""
go [y :: Int
y] = Int -> String
toYear Int
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "0000"
go [y :: Int
y,m :: 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 "%02d" Int
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "00"
go (y :: Int
y:m :: Int
m:d :: Int
d:_) = Int -> String
toYear Int
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf "%02d" Int
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> Int -> String
forall r. PrintfType r => String -> r
printf "%02d" Int
d
toYear :: Int -> String
toYear :: Int -> String
toYear y :: Int
y
| Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Int -> String
forall r. PrintfType r => String -> r
printf "N%09d" (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 "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 :: Layout a
layout (citationGroupNumber :: Int
citationGroupNumber, citation :: Citation a
citation) = do
let positionsInCitation :: [Int]
positionsInCitation =
case Citation a -> [CitationItem a]
forall a. Citation a -> [CitationItem a]
citationItems Citation a
citation of
(c :: CitationItem a
c:_) | CitationItem a -> CitationItemType
forall a. CitationItem a -> CitationItemType
citationItemType CitationItem a
c CitationItemType -> CitationItemType -> Bool
forall a. Eq a => a -> a -> Bool
== CitationItemType
AuthorOnly -> [0..]
_ -> [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 zs :: [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 ct :: CitationItemType
ct id' :: ItemId
id') (Formatted f :: Formatting
f ys :: [Output a]
ys)), Just _) ->
(\ys' :: [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 f :: Formatting
f ys :: [Output a]
ys), Just suff :: 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 "" (Formatting -> Maybe Text
formatSuffix Formatting
f) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suff) } [Output a]
ys]
| Bool
otherwise -> (\ys' :: [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]
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
Nothing -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
items
Just items' :: [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 (x :: Output a
x:xs :: [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, item :: 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 (\pref :: a
pref x :: 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 (\suff :: a
suff x :: 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
. (\x :: Output a
x -> case Output a
x of
NullOutput -> Output a
x
_ -> 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 t :: a
t | Bool
isNote
, ". " Text -> Text -> Bool
`T.isSuffixOf` a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
t
, Text -> Text -> Int
T.count " " (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
t) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
-> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
capitalizeInitialTerm
_ -> [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 SecondFieldAlignFlush -> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
secondFieldAlign
Just SecondFieldAlignMargin -> [Output a] -> [Output a]
forall a. [Output a] -> [Output a]
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 :: Layout a
layout (position :: [Position]
position, item :: 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
lang (Formatted f :: Formatting
f xs :: [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 _ x :: 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 ref :: 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
(\ctx :: Context a
ctx st :: 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 "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 "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 "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 "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 url :: Text
url (Tagged TagTitle x :: 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 _ x :: 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
Nothing -> [Output a]
xs
Just url :: 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 "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
Nothing -> [Output a]
xs'
Just lang :: 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'
Nothing -> do
Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ "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
<>
" 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
<> "?"]
updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap :: Int -> Citation a -> CitationItem a -> Eval a ()
updateRefMap citationGroupNumber :: Int
citationGroupNumber citation :: Citation a
citation item :: 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
Nothing -> () -> Eval a ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just n :: 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
$ \st :: 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
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
$ \st :: 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 (\ref :: 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 "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) }
_ -> () -> 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 citationGroupNumber :: Int
citationGroupNumber positionInCitation :: Int
positionInCitation citation :: Citation a
citation item :: 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
$ \st :: 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
[_] -> Bool
True
[x :: CitationItem a
x,y :: 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
_ -> 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 x :: 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]
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
forall a. Output a
NullOutput
removeNames x :: Output a
x = Output a
x
capitalizeInitialTerm :: [Output a] -> [Output a]
capitalizeInitialTerm :: [Output a] -> [Output a]
capitalizeInitialTerm [] = []
capitalizeInitialTerm (z :: Output a
z:zs :: [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 t :: Term
t) x :: 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 f :: Formatting
f xs :: [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 tg :: Tag
tg x :: 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 x :: 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 groupNum :: Int
groupNum mbNoteNum :: Maybe Int
mbNoteNum item :: CitationItem a
item posInGroup :: Int
posInGroup = do
Bool
inBibliography <- (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
if Bool
inBibliography
then [Position] -> Eval a [Position]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else Eval a [Position]
forall a w a. RWST (Context a) w (EvalState a) Identity [Position]
getPosition'
where
getPosition' :: RWST (Context a) w (EvalState a) Identity [Position]
getPosition' = 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)
w
(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) w (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
Nothing -> [Position] -> RWST (Context a) w (EvalState a) Identity [Position]
forall (m :: * -> *) a. Monad m => a -> m a
return [Position
FirstPosition]
Just (prevGroupNum :: Int
prevGroupNum, mbPrevNoteNum :: Maybe Int
mbPrevNoteNum,
prevPosInGroup :: Int
prevPosInGroup, prevAloneInGroup :: Bool
prevAloneInGroup,
prevLabel :: Maybe Text
prevLabel, prevLoc :: Maybe Text
prevLoc) -> do
Bool
isNote <- (Context a -> Bool)
-> RWST (Context a) w (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 5 (Maybe Int -> Int)
-> RWST (Context a) w (EvalState a) Identity (Maybe Int)
-> RWST (Context a) w (EvalState a) Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Context a -> Maybe Int)
-> RWST (Context a) w (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
Nothing -> Bool
True
Just s :: 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
<= 1
let prevAlone :: Bool
prevAlone = Bool
prevAloneInGroup Bool -> Bool -> Bool
&& Bool
prevAloneInNote
[Position] -> RWST (Context a) w (EvalState a) Identity [Position]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Position]
-> RWST (Context a) w (EvalState a) Identity [Position])
-> [Position]
-> RWST (Context a) w (EvalState a) Identity [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
+ 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
+ 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 1) Bool -> Bool -> Bool
&&
Int
posInGroup Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
(Nothing, Just _)
-> (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]
:)
(Nothing, Nothing) -> (Position
Ibid Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
:)
(Just _, Nothing) -> [Position] -> [Position]
forall a. a -> a
id
(Just l1 :: Text
l1, Just l2 :: 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 etype :: ElementType a
etype formatting :: Formatting
formatting) =
case ElementType a
etype of
EText textType :: 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 var :: Variable
var nform :: 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 isMacro :: Bool
isMacro els :: [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 chooseParts :: [(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 var :: Variable
var termform :: TermForm
termform pluralize :: 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 var :: Variable
var dateType :: DateType
dateType mbShowDateParts :: Maybe ShowDateParts
mbShowDateParts dps :: [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 vars :: [Variable]
vars namesFormat :: NamesFormat
namesFormat subst :: [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 Nothing Nothing Nothing Nothing Nothing Nothing
Nothing Nothing Nothing Nothing Nothing
False False False) p :: Eval a (Output a)
p
= Eval a (Output a)
p
withFormatting formatting :: Formatting
formatting p :: 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 "language" (Reference a -> Map Variable (Val a)
forall a. Reference a -> Map Variable (Val a)
referenceVariables Reference a
ref) of
Just (TextVal t :: 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 x :: 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 Lang
forall a. Maybe a
Nothing
let mainLangIsEn :: Maybe Lang -> Bool
mainLangIsEn Nothing = Bool
False
mainLangIsEn (Just l :: Lang
l) = Lang -> Text
langLanguage Lang
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "en"
let isEnglish :: Bool
isEnglish = case Maybe Lang
reflang of
Just l :: Lang
l -> Maybe Lang -> Bool
mainLangIsEn (Lang -> Maybe Lang
forall a. a -> Maybe a
Just Lang
l)
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
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 ts :: [(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
term',t :: Text
t) <- [(Term, Text)]
ts
, Term
term Term -> Term -> Bool
forall a. Ord a => a -> a -> Bool
<= Term
term'
]
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 = 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
VerbShort -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Verb }
Symbol -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Short }
Verb -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
Short -> Term -> Eval a (Output a)
forall a. CiteprocOutput a => Term -> Eval a (Output a)
lookupTerm' Term
term{ termForm :: TermForm
termForm = TermForm
Long }
_ -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
f xs :: [(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
((_,t :: 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
$
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)
x :: 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 = "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
(\c :: Char
c d :: Char
d -> Bool -> Bool
not (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '&' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' Bool -> Bool -> Bool
|| Char
d Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '&'))
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 " " }
([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
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
delim :: Output a
delim -> Output a
delim)) [Text]
ranges
enDash :: Char
enDash :: Char
enDash = '\x2013'
formatPageRange :: CiteprocOutput a
=> Maybe PageRangeFormat
-> Output a
-> Text
-> Output a
_ _ "&" = Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal "&"
formatPageRange _ _ "," = Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal ","
formatPageRange mbPageRangeFormat :: Maybe PageRangeFormat
mbPageRangeFormat delim :: Output a
delim t :: Text
t =
let isDash :: Char -> Bool
isDash '-' = Bool
True
isDash '\x2013' = Bool
True
isDash _ = Bool
False
rangeParts :: [Text]
rangeParts = if "\\-" Text -> Text -> Bool
`T.isInfixOf` Text
t
then [Text -> Text -> Text -> Text
T.replace "\\-" "-" 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 pref :: Text
pref xs :: [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 xs :: String
xs ys :: 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 ' ') String
ys
minimal :: Int -> Text -> Text -> Text -> Output a
minimal threshold :: Int
threshold pref :: Text
pref x :: Text
x y :: Text
y =
case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
x Text
y of
Just (_comm :: Text
_comm, _erstx :: Text
_erstx, resty :: 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]
Nothing -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y]
in case [Text]
rangeParts of
[] -> Output a
forall a. Output a
NullOutput
[w :: Text
w] -> Text -> Output a
forall a. CiteprocOutput a => Text -> Output a
literal Text
w
[w :: Text
w,v :: 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 fmt :: 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
PageRangeChicago
| Int
xlen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
| "00" Text -> Text -> Bool
`T.isSuffixOf` Text
x -> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
| Int -> Text -> Text
T.take 1 (Int -> Text -> Text
T.takeEnd 2 Text
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "0"
-> Int -> Text -> Text -> Text -> Output a
minimal 1 Text
pref Text
x Text
y'
| Int
xlen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
>= 3
-> Text -> [Text] -> Output a
inRange Text
pref [Text
x, Text
y']
| Bool
otherwise -> Int -> Text -> Text -> Text -> Output a
minimal 2 Text
pref Text
x Text
y'
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']
PageRangeMinimal -> Int -> Text -> Text -> Text -> Output a
minimal 1 Text
pref Text
x Text
y'
PageRangeMinimalTwo -> Int -> Text -> Text -> Text -> Output a
minimal 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 -> 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 varForm :: VariableForm
varForm v :: 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
"id" -> do
Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount 1 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
forall a b. Coercible a b => a -> b
coerce (ItemId -> Text) -> ItemId -> Text
forall a b. (a -> b) -> a -> b
$ Reference a -> ItemId
forall a. Reference a -> ItemId
referenceId Reference a
ref
"type" -> do
Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount 1 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
"locator" -> do
let handleAmpersands :: Maybe Text
-> RWST (Context a) (Set Text) (EvalState a) Identity (Maybe Text)
handleAmpersands (Just t :: Text
t) | (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='&') Text
t = do
[(Term, Text)]
ts <- Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = "and"
, termForm :: TermForm
termForm = TermForm
Symbol }
case [(Term, Text)]
ts of
(_,x :: Text
x):_ -> 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
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 x :: 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 x :: 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 "page" -> do
Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount 1 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 1 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
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 1 0
"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 x :: 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)))
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
"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 x :: 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))
_ -> do
Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ "citation-number not defined for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
ItemId -> Text
forall a b. Coercible a b => a -> b
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
"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 t :: 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 x :: 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
_ -> do
Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ "citation-label of unknown type for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
ItemId -> Text
forall a b. Coercible a b => a -> b
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
"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
"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
"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
"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
_ -> 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
<> "-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
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 :: 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 x :: Text
x)
| Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== "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 x :: a
x)
| Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== "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 x :: 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))
_ -> 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
== "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 (\st :: 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 f :: Text -> Text
f identConstr :: 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
Nothing -> Output b -> Eval b (Output b)
forall (m :: * -> *) a. Monad m => a -> m a
return Output b
forall a. Output a
NullOutput
Just t :: Text
t -> do
(EvalState b -> EvalState b) -> Eval b ()
forall (m :: * -> *) s r w. Monad m => (s -> s) -> RWST r w s m ()
modify (\st :: 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
$ \st :: EvalState a
st ->
EvalState a
st{ stateReference :: Reference a
stateReference =
let Reference id' :: ItemId
id' type' :: Text
type' d' :: Maybe DisambiguationData
d' m' :: 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 name :: 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
$ "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 t :: 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
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
== "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
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
t'
Just suff :: 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 " "), 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 t :: Text
t = case Text -> Maybe Int
readAsInt Text
t of
Just i :: Int
i -> Int -> Val a
forall a. Int -> Val a
NumVal Int
i
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
== "-"
then Char -> Text
T.singleton Char
enDash
else Text
t
sameClass :: Char -> Char -> Bool
sameClass c :: Char
c d :: 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 ',' = Bool
True
isSepPunct ';' = Bool
True
isSepPunct '-' = Bool
True
isSepPunct '\x2013' = Bool
True
isSepPunct _ = Bool
False
eLabel :: CiteprocOutput a
=> Variable
-> TermForm
-> Pluralize
-> Formatting
-> Eval a (Output a)
eLabel :: Variable
-> TermForm -> Pluralize -> Formatting -> Eval a (Output a)
eLabel var :: Variable
var termform :: TermForm
termform pluralize :: Pluralize
pluralize formatting :: 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 termname :: Text
termname x :: Val a
x = do
let determinePlural :: Text -> TermNumber
determinePlural t :: Text
t
| Variable
var Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== "number-of-volumes"
, Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "1" Bool -> Bool -> Bool
&& Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "0" = TermNumber
Plural
| "\\-" 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
> 1 = TermNumber
Plural
| Bool
otherwise = TermNumber
Singular
let number :: TermNumber
number = case Pluralize
pluralize of
AlwaysPluralize -> TermNumber
Plural
NeverPluralize -> TermNumber
Singular
ContextualPluralize ->
case Val a
x of
TextVal t :: Text
t -> Text -> TermNumber
determinePlural Text
t
FancyVal w :: a
w -> Text -> TermNumber
determinePlural (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
w)
NamesVal ns :: [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
> 1
then TermNumber
Plural
else TermNumber
Singular
_ -> 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
== "editortranslator" then "editor" else Variable
var
Output a
term' <- case (Variable
var, Maybe Text
locator, Maybe Text
label) of
("locator", Just loc :: Text
loc, Just lab :: 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)
("locator", Just loc :: Text
loc, 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 -> 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 "page" (Text -> Val a
forall a. Text -> Val a
TextVal Text
loc)
("page", Just loc :: Text
loc, _) ->
Text -> Val a -> Eval a (Output a)
forall a. CiteprocOutput a => Text -> Val a -> Eval a (Output a)
getTerm "page" (Text -> Val a
forall a. Text -> Val a
TextVal Text
loc)
_ -> case Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable Variable
var' Reference a
ref of
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
Just x :: 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 suff :: Text
suff
| "." Text -> Text -> Bool
`T.isPrefixOf` Text
suff
-> case Output a
term' of
Literal x :: a
x
| "." 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
<= 1
then Maybe Text
forall a. Maybe a
Nothing
else Text -> Maybe Text
forall a. a -> Maybe a
Just (Int -> Text -> Text
T.drop 1 Text
suff) }
[Output a
term']
_ -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a
term']
_ -> 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 var :: Variable
var dateType :: DateType
dateType mbShowDateParts :: Maybe ShowDateParts
mbShowDateParts dps :: [DP]
dps formatting :: 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 "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 newdps :: t DP
newdps olddp :: DP
olddp accum :: [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 x :: 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
Nothing -> DP
olddp DP -> [DP] -> [DP]
forall a. a -> [a] -> [a]
: [DP]
accum
let useDatePart :: DP -> Bool
useDatePart dp :: DP
dp =
case Maybe ShowDateParts
mbShowDateParts of
Just Year -> DP -> DPName
dpName DP
dp DPName -> DPName -> Bool
forall a. Eq a => a -> a -> Bool
== DPName
DPYear
Just 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
_ -> Bool
True
let (dps' :: [DP]
dps', formatting' :: Formatting
formatting') =
case Maybe (Element Text)
localeDateElt of
Just (Element (EDate _ _ _ edps :: [DP]
edps) f :: 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)
_ -> ((DP -> Bool) -> [DP] -> [DP]
forall a. (a -> Bool) -> [a] -> [a]
filter DP -> Bool
useDatePart [DP]
dps, Formatting
formatting)
case Maybe (Val a)
datevar of
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
date) ->
case Date -> Maybe Text
dateLiteral Date
date of
Just t :: 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]
Nothing -> do
let dateparts :: [DateParts]
dateparts = case Date -> Maybe Int
dateSeason Date
date of
Just i :: Int
i ->
case Date -> [DateParts]
dateParts Date
date of
[DateParts [y :: Int
y]] ->
[[Int] -> DateParts
DateParts [Int
y, 12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i]]
xs :: [DateParts]
xs -> [DateParts]
xs
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)
[d :: DateParts
d] -> (DateParts
d, Maybe DateParts
forall a. Maybe a
Nothing)
(d :: DateParts
d:e :: DateParts
e:_) -> (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 0 (-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 _ -> do
Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ "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 c :: 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
$ \st :: 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
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 dpSpecs :: [DP]
dpSpecs (date :: DateParts
date, mbNextDate :: Maybe DateParts
mbNextDate) = do
let (yr :: Maybe Int
yr,mo :: Maybe Int
mo,da :: Maybe Int
da) = DateParts -> (Maybe Int, Maybe Int, Maybe Int)
bindDateParts DateParts
date
case Maybe DateParts
mbNextDate of
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 nextDate :: DateParts
nextDate -> do
let (nextyr :: Maybe Int
nextyr,nextmo :: Maybe Int
nextmo,nextda :: 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 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 DPYear = (Maybe Int
yr, Maybe Int
nextyr)
dpToNs DPMonth = (Maybe Int
mo, Maybe Int
nextmo)
dpToNs 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 (sames1 :: [DP]
sames1, rest :: [DP]
rest) = (DP -> Bool) -> [DP] -> ([DP], [DP])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\dp :: 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 (diffs :: [DP]
diffs, sames2 :: [DP]
sames2) = (DP -> Bool) -> [DP] -> ([DP], [DP])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\dp :: 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 xs :: [Output a]
xs ys :: [Output a]
ys =
case [Output a] -> Maybe (Output a)
forall a. [a] -> Maybe a
lastMay [Output a]
xs of
Just xlast :: 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
_ -> [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 f :: Formatting
f xs :: [Output a]
xs : rest :: [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 xs :: [Output a]
xs = [Output a]
xs
removeLastSuffix :: [Output a] -> [Output a]
removeLastSuffix :: [Output a] -> [Output a]
removeLastSuffix [] = []
removeLastSuffix [Formatted f :: Formatting
f xs :: [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 (x :: Output a
x:xs :: [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 (yr :: Maybe Int
yr,mo :: Maybe Int
mo,da :: Maybe Int
da) dp :: DP
dp = do
let mbn :: Maybe Int
mbn = case DP -> DPName
dpName DP
dp of
DPDay -> Maybe Int
da
DPMonth -> Maybe Int
mo
DPYear -> Maybe Int
yr
case Maybe Int
mbn of
Nothing -> Output a -> Eval a (Output a)
forall (m :: * -> *) a. Monad m => a -> m a
return Output a
forall a. Output a
NullOutput
Just 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 n :: 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
DPYear
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 = "bc" }
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
, Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 = "ad" }
| Bool
otherwise -> [Output a]
-> RWST (Context a) (Set Text) (EvalState a) Identity [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> [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
DPYear -> Int -> Int
forall a. Num a => a -> a
abs Int
n
_ -> 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
DPNumeric -> String -> Eval a (Output a)
litStr (Int -> String
forall a. Show a => a -> String
show Int
n')
DPNumericLeadingZeros -> String -> Eval a (Output a)
litStr (String -> Int -> String
forall r. PrintfType r => String -> r
printf "%02d" Int
n')
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
/= 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')
form :: DPForm
form -> do
let termForMonth :: String -> Term
termForMonth s :: 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
DPMonth | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
<= 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 "month-%02d" Int
n)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 "season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12))
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 "season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 "season-%02d" (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 20))
_ -> 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 date :: DateParts
date =
case DateParts
date of
DateParts (y :: Int
y:m :: Int
m:d :: Int
d:_) -> (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 [y :: Int
y,m :: 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 [y :: 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)
_ -> (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 vars :: [Variable]
vars namesFormat' :: NamesFormat
namesFormat' subst :: [Element a]
subst formatting :: 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
Nothing -> NamesFormat
namesFormat'
Just subs :: NamesFormat
subs ->
$WNamesFormat :: 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 "editor" Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
vars Bool -> Bool -> Bool
&& "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 "editor"
Maybe (Val a)
tr <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable "translator"
let termform :: TermForm
termform =
case NamesFormat -> Maybe (TermForm, Pluralize, Formatting)
namesLabel NamesFormat
namesFormat of
Just (termform' :: TermForm
termform', _, _) -> TermForm
termform'
_ -> 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 = "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
$ "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
/= "editor"
, Variable
v Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
/= "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
nameFormat, nameFormatting' :: 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 (\var :: 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
== "editortranslator"
then "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@(_:_) | 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
(\ctx :: Context a
ctx st :: 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{} _:_) -> Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
formatting [Output a]
res
_ -> 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 "" 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]
_ -> 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
$ \st :: EvalState a
st ->
EvalState a
st{ stateReference :: Reference a
stateReference =
let Reference id' :: ItemId
id' type' :: Text
type' d' :: Maybe DisambiguationData
d' m' :: 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 | (v :: Variable
v, Just _) <- [(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
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
name) _ <- (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]
_ -> 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 els :: [Element a]
els =
case [Element a]
els of
[] -> [Output a] -> Eval a [Output a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
(e :: Element a
e:es :: [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
xs :: [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
namesFormat nameFormat :: NameFormat
nameFormat formatting :: Formatting
formatting (var :: Variable
var, Just (NamesVal names :: [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 (etAlMin :: Maybe Int
etAlMin, etAlUseFirst :: 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) [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 True, Just True) -> Text -> Text
T.strip Text
delim'
(Just True, _) -> Text -> Text
T.stripStart Text
delim'
(_, Just True) -> Text -> Text
T.stripEnd Text
delim'
_ -> 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
termform, pluralize :: Pluralize
pluralize, lf :: 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
_ -> [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 Symbol -> do
[(Term, Text)]
ts <- Term -> Eval a [(Term, Text)]
forall a. Term -> Eval a [(Term, Text)]
lookupTerm Term
emptyTerm { termName :: Text
termName = "and"
, termForm :: TermForm
termForm = TermForm
Symbol }
case [(Term, Text)]
ts of
(_,x :: 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
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 "&"
Just _ -> ((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 = "and"
, termForm :: TermForm
termForm = TermForm
Long }
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 "others"
let etAlUseLast :: Bool
etAlUseLast = NameFormat -> Bool
nameEtAlUseLast NameFormat
nameFormat
let etAlThreshold :: Maybe Int
etAlThreshold = case Maybe Int
etAlMin of
Just x :: 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 n :: Int
n, Just m :: 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)
(_, y :: 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
- 1)
_ -> Maybe Int
forall a. Maybe a
Nothing
let beforeLastDelim :: Text
beforeLastDelim =
case Maybe Text
mbAndTerm of
Nothing -> Text
delim
Just _ ->
case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesLast NameFormat
nameFormat of
PrecedesContextual
| Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 2 -> Text
delim
| Bool
otherwise -> ""
PrecedesAfterInvertedName
-> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
Just NameAsSortOrderAll -> Text
delim
Just NameAsSortOrderFirst
| Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 3 -> Text
delim
_ -> ""
PrecedesAlways -> Text
delim
PrecedesNever -> ""
let andPreSpace :: Text
andPreSpace = case Text
beforeLastDelim of
"" -> case Formatting -> Maybe Text
formatSuffix Formatting
formatting of
Just t :: Text
t | Text -> Bool
endsWithSpace Text
t -> ""
_ -> " "
t :: Text
t | Text -> Bool
endsWithSpace Text
t -> ""
_ -> " "
let andPostSpace :: Text
andPostSpace = case Formatting -> Maybe Text
formatPrefix Formatting
formatting of
Just t :: Text
t | Text -> Bool
beginsWithSpace Text
t -> ""
_ -> " "
let mbAndDelim :: Maybe Text
mbAndDelim = case Maybe Text
mbAndTerm of
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just t :: 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 t :: Text
t | Text -> Bool
endsWithSpace Text
t -> ""
_ -> " "
let beforeEtAl :: Text
beforeEtAl =
case NameFormat -> DelimiterPrecedes
nameDelimiterPrecedesEtAl NameFormat
nameFormat of
PrecedesContextual
| Int
numnames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 1 -> Text
delim
| Bool
otherwise -> Text
etAlPreSpace
PrecedesAfterInvertedName
-> case NameFormat -> Maybe NameAsSortOrder
nameAsSortOrder NameFormat
nameFormat of
Just NameAsSortOrderAll -> Text
delim
Just 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 2 -> Text
delim
_ -> Text
etAlPreSpace
PrecedesAlways -> Text
delim
PrecedesNever -> Text
etAlPreSpace
Output a
etAl <- case NamesFormat -> Maybe (Text, Formatting)
namesEtAl NamesFormat
namesFormat of
Just (term :: Text
term, f :: 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 }
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 "\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 = "et-al" }
let addNameAndDelim :: Output a -> Int -> Output a
addNameAndDelim name :: Output a
name idx :: 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 0 = Output a
forall a. Output a
NullOutput
| Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
- 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
- 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
- 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 "" 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' [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 _ _ _ (var :: Variable
var, Just _) = do
Text -> Eval a ()
forall a. Text -> Eval a ()
warn (Text -> Eval a ()) -> Text -> Eval a ()
forall a b. (a -> b) -> a -> b
$ "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 _ _ _ (_, 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
nameFormat formatting :: Formatting
formatting order :: Int
order name :: 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
Nothing -> NameFormat
nameFormat
Just AddInitials
-> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
Just AddInitialsIfPrimary
| Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName }
| Bool
otherwise -> NameFormat
nameFormat
Just AddGivenName ->
NameFormat
nameFormat{ nameForm :: NameForm
nameForm = NameForm
LongName
, nameInitialize :: Bool
nameInitialize = Bool
False
}
Just AddGivenNameIfPrimary
| Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 t :: 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]
(\f :: 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)
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
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
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
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]
_ -> [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 n :: 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 x :: Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
| Bool
otherwise =
let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
in String -> Text
T.pack [Int -> Char
chr (Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 26)),
Int -> Char
chr (Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 26))]
initialize :: Maybe Lang
-> Bool
-> Bool
-> Text
-> Text
-> Text
initialize :: Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize mblang :: Maybe Lang
mblang makeInitials :: Bool
makeInitials useHyphen :: Bool
useHyphen initializeWith :: 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
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
==' ') (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
==' ')
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
. (\(ws :: [Either Text Text]
ws,cs :: String
cs) ->
case String
cs of
[] -> [Either Text Text]
ws
[d :: 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
_ -> 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'
(\(ws :: [Either Text Text]
ws, cs :: String
cs) c :: Char
c ->
case Char
c of
'.' | 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, [])
'-' | 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. 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, ['-'])
' ' -> case String
cs of
[] -> ([Either Text Text]
ws, String
cs)
[d :: 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, [])
_ -> (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]
ws, Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs))
([], String
forall a. Monoid a => a
mempty)
addSuffix :: Text -> Text
addSuffix t :: 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 t :: Text
t =
case Text -> Maybe (Char, Text)
T.uncons Text
t of
Just ('-', t' :: Text
t') ->
case Text -> Maybe (Char, Text)
T.uncons Text
t' of
Just (c :: Char
c, _)
| Char -> Bool
isUpper Char
c
, Bool
useHyphen -> "-" 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)
_ -> Text
forall a. Monoid a => a
mempty
Just (c :: Char
c, t' :: Text
t')
| Char -> Bool
isUpper Char
c ->
case Text -> Maybe (Char, Text)
T.uncons Text
t' of
Just (d :: Char
d, t'' :: 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)
_ -> Char -> Text
T.singleton Char
c
_ -> Text
t
initializeWord :: Either Text Text -> Text
initializeWord (Left t :: Text
t)
= Text -> Text
addSuffix Text
t
initializeWord (Right t :: 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
<> " "
else " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " "
| 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
<> " "
getDisplayName :: CiteprocOutput a
=> NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName :: NameFormat -> Formatting -> Int -> Name -> Eval a (Output a)
getDisplayName nameFormat :: NameFormat
nameFormat formatting :: Formatting
formatting order :: Int
order name :: 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
Nothing -> Text -> Text
forall a. a -> a
id
Just _ ->
case NameFormat -> Maybe Text
nameInitializeWith NameFormat
nameFormat of
Just initializeWith :: Text
initializeWith ->
Maybe Lang -> Bool -> Bool -> Text -> Text -> Text
initialize
Maybe Lang
mblang
(NameFormat -> Bool
nameInitialize NameFormat
nameFormat)
Bool
initializeWithHyphen
Text
initializeWith
Nothing -> Text -> Text
forall a. a -> a
id
let separator :: Text
separator = NameFormat -> Text
nameSortSeparator NameFormat
nameFormat
let x :: Output a
x <+> :: Output a -> Output a -> Output a
<+> NullOutput = Output a
x
NullOutput <+> x :: Output a
x = Output a
x
Literal x :: a
x <+> y :: Output a
y =
case Text -> Maybe (Text, Char)
T.unsnoc (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x) of
Just (_, c :: Char
c) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '’' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\x2013' Bool -> Bool -> Bool
||
Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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]
_ | 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 " " } [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 f :: Formatting
f x :: [Output a]
x <+> y :: 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 t :: Text
t | Text -> Bool
endsWithSpace Text
t -> Maybe Text
forall a. Maybe a
Nothing
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just " " } [Formatting -> [Output a] -> Output a
forall a. Formatting -> [Output a] -> Output a
formatted Formatting
f [Output a]
x, Output a
y]
Linked i :: Text
i x :: [Output a]
x <+> y :: 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 -> [Output a] -> Output a
forall a. Text -> [Output a] -> Output a
Linked Text
i [Output a]
x, Output a
y]
Tagged _ x :: Output a
x <+> y :: Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
InNote x :: Output a
x <+> y :: Output a
y = Output a
x Output a -> Output a -> Output a
<+> Output a
y
let x :: Output a
x <:> :: Output a -> Output a -> Output a
<:> NullOutput = Output a
x
NullOutput <:> x :: Output a
x = Output a
x
Literal x :: a
x <:> y :: 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 f :: Formatting
f x :: [Output a]
x <:> y :: 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 i :: Text
i x :: [Output a]
x <:> y :: 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 _ x :: Output a
x <:> y :: Output a
y = Output a
x Output a -> Output a -> Output a
<:> Output a
y
InNote x :: Output a
x <:> y :: 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
Nothing -> Formatting
forall a. Monoid a => a
mempty
Just f :: 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
Nothing -> Formatting
forall a. Monoid a => a
mempty
Just f :: 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
Nothing -> Formatting
forall a. Monoid a => a
mempty
Just f :: 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
Nothing -> Formatting
forall a. Monoid a => a
mempty
Just f :: 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 NameAsSortOrderAll -> Bool
True
Just NameAsSortOrderFirst -> Int
order Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
_ -> 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
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 ]
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 ]
CountName -> Output a
forall a. Output a
NullOutput
else
case NameFormat -> NameForm
nameForm NameFormat
nameFormat of
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 ] ]
ShortName -> [Output a] -> Output a
forall a. [Output a] -> Output a
familyAffixes
[ Output a
family ]
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 isMacro :: Bool
isMacro formatting :: Formatting
formatting els :: [Element a]
els = do
VarCount oldVars :: Int
oldVars oldNonempty :: 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 newVars :: Int
newVars newNonempty :: 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 1 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
match, conditions :: [Condition]
conditions, els :: [Element a]
els):rest :: [(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 t :: Text
t = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
(\chunk :: 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 (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ',' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '&')
(Text -> Text -> Text -> Text
T.replace ", " "," (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 b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace ", " "," (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
t)
let testCondition :: Condition -> Bool
testCondition cond :: Condition
cond =
case Condition
cond of
HasVariable "locator" -> Bool
hasLocator
HasVariable t :: 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 x :: Val a
x -> Val a -> Bool
forall a. CiteprocOutput a => Val a -> Bool
isNonEmpty Val a
x
Nothing -> Bool
False
HasType t :: Text
t -> Variable -> Reference a -> Maybe (Val a)
forall a.
CiteprocOutput a =>
Variable -> Reference a -> Maybe (Val a)
lookupVariable "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 t :: 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 d :: Date
d) -> Date -> Bool
dateCirca Date
d
_ -> Bool
False
IsNumeric t :: 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 _) -> Bool
True
Just (TextVal x :: Text
x) -> Text -> Bool
isNumeric Text
x
Just (FancyVal x :: a
x) -> Text -> Bool
isNumeric (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x)
_ -> Bool
False
HasLocatorType t :: Variable
t -> case Maybe Text
label of
Just "sub verbo" -> Variable
t Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== "sub-verbo"
Just x :: Text
x -> Text -> Variable
toVariable Text
x Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== Variable
t
Nothing -> Variable
t Variable -> Variable -> Bool
forall a. Eq a => a -> a -> Bool
== "page"
HasPosition pos :: Position
pos -> Position
pos Position -> [Position] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Position]
positions
WouldDisambiguate -> Bool
disambiguate
let matched :: Bool
matched = (case Match
match of
MatchAll -> (Condition -> Bool) -> [Condition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Condition -> Bool
testCondition
MatchAny -> (Condition -> Bool) -> [Condition] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Condition -> Bool
testCondition
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 var :: Variable
var nform :: 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
((t :: Term
t,_):_) -> 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 x :: a
x) -> Text -> [Val a]
forall a. Text -> [Val a]
splitNums (a -> Text
forall a. CiteprocOutput a => a -> Text
toText a
x)
Just (TextVal t :: Text
t) -> Text -> [Val a]
forall a. Text -> [Val a]
splitNums Text
t
_ -> []
[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 form :: NumberForm
form mbGender :: Maybe TermGender
mbGender (NumVal i :: Int
i) = do
let numterm :: String -> t -> Term
numterm s :: String
s x :: 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 "ordinal-%02d" (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 100)
let onematch :: Term
onematch = String -> Int -> Term
forall t. PrintfArg t => String -> t -> Term
numterm "ordinal-%02d" (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 10)
let fallback :: Term
fallback = Term
emptyTerm { termName :: Text
termName = "ordinal" }
case NumberForm
form of
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
NumberOrdinal -> do
[(Term, Text)]
res <- (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 99
then ((Term, Text) -> Bool) -> [(Term, Text)] -> [(Term, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(t :: Term
t,_) -> 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
((_,suff :: Text
suff):_) ->
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
> 10
then ((Term, Text) -> Bool) -> [(Term, Text)] -> [(Term, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(t :: Term
t,_) ->
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
((_,suff :: Text
suff):_) ->
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
((_,suff :: Text
suff):_) ->
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
$ "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))
NumberLongOrdinal
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1
, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 "long-ordinal-%02d" Int
i)
case [(Term, Text)]
res of
((_,t :: 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
[] -> 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)
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 _ _ (TextVal t :: 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 _ _ (FancyVal t :: 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 _ _ _ = 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 t :: 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 x :: Int
x
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4000 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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
>= 1000 = "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
- 1000)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 900 = "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
- 900)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 500 = "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
- 500)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 400 = "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
- 400)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 100 = "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
- 100)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 90 = "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
- 90)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 50 = "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
- 50)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 40 = "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
- 40)
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10 = "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
- 10)
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 9 = "ix"
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 5 = "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
- 5)
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 4 = "iv"
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 = "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
- 1)
| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
| 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 "page-first" = do
Maybe (Val a)
res <- Variable -> Eval a (Maybe (Val a))
forall a. CiteprocOutput a => Variable -> Eval a (Maybe (Val a))
askVariable "page"
case Maybe (Val a)
res of
Just (TextVal t :: 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 x :: 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 n :: 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) -> Eval a (Maybe (Val a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Val a)
forall a. Maybe a
Nothing
askVariable v :: 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 x :: 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 1 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
_ -> do
Int -> Int -> Eval a ()
forall a. Int -> Int -> Eval a ()
updateVarCount 1 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 t :: Text
t) = Bool -> Bool
not (Text -> Bool
T.null Text
t)
isNonEmpty (FancyVal x :: 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 [] _ Nothing Nothing)) = Bool
False
isNonEmpty _ = Bool
True
citationLabel :: Reference a -> Val a
citationLabel :: Reference a -> Val a
citationLabel ref :: 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 "issued" Map Variable (Val a)
varmap of
Just (DateVal d :: Date
d) -> Date -> Text
getYear Date
d
_ -> ""
namepart :: Text
namepart = if "author" Variable -> [Variable] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Variable]
namevars
then Variable -> Text
getNames "author"
else case [Variable]
namevars of
(n :: Variable
n:_) -> Variable -> Text
getNames Variable
n
_ -> "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 var :: 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 ns :: [Name]
ns) ->
let x :: Int
x = case [Name] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
ns of
1 -> 4
n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 -> 1
| Bool
otherwise -> 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 "" (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 4 [Name]
ns)
_ -> ""
getYear :: Date -> Text
getYear d :: Date
d = case Date -> [DateParts]
dateParts Date
d of
(DateParts (x :: Int
x:_):_) ->
String -> Text
T.pack (String -> Int -> String
forall r. PrintfType r => String -> r
printf "%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` 100)
_ -> ""
removeDoubleSpaces :: Text -> Text
removeDoubleSpaces :: Text -> Text
removeDoubleSpaces = Text -> Text -> Text -> Text
T.replace " " " "
endsWithSpace :: Text -> Bool
endsWithSpace :: Text -> Bool
endsWithSpace t :: 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 t :: Text
t = Bool -> Bool
not (Text -> Bool
T.null Text
t) Bool -> Bool -> Bool
&& Char -> Bool
isSpace (Text -> Char
T.head Text
t)