{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards    #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Eval.Names
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The CSL implementation
--
-----------------------------------------------------------------------------

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
/= [] -- FIXME!! le zero!!
                     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]

-- | The 'Bool' is 'True' when formatting a name with a final "et-al".
-- The first 'Text' represents the position and the second the role
-- (e.i. editor, translator, etc.).
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 }
        -- Note: the following line was here previously.
        -- It produces spurious 'et al's and seems to have no function,
        -- so I have commented it out:
        -- updateEtal [tr' "res" res]
        [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 -- is that correct? FIXME later
                    | ([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

-- | The first 'Bool' is 'True' if we are evaluating the bibliography.
-- The 'Text' is the cite position. The function also returns the
-- number of contributors to be displayed.
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)

-- | Generate the 'Agent's names applying et-al options, with all
-- possible permutations to disambiguate colliding citations. The
-- 'Bool' indicate whether we are formatting the first name or not.
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] -- default
                       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
      -- see src/load.js ROMANESQUE_REGEX in citeproc-js:
      -- /[-0-9a-zA-Z\u0e01-\u0e5b\u00c0-\u017f\u0370-\u03ff\u0400-\u052f\u0590-\u05d4\u05d6-\u05ff\u1f00-\u1fff\u0600-\u06ff\u200c\u200d\u200e\u0218\u0219\u021a\u021b\u202a-\u202e]/
      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