{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
module Text.CSL.Eval.Names where
import Prelude
import Control.Monad.State
import Data.Char (isLower, isUpper)
import Data.List (intersperse, nub)
import Data.List.Split (wordsBy)
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.CSL.Eval.Common
import Text.CSL.Eval.Output
import Text.CSL.Style
import Text.CSL.Util (headInline, isRange, lastInline, query,
readNum, splitStrWhen, toRead, (<^>))
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Definition
import Text.Pandoc.Shared (stringify)
evalNames :: Bool -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames :: Bool -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames Bool
skipEdTrans [Text]
ns [Name]
nl Text
d
| [Text
sa,Text
sb] <- [Text]
ns, Bool -> Bool
not Bool
skipEdTrans
, (Text
sa Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"editor" Bool -> Bool -> Bool
&& Text
sb Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"translator") Bool -> Bool -> Bool
||
(Text
sb Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"editor" Bool -> Bool -> Bool
&& Text
sa Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"translator") = do
[Agent]
aa <- Text -> State EvalState [Agent]
getAgents' Text
sa
[Agent]
ab <- Text -> State EvalState [Agent]
getAgents' Text
sb
if Bool -> Bool
not ([Agent] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Agent]
aa) Bool -> Bool -> Bool
&& [Agent]
aa [Agent] -> [Agent] -> Bool
forall a. Eq a => a -> a -> Bool
== [Agent]
ab
then (EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EvalState
s -> EvalState
s { edtrans :: Bool
edtrans = Bool
True }) StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Bool -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames Bool
True [Text
sa] [Name]
nl Text
d
else Bool -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames Bool
True [Text]
ns [Name]
nl Text
d
| (Text
s:[Text]
xs) <- [Text]
ns = do
StateT EvalState Identity ()
resetEtal
[Agent]
ags <- Text -> State EvalState [Agent]
getAgents Text
s
Text
k <- Text -> State EvalState Text
getStringVar Text
"ref-id"
Text
p <- (EvalState -> Text) -> State EvalState Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> Text
citePosition (Cite -> Text) -> (EvalState -> Cite) -> EvalState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Cite
cite (Environment -> Cite)
-> (EvalState -> Environment) -> EvalState -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
[Option]
ops <- (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
[Text]
aus <- (EvalState -> [Text]) -> StateT EvalState Identity [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [Text]
authSub
[Output]
r <- do [Output]
res <- Text -> Text -> [Agent] -> State EvalState [Output]
agents Text
p Text
s [Agent]
ags
EvalState
st <- StateT EvalState Identity EvalState
forall s (m :: * -> *). MonadState s m => m s
get
[Output]
fb <- Text -> Text -> [Agent] -> State EvalState [Output]
agents Text
"subsequent" Text
s [Agent]
ags
EvalState -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put EvalState
st
if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
res
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else let role :: Text
role = if [Text]
aus [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text
"author"] then Text
"authorsub" else Text
s
in Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output])
-> ([[Output]] -> Output) -> [[Output]] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib Text
k Text
role [Output]
res [Output]
fb ([[Output]] -> [Output])
-> StateT EvalState Identity [[Output]] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [[Output]]) -> StateT EvalState Identity [[Output]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [[Output]]
etal
[Output]
r' <- Bool -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames Bool
skipEdTrans [Text]
xs [Name]
nl Text
d
[Agent]
num <- (EvalState -> [Agent]) -> State EvalState [Agent]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [Agent]
contNum
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ if [Output]
r [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& [Output]
r' [Output] -> [Output] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then [Agent] -> [Output] -> [Output]
forall a. Eq a => [a] -> [Output] -> [Output]
count [Agent]
num ([Output]
r [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Text -> Output
ODel (Text -> Output) -> Text -> Output
forall a b. (a -> b) -> a -> b
$ [Option] -> Text
delim [Option]
ops] [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
r')
else [Agent] -> [Output] -> [Output]
forall a. Eq a => [a] -> [Output] -> [Output]
count [Agent]
num ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ [Output] -> [Output]
cleanOutput ([Output]
r [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
r')
| Bool
otherwise = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
agents :: Text -> Text -> [Agent] -> State EvalState [Output]
agents Text
p Text
s [Agent]
a = (Name -> State EvalState [Output])
-> [Name] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM (Bool
-> Text
-> Text
-> Text
-> [Agent]
-> Name
-> State EvalState [Output]
formatNames ([Name] -> Bool
hasEtAl [Name]
nl) Text
d Text
p Text
s [Agent]
a) [Name]
nl
delim :: [Option] -> Text
delim [Option]
ops = if Text -> Bool
T.null Text
d then Text -> [Option] -> Text
getOptionVal Text
"names-delimiter" [Option]
ops else Text
d
resetEtal :: StateT EvalState Identity ()
resetEtal = (EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EvalState
s -> EvalState
s { etal :: [[Output]]
etal = [] })
count :: [a] -> [Output] -> [Output]
count [a]
num [Output]
x = if [Name] -> Bool
hasCount [Name]
nl Bool -> Bool -> Bool
&& [a]
num [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
then [Text -> Text -> [Output] -> [Output] -> [[Output]] -> Output
OContrib Text
"" Text
"" [Int -> Formatting -> Output
ONum ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
num) Formatting
emptyFormatting] [] []]
else [Output]
x
hasCount :: [Name] -> Bool
hasCount = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> ([Name] -> [Bool]) -> [Name] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> [Bool]) -> [Name] -> [Bool]
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Name -> [Bool]
hasCount'
hasCount' :: Name -> [Bool]
hasCount' Name
n
| Name Form
Count Formatting
_ [Option]
_ Text
_ [NamePart]
_ <- Name
n = [Bool
True]
| Bool
otherwise = [Bool
False]
formatNames :: Bool -> Delimiter -> Text -> Text -> [Agent] -> Name -> State EvalState [Output]
formatNames :: Bool
-> Text
-> Text
-> Text
-> [Agent]
-> Name
-> State EvalState [Output]
formatNames Bool
ea Text
del Text
p Text
s [Agent]
as Name
n
| Name Form
f Formatting
_ [Option]
ns Text
_ [NamePart]
_ <- Name
n, Form
Count <- Form
f = do
Bool
b <- EvalMode -> Bool
isBib (EvalMode -> Bool)
-> StateT EvalState Identity EvalMode
-> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> EvalMode) -> StateT EvalState Identity EvalMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> EvalMode
mode
[Option]
o <- [Option] -> [Option] -> [Option]
mergeOptions [Option]
ns ([Option] -> [Option])
-> StateT EvalState Identity [Option]
-> StateT EvalState Identity [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
(EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> StateT EvalState Identity ())
-> (EvalState -> EvalState) -> StateT EvalState Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState
st -> EvalState
st { contNum :: [Agent]
contNum = [Agent] -> [Agent]
forall a. Eq a => [a] -> [a]
nub ([Agent] -> [Agent]) -> [Agent] -> [Agent]
forall a b. (a -> b) -> a -> b
$ [Agent] -> [Agent] -> [Agent]
forall a. [a] -> [a] -> [a]
(++) (Int -> [Agent] -> [Agent]
forall a. Int -> [a] -> [a]
take ((Bool, Int) -> Int
forall a b. (a, b) -> b
snd ((Bool, Int) -> Int) -> (Bool, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Bool -> [Option] -> Text -> [Agent] -> (Bool, Int)
isEtAl Bool
b [Option]
o Text
p [Agent]
as) [Agent]
as) ([Agent] -> [Agent]) -> [Agent] -> [Agent]
forall a b. (a -> b) -> a -> b
$ EvalState -> [Agent]
contNum EvalState
st }
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Name Form
f Formatting
fm [Option]
ns Text
d [NamePart]
np <- Name
n = do
Bool
b <- EvalMode -> Bool
isBib (EvalMode -> Bool)
-> StateT EvalState Identity EvalMode
-> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> EvalMode) -> StateT EvalState Identity EvalMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> EvalMode
mode
[Option]
o <- [Option] -> [Option] -> [Option]
mergeOptions [Option]
ns ([Option] -> [Option])
-> StateT EvalState Identity [Option]
-> StateT EvalState Identity [Option]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
EvalMode
m <- (EvalState -> EvalMode) -> StateT EvalState Identity EvalMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> EvalMode
mode
let odel :: Text
odel = if Text
del Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then Text
del else Text -> [Option] -> Text
getOptionVal Text
"name-delimiter" [Option]
o
del' :: Text
del'
| Text
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" = Text
d
| Text -> Bool
T.null Text
odel = Text
", "
| Bool
otherwise = Text
odel
(Bool
_,Int
i) = Bool -> [Option] -> Text -> [Agent] -> (Bool, Int)
isEtAl Bool
b [Option]
o Text
p [Agent]
as
form :: Form
form = case Form
f of
Form
NotSet -> case Text -> [Option] -> Text
getOptionVal Text
"name-form" [Option]
o of
Text
"" -> Form
Long
Text
x -> String -> Form
forall a. Read a => String -> a
read (String -> Form) -> (Text -> String) -> Text -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Form) -> Text -> Form
forall a b. (a -> b) -> a -> b
$ Text -> Text
toRead Text
x
Form
_ -> Form
f
genName :: Int -> State EvalState [Output]
genName Int
x = do [Output]
etal' <- [Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
formatEtAl [Option]
o Bool
ea Text
"et-al" Formatting
fm Text
del' Int
x
if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
etal'
then do Text
t <- Bool -> Form -> Text -> State EvalState Text
getTerm Bool
False Form
Long Text
"and"
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Text -> [Option] -> Text -> [Output] -> [Output]
delim Text
t [Option]
o Text
del'
([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ EvalMode
-> [Option] -> Form -> Formatting -> [NamePart] -> Int -> [Output]
format EvalMode
m [Option]
o Form
form Formatting
fm [NamePart]
np Int
x
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
Text -> [Output] -> [Output]
addDelim Text
del' (EvalMode
-> [Option] -> Form -> Formatting -> [NamePart] -> Int -> [Output]
format EvalMode
m [Option]
o Form
form Formatting
fm [NamePart]
np Int
x)
[Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
etal'
[Option] -> [Output] -> StateT EvalState Identity ()
forall (m :: * -> *).
MonadState EvalState m =>
[Option] -> [Output] -> m ()
setLastName [Option]
o ([Output] -> StateT EvalState Identity ())
-> [Output] -> StateT EvalState Identity ()
forall a b. (a -> b) -> a -> b
$ EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName EvalMode
m Bool
False Form
f Formatting
fm [Option]
o [NamePart]
np ([Agent] -> Agent
forall a. [a] -> a
last [Agent]
as)
[[Output]] -> StateT EvalState Identity ()
forall (m :: * -> *). MonadState EvalState m => [[Output]] -> m ()
updateEtal ([[Output]] -> StateT EvalState Identity ())
-> StateT EvalState Identity [[Output]]
-> StateT EvalState Identity ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> State EvalState [Output])
-> [Int] -> StateT EvalState Identity [[Output]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Int -> State EvalState [Output]
genName [Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i .. [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as]
Int -> State EvalState [Output]
genName Int
i
| NameLabel Form
f Formatting
fm Plural
pl <- Name
n = StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' (Text -> StateT EvalState Identity Bool
isVarSet Text
s) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ do
Bool
b <- (EvalState -> Bool) -> StateT EvalState Identity Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> Bool
edtrans
[Output]
res <- Form -> Formatting -> Bool -> Text -> State EvalState [Output]
formatLabel Form
f Formatting
fm (Plural -> Int -> Bool
isPlural Plural
pl (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as) (Text -> State EvalState [Output])
-> Text -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
if Bool
b then Text
"editortranslator" else Text
s
(EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> StateT EvalState Identity ())
-> (EvalState -> EvalState) -> StateT EvalState Identity ()
forall a b. (a -> b) -> a -> b
$ \EvalState
st -> EvalState
st { edtrans :: Bool
edtrans = Bool
False }
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
res
| EtAl Formatting
fm Text
t <- Name
n = do
[Option]
o <- (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
[[Output]]
et <- (EvalState -> [[Output]]) -> StateT EvalState Identity [[Output]]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [[Output]]
etal
let i :: Int
i = [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- [[Output]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Output]]
et
t' :: Text
t' = if Text -> Bool
T.null Text
t then Text
"et-al" else Text
t
[[Output]]
r <- (Int -> State EvalState [Output])
-> [Int] -> StateT EvalState Identity [[Output]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
False Text
t' Formatting
fm Text
del) [Int
i .. [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as]
let ([Output]
r',[[Output]]
r'') = case [[Output]]
r of
([Output]
x:[[Output]]
xs) -> ([Output]
x, [[Output]]
xs)
[] -> ([],[])
[[Output]] -> StateT EvalState Identity ()
forall (m :: * -> *). MonadState EvalState m => [[Output]] -> m ()
updateEtal [[Output]]
r''
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r'
| Bool
otherwise = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
isBib :: EvalMode -> Bool
isBib (EvalBiblio Cite
_) = Bool
True
isBib EvalMode
_ = Bool
False
updateEtal :: [[Output]] -> m ()
updateEtal [[Output]]
x = (EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> m ())
-> (EvalState -> EvalState) -> m ()
forall a b. (a -> b) -> a -> b
$ \EvalState
st ->
let x' :: [[Output]]
x' = if [[Output]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Output]]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then [Output] -> [[Output]]
forall a. a -> [a]
repeat ([Output] -> [[Output]]) -> [Output] -> [[Output]]
forall a b. (a -> b) -> a -> b
$ [[Output]] -> [Output]
forall a. [a] -> a
head [[Output]]
x else [[Output]]
x
in EvalState
st { etal :: [[Output]]
etal = case EvalState -> [[Output]]
etal EvalState
st of
[] -> [[Output]]
x
[[Output]]
ys -> ([Output] -> [Output] -> [Output])
-> [[Output]] -> [[Output]] -> [[Output]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
(++) [[Output]]
ys [[Output]]
x'
}
isWithLastName :: [Option] -> Bool
isWithLastName [Option]
os
| Text
"true" <- Text -> [Option] -> Text
getOptionVal Text
"et-al-use-last" [Option]
os
, Int
em <- Text -> Int
readNum (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Option] -> Text
getOptionVal Text
"et-al-min" [Option]
os
, Int
uf <- Text -> Int
readNum (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Option] -> Text
getOptionVal Text
"et-al-use-first" [Option]
os
, Int
em Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
uf Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Bool
True
| Bool
otherwise = Bool
False
setLastName :: [Option] -> [Output] -> m ()
setLastName [Option]
os [Output]
x
| [Agent]
as [Agent] -> [Agent] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
, [Option] -> Bool
isWithLastName [Option]
os = (EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EvalState -> EvalState) -> m ())
-> (EvalState -> EvalState) -> m ()
forall a b. (a -> b) -> a -> b
$ \EvalState
st -> EvalState
st { lastName :: [Output]
lastName = [Output]
x}
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
format :: EvalMode
-> [Option] -> Form -> Formatting -> [NamePart] -> Int -> [Output]
format EvalMode
m [Option]
os Form
f Formatting
fm [NamePart]
np Int
i
| (Agent
a:[Agent]
xs) <- Int -> [Agent] -> [Agent]
forall a. Int -> [a] -> [a]
take Int
i [Agent]
as = EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName EvalMode
m Bool
True Form
f Formatting
fm [Option]
os [NamePart]
np Agent
a [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++
(Agent -> [Output]) -> [Agent] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName EvalMode
m Bool
False Form
f Formatting
fm [Option]
os [NamePart]
np) [Agent]
xs
| Bool
otherwise = (Agent -> [Output]) -> [Agent] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName EvalMode
m Bool
True Form
f Formatting
fm [Option]
os [NamePart]
np) ([Agent] -> [Output])
-> ([Agent] -> [Agent]) -> [Agent] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Agent] -> [Agent]
forall a. Int -> [a] -> [a]
take Int
i ([Agent] -> [Output]) -> [Agent] -> [Output]
forall a b. (a -> b) -> a -> b
$ [Agent]
as
delim :: Text -> [Option] -> Text -> [Output] -> [Output]
delim Text
t [Option]
os Text
d [Output]
x
| Text
"always" <- Text -> [Option] -> Text
getOptionVal Text
"delimiter-precedes-last" [Option]
os
, [Output] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Text -> [Output] -> [Output]
addDelim Text
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Text -> Output
ODel (Text
d Text -> Text -> Text
<^> Text -> [Option] -> Text
forall p. (Semigroup p, IsString p) => p -> [Option] -> p
andStr Text
t [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
| [Output] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Text -> [Output] -> [Output]
addDelim Text
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Text -> Output
ODel (Text -> Text -> [Option] -> Text
andStr' Text
t Text
d [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
| Text
"never" <- Text -> [Option] -> Text
getOptionVal Text
"delimiter-precedes-last" [Option]
os
, [Output] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = Text -> [Output] -> [Output]
addDelim Text
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Text -> Output
ODel (Text -> Text -> [Option] -> Text
andStr' Text
t Text
d [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
| [Output] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Output]
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 = Text -> [Output] -> [Output]
addDelim Text
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Text -> Output
ODel (Text
d Text -> Text -> Text
<^> Text -> [Option] -> Text
forall p. (Semigroup p, IsString p) => p -> [Option] -> p
andStr Text
t [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
| Bool
otherwise = Text -> [Output] -> [Output]
addDelim Text
d [Output]
x
andStr :: p -> [Option] -> p
andStr p
t [Option]
os
| Text
"text" <- Text -> [Option] -> Text
getOptionVal Text
"and" [Option]
os = p
" " p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
t p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
" "
| Text
"symbol" <- Text -> [Option] -> Text
getOptionVal Text
"and" [Option]
os = p
" & "
| Bool
otherwise = p
""
andStr' :: Text -> Text -> [Option] -> Text
andStr' Text
t Text
d [Option]
os = if Text -> Bool
T.null (Text -> [Option] -> Text
forall p. (Semigroup p, IsString p) => p -> [Option] -> p
andStr Text
t [Option]
os) then Text
d else Text -> [Option] -> Text
forall p. (Semigroup p, IsString p) => p -> [Option] -> p
andStr Text
t [Option]
os
formatEtAl :: [Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
formatEtAl [Option]
o Bool
b Text
t Formatting
fm Text
d Int
i = do
[Output]
ln <- (EvalState -> [Output]) -> State EvalState [Output]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [Output]
lastName
if [Option] -> Bool
isWithLastName [Option]
o
then case () of
()
_ | ([Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> [Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
b Text
t Formatting
fm Text
d Int
i
| ([Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ [Text -> Output
ODel Text
d, [Inline] -> Output
OPan [Text -> Inline
Str Text
"\x2026"], Output
OSpace] [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
ln
| Bool
otherwise -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
b Text
t Formatting
fm Text
d Int
i
et_al :: [Option]
-> Bool
-> Text
-> Formatting
-> Text
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
b Text
t Formatting
fm Text
d Int
i
= StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' ( Bool -> Bool
not (Bool -> Bool) -> (EvalMode -> Bool) -> EvalMode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalMode -> Bool
isSorting (EvalMode -> Bool)
-> StateT EvalState Identity EvalMode
-> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> EvalMode) -> StateT EvalState Identity EvalMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> EvalMode
mode) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
if Bool
b Bool -> Bool -> Bool
|| [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do Text
x <- Bool -> Form -> Text -> State EvalState Text
getTerm Bool
False Form
Long Text
t
StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' (Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> StateT EvalState Identity Bool)
-> Bool -> StateT EvalState Identity Bool
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"") (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
case Text -> [Option] -> Text
getOptionVal Text
"delimiter-precedes-et-al" [Option]
o of
Text
"never" -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> ([Output] -> [Output]) -> [Output] -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
(++) [Output
OSpace] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> Text -> [Output]
output Formatting
fm Text
x
Text
"always" -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> ([Output] -> [Output]) -> [Output] -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
(++) [Text -> Output
ODel Text
d] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> Text -> [Output]
output Formatting
fm Text
x
Text
_ -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
d)
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> ([Output] -> [Output]) -> [Output] -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
(++) [Text -> Output
ODel Text
d] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> Text -> [Output]
output Formatting
fm Text
x
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> ([Output] -> [Output]) -> [Output] -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
(++) [Output
OSpace] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> Text -> [Output]
output Formatting
fm Text
x
isEtAl :: Bool -> [Option] -> Text -> [Agent] -> (Bool, Int)
isEtAl :: Bool -> [Option] -> Text -> [Agent] -> (Bool, Int)
isEtAl Bool
b [Option]
os Text
p [Agent]
as
| Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"first"
, Text -> [Option] -> Bool
isOptionSet Text
"et-al-subsequent-min" [Option]
os
, Text -> [Option] -> Bool
isOptionSet Text
"et-al-subsequent-use-first" [Option]
os
, Int
le <- Text -> Int
forall c. Read c => Text -> c
etAlMin Text
"et-al-subsequent-min"
, Int
le' <- Text -> Int
forall c. Read c => Text -> c
etAlMin Text
"et-al-subsequent-use-first"
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
le
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
le' = (,) Bool
True Int
le'
| Text -> Text -> Bool
isOptionSet' Text
"et-al-min" Text
"et-al-subsequent-min"
, Text -> Text -> Bool
isOptionSet' Text
"et-al-use-first" Text
"et-al-subsequent-use-first"
, Int
le <- Text -> Text -> Int
forall p. Read p => Text -> Text -> p
etAlMin' Text
"et-al-min" Text
"et-al-subsequent-min"
, Int
le' <- Text -> Text -> Int
forall p. Read p => Text -> Text -> p
etAlMin' Text
"et-al-use-first" Text
"et-al-subsequent-use-first"
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
le
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
le' = (,) Bool
True Int
le'
| Text -> Text -> Bool
isOptionSet' Text
"et-al-min" Text
"et-al-subsequent-min"
, Int
le <- Text -> Text -> Int
forall p. Read p => Text -> Text -> p
etAlMin' Text
"et-al-min" Text
"et-al-subsequent-min"
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
le
, [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (,) Bool
True Int
getUseFirst
| Bool
otherwise = (,) Bool
False (Int -> (Bool, Int)) -> Int -> (Bool, Int)
forall a b. (a -> b) -> a -> b
$ [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as
where
etAlMin :: Text -> c
etAlMin Text
x = String -> c
forall a. Read a => String -> a
read (String -> c) -> (Text -> String) -> Text -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> c) -> Text -> c
forall a b. (a -> b) -> a -> b
$ Text -> [Option] -> Text
getOptionVal Text
x [Option]
os
etAlMin' :: Text -> Text -> p
etAlMin' Text
x Text
y = if Bool
b then Text -> p
forall c. Read c => Text -> c
etAlMin Text
x else String -> p
forall a. Read a => String -> a
read (String -> p) -> (Text -> String) -> Text -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> p) -> Text -> p
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
getOptionVal' Text
x Text
y
isOptionSet' :: Text -> Text -> Bool
isOptionSet' Text
s1 Text
s2 = if Bool
b
then Text -> [Option] -> Bool
isOptionSet Text
s1 [Option]
os
else [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [Option] -> Bool
isOptionSet Text
s1 [Option]
os Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Text -> [Option] -> Bool
isOptionSet Text
s2 [Option]
os]
getOptionVal' :: Text -> Text -> Text
getOptionVal' Text
s1 Text
s2 = if Text -> Bool
T.null (Text -> [Option] -> Text
getOptionVal Text
s1 [Option]
os)
then Text -> [Option] -> Text
getOptionVal Text
s2 [Option]
os
else Text -> [Option] -> Text
getOptionVal Text
s1 [Option]
os
getUseFirst :: Int
getUseFirst = let u :: Text
u = if Bool
b
then Text -> [Option] -> Text
getOptionVal Text
"et-al-use-first" [Option]
os
else Text -> Text -> Text
getOptionVal' Text
"et-al-use-first" Text
"et-al-subsequent-min"
in if Text -> Bool
T.null Text
u then Int
1 else String -> Int
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
u)
formatName :: EvalMode -> Bool -> Form -> Formatting -> [Option] -> [NamePart] -> Agent -> [Output]
formatName :: EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName EvalMode
m Bool
b Form
f Formatting
fm [Option]
ops [NamePart]
np Agent
n
| Agent -> Formatted
literal Agent
n Formatted -> Formatted -> Bool
forall a. Eq a => a -> a -> Bool
/= Formatted
forall a. Monoid a => a
mempty = Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
n [Output]
institution [] Formatting
fm
| Form
Short <- Form
f = Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
n [Output]
shortName [[Output]]
disambdata Formatting
fm
| Bool
otherwise = Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ Agent -> [Output] -> [[Output]] -> Formatting -> Output
OName Agent
n (Formatted -> [Output]
longName Formatted
given) [[Output]]
disambdata Formatting
fm
where
institution :: [Output]
institution = [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted (Formatted -> [Inline]) -> Formatted -> [Inline]
forall a b. (a -> b) -> a -> b
$ Agent -> Formatted
literal Agent
n) (Text -> Formatting
form Text
"family")
when_ :: a -> p -> p
when_ a
c p
o = if a
c a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Monoid a => a
mempty then p
o else p
forall a. Monoid a => a
mempty
addAffixes :: Formatted -> Text -> [Output] -> [Output]
addAffixes (Formatted []) Text
_ [] = []
addAffixes Formatted
s Text
sf [Output]
ns = [[Output] -> Formatting -> Output
Output ([Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan (Formatted -> [Inline]
unFormatted Formatted
s)]
(Text -> Formatting
form Text
sf){ prefix :: Text
prefix = Text
forall a. Monoid a => a
mempty, suffix :: Text
suffix = Text
forall a. Monoid a => a
mempty} Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output]
ns)
Formatting
emptyFormatting { prefix :: Text
prefix = Formatting -> Text
prefix (Text -> Formatting
form Text
sf)
, suffix :: Text
suffix = Formatting -> Text
suffix (Text -> Formatting
form Text
sf)}]
form :: Text -> Formatting
form Text
s = case (NamePart -> Bool) -> [NamePart] -> [NamePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(NamePart Text
n' Formatting
_) -> Text
n' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s) [NamePart]
np of
NamePart Text
_ Formatting
fm':[NamePart]
_ -> Formatting
fm'
[NamePart]
_ -> Formatting
emptyFormatting
hyphenate :: [Inline] -> [Inline] -> [Inline]
hyphenate [Inline]
new [] = [Inline]
new
hyphenate [Inline]
new [Inline]
accum =
if Text -> [Option] -> Text
getOptionVal Text
"initialize-with-hyphen" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"false"
then [Inline]
new [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
accum
else [Inline] -> [Inline]
trimsp [Inline]
new [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Text -> Inline
Str Text
"-"] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
accum
isInit :: [Inline] -> Bool
isInit [Str (Text -> String
T.unpack -> [Char
c])] = Char -> Bool
isUpper Char
c
isInit [Inline]
_ = Bool
False
initial :: Formatted -> [Inline]
initial (Formatted [Inline]
x) =
case Text -> [Option] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"initialize-with" [Option]
ops of
Just Text
iw
| Text -> [Option] -> Text
getOptionVal Text
"initialize" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"false"
, [Inline] -> Bool
isInit [Inline]
x -> [Inline] -> [Inline] -> [Inline]
addIn [Inline]
x ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text Text
iw
| Text -> [Option] -> Text
getOptionVal Text
"initialize" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"false"
, Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isLower (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> [Inline] -> String
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) [Inline]
x) -> [Inline] -> [Inline] -> [Inline]
addIn [Inline]
x ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall a b. (a -> b) -> a -> b
$ Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Many Inline -> [Inline]) -> Many Inline -> [Inline]
forall a b. (a -> b) -> a -> b
$ Text -> Many Inline
B.text Text
iw
Maybe Text
Nothing
| [Inline] -> Bool
isInit [Inline]
x -> [Inline] -> [Inline] -> [Inline]
addIn [Inline]
x [Inline
Space]
Maybe Text
_ -> Inline
Space Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
x [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
Space]
addIn :: [Inline] -> [Inline] -> [Inline]
addIn [Inline]
x [Inline]
i = ([Inline] -> [Inline] -> [Inline])
-> [Inline] -> [[Inline]] -> [Inline]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Inline] -> [Inline] -> [Inline]
hyphenate ([Inline] -> [Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Inline]
z -> Text -> Inline
Str (Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton (Maybe Char -> Text) -> Maybe Char -> Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> Maybe Char
headInline [Inline]
z) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline]
i)) []
([[Inline]] -> [Inline]) -> [[Inline]] -> [Inline]
forall a b. (a -> b) -> a -> b
$ (Inline -> Bool) -> [Inline] -> [[Inline]]
forall a. (a -> Bool) -> [a] -> [[a]]
wordsBy (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Inline
Str Text
"-")
([Inline] -> [[Inline]]) -> [Inline] -> [[Inline]]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Inline] -> [Inline]
splitStrWhen (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-') [Inline]
x
sortSep :: Formatted -> Formatted -> [Output]
sortSep Formatted
g Formatted
s = Formatted -> [Output] -> [Output]
forall a p. (Eq a, Monoid a, Monoid p) => a -> p -> p
when_ Formatted
g ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ [Output]
separator [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ Formatted -> Text -> [Output] -> [Output]
addAffixes (Formatted
g Formatted -> Formatted -> Formatted
<+> Formatted
s) Text
"given" [Output]
forall a. Monoid a => a
mempty
separator :: [Output]
separator = if Bool
isByzantineFamily
then [[Inline] -> Output
OPan (Many Inline -> [Inline]
forall a. Many a -> [a]
B.toList (Text -> Many Inline
B.text
(Text -> Text -> [Option] -> Text
getOptionValWithDefault Text
"sort-separator" Text
", " [Option]
ops)))]
else []
suff :: [Output]
suff = if Agent -> Bool
commaSuffix Agent
n Bool -> Bool -> Bool
&& Agent -> Formatted
nameSuffix Agent
n Formatted -> Formatted -> Bool
forall a. Eq a => a -> a -> Bool
/= Formatted
forall a. Monoid a => a
mempty
then [Output]
suffCom
else [Output]
suffNoCom
suffCom :: [Output]
suffCom = Formatted -> [Output] -> [Output]
forall a p. (Eq a, Monoid a, Monoid p) => a -> p -> p
when_ (Agent -> Formatted
nameSuffix Agent
n) ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ [Output]
separator [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++
[Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted (Formatted -> [Inline]) -> Formatted -> [Inline]
forall a b. (a -> b) -> a -> b
$ Agent -> Formatted
nameSuffix Agent
n) Formatting
fm
suffNoCom :: [Output]
suffNoCom = Formatted -> [Output] -> [Output]
forall a p. (Eq a, Monoid a, Monoid p) => a -> p -> p
when_ (Agent -> Formatted
nameSuffix Agent
n) ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ Output
OSpace Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted (Formatted -> [Inline]) -> Formatted -> [Inline]
forall a b. (a -> b) -> a -> b
$ Agent -> Formatted
nameSuffix Agent
n) Formatting
fm
onlyGiven :: Bool
onlyGiven = Agent -> [Formatted]
givenName Agent
n [Formatted] -> [Formatted] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Formatted]
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Formatted
family Formatted -> Formatted -> Bool
forall a. Eq a => a -> a -> Bool
== Formatted
forall a. Monoid a => a
mempty
given :: Formatted
given = if Bool
onlyGiven
then Formatted
givenLong
else [Formatted] -> Formatted -> Formatted
forall a p. (Eq a, Monoid a, Monoid p) => a -> p -> p
when_ (Agent -> [Formatted]
givenName Agent
n) (Formatted -> Formatted)
-> ([Formatted] -> Formatted) -> [Formatted] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Formatted
Formatted ([Inline] -> Formatted)
-> ([Formatted] -> [Inline]) -> [Formatted] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
trimsp ([Inline] -> [Inline])
-> ([Formatted] -> [Inline]) -> [Formatted] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
fixsp ([Inline] -> [Inline])
-> ([Formatted] -> [Inline]) -> [Formatted] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Formatted -> [Inline]) -> [Formatted] -> [Inline]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Formatted -> [Inline]
initial ([Formatted] -> Formatted) -> [Formatted] -> Formatted
forall a b. (a -> b) -> a -> b
$ Agent -> [Formatted]
givenName Agent
n
fixsp :: [Inline] -> [Inline]
fixsp (Inline
Space:Inline
Space:[Inline]
xs) = [Inline] -> [Inline]
fixsp (Inline
SpaceInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
xs)
fixsp (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixsp [Inline]
xs
fixsp [] = []
trimsp :: [Inline] -> [Inline]
trimsp = [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space) ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> [Inline]
forall a. [a] -> [a]
reverse ([Inline] -> [Inline])
-> ([Inline] -> [Inline]) -> [Inline] -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Bool) -> [Inline] -> [Inline]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Inline -> Inline -> Bool
forall a. Eq a => a -> a -> Bool
==Inline
Space)
givenLong :: Formatted
givenLong = [Formatted] -> Formatted -> Formatted
forall a p. (Eq a, Monoid a, Monoid p) => a -> p -> p
when_ (Agent -> [Formatted]
givenName Agent
n) (Formatted -> Formatted)
-> ([Formatted] -> Formatted) -> [Formatted] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Formatted] -> Formatted
forall a. Monoid a => [a] -> a
mconcat ([Formatted] -> Formatted)
-> ([Formatted] -> [Formatted]) -> [Formatted] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatted -> [Formatted] -> [Formatted]
forall a. a -> [a] -> [a]
intersperse ([Inline] -> Formatted
Formatted [Inline
Space]) ([Formatted] -> Formatted) -> [Formatted] -> Formatted
forall a b. (a -> b) -> a -> b
$ Agent -> [Formatted]
givenName Agent
n
family :: Formatted
family = Agent -> Formatted
familyName Agent
n
dropping :: Formatted
dropping = Agent -> Formatted
droppingPart Agent
n
nondropping :: Formatted
nondropping = Agent -> Formatted
nonDroppingPart Agent
n
isByzantine :: Char -> Bool
isByzantine Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0e01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x0e5b') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x00c0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x017f') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x03ff') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0400' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x052f') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0590' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x05d4') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x05d6' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x05ff') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1f00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1fff') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x0600' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x06ff') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x200c' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x200e') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x2018' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x2019') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x021a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x021b') Bool -> Bool -> Bool
||
(Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x202a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x202e')
isByzantineFamily :: Bool
isByzantineFamily = (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isByzantine (Formatted -> Text
forall a. Walkable Inline a => a -> Text
stringify Formatted
family)
shortName :: [Output]
shortName = [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted (Formatted -> [Inline]) -> Formatted -> [Inline]
forall a b. (a -> b) -> a -> b
$ Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family) (Text -> Formatting
form Text
"family")
longName :: Formatted -> [Output]
longName Formatted
g
| EvalMode -> Bool
isSorting EvalMode
m = let firstPart :: Formatted
firstPart = case Text -> [Option] -> Text
getOptionVal Text
"demote-non-dropping-particle" [Option]
ops of
Text
"never" -> Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family Formatted -> Formatted -> Formatted
<+> Formatted
dropping
Text
_ -> Formatted
family Formatted -> Formatted -> Formatted
<+> Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping
in [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
firstPart) (Text -> Formatting
form Text
"family") [Output] -> [Output] -> [Output]
<++> [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
g) (Text -> Formatting
form Text
"given") [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
suffCom
| (Bool
b Bool -> Bool -> Bool
&& Text -> [Option] -> Text
getOptionVal Text
"name-as-sort-order" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"first") Bool -> Bool -> Bool
||
Text -> [Option] -> Text
getOptionVal Text
"name-as-sort-order" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"all" = let (Formatted
fam,Formatted
par) = case Text -> [Option] -> Text
getOptionVal Text
"demote-non-dropping-particle" [Option]
ops of
Text
"never" -> (Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family, Formatted
dropping)
Text
"sort-only" -> (Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family, Formatted
dropping)
Text
_ -> (Formatted
family, Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping)
in [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
fam) (Text -> Formatting
form Text
"family") [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> Formatted -> Formatted -> [Output]
sortSep Formatted
g Formatted
par [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
suffCom
| Bool
otherwise = let fam :: [Output]
fam = Formatted -> Text -> [Output] -> [Output]
addAffixes (Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family) Text
"family" [Output]
suff
gvn :: [Output]
gvn = [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
g) (Text -> Formatting
form Text
"given")
in if Bool
isByzantineFamily
then [Output]
gvn [Output] -> [Output] -> [Output]
<++> [Output]
fam
else [Output]
fam [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
gvn
disWithGiven :: Bool
disWithGiven = Text -> [Option] -> Text
getOptionVal Text
"disambiguate-add-givenname" [Option]
ops Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"true"
initialize :: Bool
initialize = Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Text -> [Option] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"initialize-with" [Option]
ops) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
onlyGiven
isLong :: Bool
isLong = Form
f Form -> Form -> Bool
forall a. Eq a => a -> a -> Bool
/= Form
Short Bool -> Bool -> Bool
&& Bool
initialize
givenRule :: Text
givenRule = let gr :: Text
gr = Text -> [Option] -> Text
getOptionVal Text
"givenname-disambiguation-rule" [Option]
ops
in if Text -> Bool
T.null Text
gr then Text
"by-cite" else Text
gr
disambdata :: [[Output]]
disambdata = case () of
()
_ | Text
"all-names-with-initials" <- Text
givenRule
, Bool
disWithGiven, Form
Short <- Form
f, Bool
initialize -> [Formatted -> [Output]
longName Formatted
given]
| Text
"primary-name-with-initials" <- Text
givenRule
, Bool
disWithGiven, Form
Short <- Form
f, Bool
initialize, Bool
b -> [Formatted -> [Output]
longName Formatted
given]
| Bool
disWithGiven, Form
Short <- Form
f, Bool
b
, Text
"primary-name" <- Text
givenRule -> [Formatted -> [Output]
longName Formatted
given, Formatted -> [Output]
longName Formatted
givenLong]
| Bool
disWithGiven, Form
Short <- Form
f
, Text
"all-names" <- Text
givenRule -> [Formatted -> [Output]
longName Formatted
given, Formatted -> [Output]
longName Formatted
givenLong]
| Bool
disWithGiven, Form
Short <- Form
f
, Text
"by-cite" <- Text
givenRule -> [Formatted -> [Output]
longName Formatted
given, Formatted -> [Output]
longName Formatted
givenLong]
| Bool
disWithGiven, Bool
isLong -> [Formatted -> [Output]
longName Formatted
givenLong]
| Bool
otherwise -> []
formatTerm :: Form -> Formatting -> Bool -> Text -> Text
-> State EvalState [Output]
formatTerm :: Form
-> Formatting -> Bool -> Text -> Text -> State EvalState [Output]
formatTerm Form
f Formatting
fm Bool
p Text
refid Text
s = do
Bool
plural <- if Text
s Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"page", Text
"volume", Text
"issue"]
then do
Bool
varset <- Text -> StateT EvalState Identity Bool
isVarSet Text
s
if Bool
varset
then Text -> Bool
isRange (Text -> Bool)
-> State EvalState Text -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> State EvalState Text
getStringVar Text
s
else Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
p
else Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
p
Text
t <- Bool -> Form -> Text -> State EvalState Text
getTerm Bool
plural Form
f Text
s
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"no date"
then [Text -> Text -> Formatting -> Output
OYear Text
t Text
refid Formatting
fm]
else Text -> Formatting -> [Output]
oStr' Text
t Formatting
fm
formatLabel :: Form -> Formatting -> Bool -> Text -> State EvalState [Output]
formatLabel :: Form -> Formatting -> Bool -> Text -> State EvalState [Output]
formatLabel Form
f Formatting
fm Bool
p Text
s = StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' (Text -> StateT EvalState Identity Bool
isVarSet Text
s) State EvalState [Output]
go
where
go :: State EvalState [Output]
go
| Text
"locator" <- Text
s = StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' ( Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Text
"" (Text -> Bool)
-> State EvalState Text -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> Text) -> State EvalState Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> Text
citeLocator (Cite -> Text) -> (EvalState -> Cite) -> EvalState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Cite
cite (Environment -> Cite)
-> (EvalState -> Environment) -> EvalState -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ do
(Text
l,Text
v) <- State EvalState Option
getLocVar
(Formatting -> Text -> [Output])
-> (Text -> Text) -> Text -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (Text -> b) -> Text -> Bool -> StateT EvalState Identity b
form (\Formatting
fm' -> Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> (Text -> Output) -> Text -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Output] -> Formatting -> Output)
-> Formatting -> [Output] -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Output] -> Formatting -> Output
OLoc Formatting
emptyFormatting ([Output] -> Output) -> (Text -> [Output]) -> Text -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> Text -> [Output]
output Formatting
fm') Text -> Text
forall a. a -> a
id Text
l (Text -> Bool
isRange Text
v)
| Text
"page" <- Text
s = State EvalState [Output]
checkPlural
| Text
"volume" <- Text
s = State EvalState [Output]
checkPlural
| Text
"issue" <- Text
s = State EvalState [Output]
checkPlural
| Text
"ibid" <- Text
s = Text -> Bool -> State EvalState [Output]
format Text
s Bool
p
| Text -> Bool
isRole Text
s = do [Agent]
a <- Text -> State EvalState [Agent]
getAgents' (if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"editortranslator"
then Text
"editor"
else Text
s)
if [Agent] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Agent]
a
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else (Formatting -> Text -> [Output])
-> (Text -> Text) -> Text -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (Text -> b) -> Text -> Bool -> StateT EvalState Identity b
form (\Formatting
fm' Text
x -> [Text -> Formatting -> Output
OLabel Text
x Formatting
fm']) Text -> Text
forall a. a -> a
id Text
s Bool
p
| Bool
otherwise = Text -> Bool -> State EvalState [Output]
format Text
s Bool
p
isRole :: Text -> Bool
isRole = (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text
"author", Text
"collection-editor", Text
"composer", Text
"container-author"
,Text
"director", Text
"editor", Text
"editorial-director", Text
"editortranslator"
,Text
"illustrator", Text
"interviewer", Text
"original-author", Text
"recipient"
,Text
"reviewed-author", Text
"translator"]
checkPlural :: State EvalState [Output]
checkPlural = StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' (Text -> StateT EvalState Identity Bool
isVarSet Text
s) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ do
Text
v <- Text -> State EvalState Text
getStringVar Text
s
Text -> Bool -> State EvalState [Output]
format Text
s (Text -> Bool
isRange Text
v)
format :: Text -> Bool -> State EvalState [Output]
format = (Formatting -> Text -> [Output])
-> (Text -> Text) -> Text -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (Text -> b) -> Text -> Bool -> StateT EvalState Identity b
form Formatting -> Text -> [Output]
output Text -> Text
forall a. a -> a
id
form :: (Formatting -> b -> b)
-> (Text -> b) -> Text -> Bool -> StateT EvalState Identity b
form Formatting -> b -> b
o Text -> b
g Text
t Bool
b = Formatting -> b -> b
o Formatting
fm (b -> b) -> (Text -> b) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> b
g (Text -> b) -> (Text -> Text) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
period (Text -> b) -> State EvalState Text -> StateT EvalState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Form -> Text -> State EvalState Text
getTerm (Bool
b Bool -> Bool -> Bool
&& Bool
p) Form
f Text
t
period :: Text -> Text
period = if Formatting -> Bool
stripPeriods Formatting
fm then (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') else Text -> Text
forall a. a -> a
id
(<+>) :: Formatted -> Formatted -> Formatted
Formatted [] <+> :: Formatted -> Formatted -> Formatted
<+> Formatted
ss = Formatted
ss
Formatted
s <+> Formatted [] = Formatted
s
Formatted [Inline]
xs <+> Formatted [Inline]
ys =
case [Inline] -> Maybe Char
lastInline [Inline]
xs of
Just Char
'’' -> [Inline] -> Formatted
Formatted ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys)
Just Char
'-' -> [Inline] -> Formatted
Formatted ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys)
Maybe Char
_ -> [Inline] -> Formatted
Formatted ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline
Space] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys)
(<++>) :: [Output] -> [Output] -> [Output]
[] <++> :: [Output] -> [Output] -> [Output]
<++> [Output]
o = [Output]
o
[Output]
o <++> [] = [Output]
o
[Output]
o1 <++> [Output]
o2 = [Output]
o1 [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output
OSpace] [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
o2