{-# 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 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 -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames :: Bool -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames skipEdTrans :: Bool
skipEdTrans ns :: [String]
ns nl :: [Name]
nl d :: String
d
    | [sa :: String
sa,sb :: String
sb] <- [String]
ns, Bool -> Bool
not Bool
skipEdTrans
    , (String
sa String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "editor" Bool -> Bool -> Bool
&& String
sb String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "translator") Bool -> Bool -> Bool
||
      (String
sb String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "editor" Bool -> Bool -> Bool
&& String
sa String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "translator") = do
        [Agent]
aa <- String -> State EvalState [Agent]
getAgents' String
sa
        [Agent]
ab <- String -> State EvalState [Agent]
getAgents' String
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 (\s :: 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 -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames Bool
True [String
sa] [Name]
nl String
d
           else Bool -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames Bool
True  [String]
ns  [Name]
nl String
d
    | (s :: String
s:xs :: [String]
xs) <- [String]
ns = do
        StateT EvalState Identity ()
resetEtal
        [Agent]
ags <- String -> State EvalState [Agent]
getAgents String
s
        String
k   <- String -> State EvalState String
getStringVar "ref-id"
        String
p   <- (EvalState -> String) -> State EvalState String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> String
citePosition (Cite -> String) -> (EvalState -> Cite) -> EvalState -> String
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)
        [String]
aus <- (EvalState -> [String]) -> StateT EvalState Identity [String]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> [String]
authSub
        [Output]
r   <- do [Output]
res <- String -> String -> [Agent] -> State EvalState [Output]
agents String
p            String
s [Agent]
ags
                  EvalState
st  <- StateT EvalState Identity EvalState
forall s (m :: * -> *). MonadState s m => m s
get
                  [Output]
fb  <- String -> String -> [Agent] -> State EvalState [Output]
agents "subsequent" String
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 :: String
role = if [String]
aus [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== ["author"] then "authorsub" else String
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
. String -> String -> [Output] -> [Output] -> [[Output]] -> Output
OContrib String
k String
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 -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames Bool
skipEdTrans [String]
xs [Name]
nl String
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]
++ [String -> Output
ODel (String -> Output) -> String -> Output
forall a b. (a -> b) -> a -> b
$ [Option] -> String
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 :: String -> String -> [Agent] -> State EvalState [Output]
agents p :: String
p s :: String
s a :: [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
-> String
-> String
-> String
-> [Agent]
-> Name
-> State EvalState [Output]
formatNames ([Name] -> Bool
hasEtAl [Name]
nl) String
d String
p String
s [Agent]
a) [Name]
nl
      delim :: [Option] -> String
delim    ops :: [Option]
ops = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d then String -> [Option] -> String
getOptionVal "names-delimiter" [Option]
ops else String
d
      resetEtal :: StateT EvalState Identity ()
resetEtal    = (EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: EvalState
s -> EvalState
s { etal :: [[Output]]
etal = [] })
      count :: [a] -> [Output] -> [Output]
count  num :: [a]
num x :: [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 [String -> String -> [Output] -> [Output] -> [[Output]] -> Output
OContrib [] [] [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' n :: Name
n
          | Name Count _ _ _ _  <- Name
n = [Bool
True]
          | Bool
otherwise                = [Bool
False]

-- | The 'Bool' is 'True' when formatting a name with a final "et-al".
-- The first 'String' represents the position and the second the role
-- (e.i. editor, translator, etc.).
formatNames :: Bool -> Delimiter -> String -> String -> [Agent] -> Name -> State EvalState [Output]
formatNames :: Bool
-> String
-> String
-> String
-> [Agent]
-> Name
-> State EvalState [Output]
formatNames ea :: Bool
ea del :: String
del p :: String
p s :: String
s as :: [Agent]
as n :: Name
n
    | Name f :: Form
f _ ns :: [Option]
ns _ _ <- 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
$ \st :: 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] -> String -> [Agent] -> (Bool, Int)
isEtAl Bool
b [Option]
o String
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 f :: Form
f fm :: Formatting
fm ns :: [Option]
ns d :: String
d np :: [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 :: String
odel  = if String
del String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then String
del else String -> [Option] -> String
getOptionVal "name-delimiter" [Option]
o
            del' :: String
del'
              | String
d   String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = String
d
              | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
odel = ", "
              | Bool
otherwise = String
odel
            (_,i :: Int
i) = Bool -> [Option] -> String -> [Agent] -> (Bool, Int)
isEtAl Bool
b [Option]
o String
p [Agent]
as
            form :: Form
form  = case Form
f of
                      NotSet -> case String -> [Option] -> String
getOptionVal "name-form" [Option]
o of
                                  [] -> Form
Long
                                  x :: String
x  -> String -> Form
forall a. Read a => String -> a
read (String -> Form) -> String -> Form
forall a b. (a -> b) -> a -> b
$ String -> String
toRead String
x
                      _      -> Form
f
            genName :: Int -> State EvalState [Output]
genName x :: Int
x = do [Output]
etal' <- [Option]
-> Bool
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
formatEtAl [Option]
o Bool
ea "et-al" Formatting
fm String
del' Int
x
                           if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
etal'
                              then do String
t <- Bool -> Form -> String -> State EvalState String
getTerm Bool
False Form
Long "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
$ String -> [Option] -> String -> [Output] -> [Output]
delim String
t [Option]
o String
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
$
                                    String -> [Output] -> [Output]
addDelim String
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 [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 f :: Form
f fm :: Formatting
fm pl :: 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' (String -> StateT EvalState Identity Bool
isVarSet String
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 -> String -> 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) (String -> State EvalState [Output])
-> String -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
               if Bool
b then "editortranslator" else String
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
$ \st :: 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 fm :: Formatting
fm t :: String
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' :: String
t' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
t then "et-al" else String
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
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
False String
t' Formatting
fm String
del) [Int
i .. [Agent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Agent]
as]
        let (r' :: [Output]
r',r'' :: [[Output]]
r'') = case [[Output]]
r of
                         (x :: [Output]
x:xs :: [[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 _) = Bool
True
      isBib  _             = Bool
False
      updateEtal :: [[Output]] -> m ()
updateEtal x :: [[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
$ \st :: 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
== 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
                                         ys :: [[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 os :: [Option]
os
          | String
"true" <-       String -> [Option] -> String
getOptionVal "et-al-use-last"  [Option]
os
          , Int
em <- String -> Int
readNum (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String -> [Option] -> String
getOptionVal "et-al-min"       [Option]
os
          , Int
uf <- String -> Int
readNum (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String -> [Option] -> String
getOptionVal "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
> 1 = Bool
True
          | Bool
otherwise   = Bool
False
      setLastName :: [Option] -> [Output] -> m ()
setLastName os :: [Option]
os x :: [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
$ \st :: 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 m :: EvalMode
m os :: [Option]
os f :: Form
f fm :: Formatting
fm np :: [NamePart]
np i :: Int
i
          | (a :: Agent
a:xs :: [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 :: String -> [Option] -> String -> [Output] -> [Output]
delim t :: String
t os :: [Option]
os d :: String
d x :: [Output]
x
          | String
"always" <- String -> [Option] -> String
getOptionVal "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
== 2 = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ String -> Output
ODel (String
d String -> String -> String
<^> String -> [Option] -> String
andStr String
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
== 2 = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ String -> Output
ODel (String -> String -> [Option] -> String
andStr'   String
t String
d [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
          | String
"never" <- String -> [Option] -> String
getOptionVal "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
>  2 = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ String -> Output
ODel (String -> String -> [Option] -> String
andStr'   String
t String
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
>  2 = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output]
forall a. [a] -> [a]
init [Output]
x) [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ String -> Output
ODel (String
d String -> String -> String
<^> String -> [Option] -> String
andStr String
t [Option]
os) Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [[Output] -> Output
forall a. [a] -> a
last [Output]
x]
          | Bool
otherwise     = String -> [Output] -> [Output]
addDelim String
d [Output]
x
      andStr :: String -> [Option] -> String
andStr t :: String
t os :: [Option]
os
          | String
"text"   <- String -> [Option] -> String
getOptionVal "and" [Option]
os = " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
          | String
"symbol" <- String -> [Option] -> String
getOptionVal "and" [Option]
os = " & "
          | Bool
otherwise                          = []
      andStr' :: String -> String -> [Option] -> String
andStr' t :: String
t d :: String
d os :: [Option]
os = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [Option] -> String
andStr String
t [Option]
os) then String
d else String -> [Option] -> String
andStr String
t [Option]
os

      formatEtAl :: [Option]
-> Bool
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
formatEtAl o :: [Option]
o b :: Bool
b t :: String
t fm :: Formatting
fm d :: String
d i :: 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
== 1 -> [Option]
-> Bool
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
b String
t Formatting
fm String
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
>  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
$ [String -> Output
ODel String
d, [Inline] -> Output
OPan [Text -> Inline
Str "\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
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
et_al [Option]
o Bool
b String
t Formatting
fm String
d Int
i
      et_al :: [Option]
-> Bool
-> String
-> Formatting
-> String
-> Int
-> State EvalState [Output]
et_al o :: [Option]
o b :: Bool
b t :: String
t fm :: Formatting
fm d :: String
d i :: 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 String
x <- Bool -> Form -> String -> State EvalState String
getTerm Bool
False Form
Long String
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
$ String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$
                          case String -> [Option] -> String
getOptionVal "delimiter-precedes-et-al" [Option]
o of
                            "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 -> String -> [Output]
output Formatting
fm String
x
                            "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]
(++) [String -> Output
ODel String
d] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> String -> [Output]
output Formatting
fm String
x
                            _        -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
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]
(++) [String -> Output
ODel String
d] ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Formatting -> String -> [Output]
output Formatting
fm String
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 -> String -> [Output]
output Formatting
fm String
x

-- | The first 'Bool' is 'True' if we are evaluating the bibliography.
-- The 'String' is the cite position. The function also returns the
-- number of contributors to be displayed.
isEtAl :: Bool -> [Option] -> String -> [Agent] -> (Bool, Int)
isEtAl :: Bool -> [Option] -> String -> [Agent] -> (Bool, Int)
isEtAl b :: Bool
b os :: [Option]
os p :: String
p as :: [Agent]
as
    | String
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "first"
    , String -> [Option] -> Bool
isOptionSet    "et-al-subsequent-min"       [Option]
os
    , String -> [Option] -> Bool
isOptionSet    "et-al-subsequent-use-first" [Option]
os
    , Int
le  <- String -> Int
forall a. Read a => String -> a
etAlMin "et-al-subsequent-min"
    , Int
le' <- String -> Int
forall a. Read a => String -> a
etAlMin "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'
    | String -> String -> Bool
isOptionSet'    "et-al-min"       "et-al-subsequent-min"
    , String -> String -> Bool
isOptionSet'    "et-al-use-first" "et-al-subsequent-use-first"
    , Int
le  <- String -> String -> Int
forall p. Read p => String -> String -> p
etAlMin' "et-al-min"       "et-al-subsequent-min"
    , Int
le' <- String -> String -> Int
forall p. Read p => String -> String -> p
etAlMin' "et-al-use-first" "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'
    | String -> String -> Bool
isOptionSet'    "et-al-min"       "et-al-subsequent-min"
    , Int
le  <- String -> String -> Int
forall p. Read p => String -> String -> p
etAlMin' "et-al-min"       "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
>    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 :: String -> a
etAlMin  x :: String
x   = String -> a
forall a. Read a => String -> a
read (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String -> [Option] -> String
getOptionVal String
x [Option]
os
      etAlMin' :: String -> String -> p
etAlMin' x :: String
x y :: String
y = if Bool
b then String -> p
forall a. Read a => String -> a
etAlMin String
x else String -> p
forall a. Read a => String -> a
read (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String -> String -> String
getOptionVal' String
x String
y
      isOptionSet' :: String -> String -> Bool
isOptionSet'  s1 :: String
s1 s2 :: String
s2 = if Bool
b
                            then String -> [Option] -> Bool
isOptionSet String
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
$ String -> [Option] -> Bool
isOptionSet String
s1 [Option]
os Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [String -> [Option] -> Bool
isOptionSet String
s2 [Option]
os]
      getOptionVal' :: String -> String -> String
getOptionVal' s1 :: String
s1 s2 :: String
s2 = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> [Option] -> String
getOptionVal String
s1 [Option]
os)
                            then String -> [Option] -> String
getOptionVal String
s2 [Option]
os
                            else String -> [Option] -> String
getOptionVal String
s1 [Option]
os
      getUseFirst :: Int
getUseFirst = let u :: String
u = if Bool
b
                            then String -> [Option] -> String
getOptionVal  "et-al-use-first" [Option]
os
                            else String -> String -> String
getOptionVal' "et-al-use-first" "et-al-subsequent-min"
                    in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
u then 1 else String -> Int
forall a. Read a => String -> a
read String
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 m :: EvalMode
m b :: Bool
b f :: Form
f fm :: Formatting
fm ops :: [Option]
ops np :: [NamePart]
np n :: 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) (String -> Formatting
form "family")
      when_ :: a -> p -> p
when_ c :: a
c o :: 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 -> String -> [Output] -> [Output]
addAffixes (Formatted []) _ [] = []
      addAffixes s :: Formatted
s sf :: String
sf ns :: [Output]
ns  = [[Output] -> Formatting -> Output
Output ([Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan (Formatted -> [Inline]
unFormatted Formatted
s)]
                            (String -> Formatting
form String
sf){ prefix :: String
prefix = String
forall a. Monoid a => a
mempty, suffix :: String
suffix = String
forall a. Monoid a => a
mempty} Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
: [Output]
ns)
                                   Formatting
emptyFormatting { prefix :: String
prefix = Formatting -> String
prefix (String -> Formatting
form String
sf)
                                                   , suffix :: String
suffix = Formatting -> String
suffix (String -> Formatting
form String
sf)}]

      form :: String -> Formatting
form    s :: String
s = case (NamePart -> Bool) -> [NamePart] -> [NamePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(NamePart n' :: String
n' _) -> String
n' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s) [NamePart]
np of
                    NamePart _ fm' :: Formatting
fm':_ -> Formatting
fm'
                    _                -> Formatting
emptyFormatting

      hyphenate :: [Inline] -> [Inline] -> [Inline]
hyphenate new :: [Inline]
new []    = [Inline]
new
      hyphenate new :: [Inline]
new accum :: [Inline]
accum =
                  if String -> [Option] -> String
getOptionVal "initialize-with-hyphen" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "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 "-"] [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
accum
      isInit :: [Inline] -> Bool
isInit [Str (Text -> String
T.unpack -> [c :: Char
c])] = Char -> Bool
isUpper Char
c
      isInit _         = Bool
False
      initial :: Formatted -> [Inline]
initial (Formatted x :: [Inline]
x) =
                  case String -> [Option] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "initialize-with" [Option]
ops of
                       Just iw :: String
iw
                         | String -> [Option] -> String
getOptionVal "initialize" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "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 -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
iw
                         | String -> [Option] -> String
getOptionVal "initialize" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "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 -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
iw
                       Nothing
                         | [Inline] -> Bool
isInit [Inline]
x  -> [Inline] -> [Inline] -> [Inline]
addIn [Inline]
x [Inline
Space] -- default
                       _ -> 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 x :: [Inline]
x i :: [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
. (\z :: [Inline]
z -> Text -> Inline
Str (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Inline] -> String
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 "-")
                     ([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
=='-') [Inline]
x

      sortSep :: Formatted -> Formatted -> [Output]
sortSep g :: Formatted
g s :: 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 -> String -> [Output] -> [Output]
addAffixes (Formatted
g Formatted -> Formatted -> Formatted
<+> Formatted
s) "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 -> Many Inline) -> Text -> Many Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack
                              (String -> String -> [Option] -> String
getOptionValWithDefault "sort-separator" ", " [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     (Space:Space:xs :: [Inline]
xs) = [Inline] -> [Inline]
fixsp (Inline
SpaceInline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
:[Inline]
xs)
      fixsp     (x :: Inline
x:xs :: [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 c :: Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '9') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'z') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= 'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= 'Z') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0e01' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x0e5b') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x00c0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x017f') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0370' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x03ff') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0400' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x052f') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0590' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x05d4') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x05d6' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x05ff') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x1f00' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x1fff') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x0600' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x06ff') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x200c' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x200e') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x2018' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x2019') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x021a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\x021b') Bool -> Bool -> Bool
||
                      (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= '\x202a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= '\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) (String -> Formatting
form "family")

      longName :: Formatted -> [Output]
longName g :: Formatted
g
        | EvalMode -> Bool
isSorting EvalMode
m = let firstPart :: Formatted
firstPart = case String -> [Option] -> String
getOptionVal "demote-non-dropping-particle" [Option]
ops of
                                           "never" -> Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family  Formatted -> Formatted -> Formatted
<+> Formatted
dropping
                                           _       -> Formatted
family  Formatted -> Formatted -> Formatted
<+> Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping
                        in [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
firstPart) (String -> Formatting
form "family") [Output] -> [Output] -> [Output]
<++> [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
g) (String -> Formatting
form "given") [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
suffCom
        | (Bool
b Bool -> Bool -> Bool
&& String -> [Option] -> String
getOptionVal "name-as-sort-order" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "first") Bool -> Bool -> Bool
||
         String -> [Option] -> String
getOptionVal "name-as-sort-order" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "all" = let (fam :: Formatted
fam,par :: Formatted
par) = case String -> [Option] -> String
getOptionVal "demote-non-dropping-particle" [Option]
ops of
                                                                            "never"     -> (Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family, Formatted
dropping)
                                                                            "sort-only" -> (Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family, Formatted
dropping)
                                                                            _           -> (Formatted
family, Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping)
                                                          in [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
fam) (String -> Formatting
form "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 -> String -> [Output] -> [Output]
addAffixes (Formatted
dropping Formatted -> Formatted -> Formatted
<+> Formatted
nondropping Formatted -> Formatted -> Formatted
<+> Formatted
family) "family" [Output]
suff
                          gvn :: [Output]
gvn = [Inline] -> Formatting -> [Output]
oPan' (Formatted -> [Inline]
unFormatted Formatted
g) (String -> Formatting
form "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 = String -> [Option] -> String
getOptionVal "disambiguate-add-givenname" [Option]
ops String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "true"
      initialize :: Bool
initialize   = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (String -> [Option] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "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 :: String
givenRule    = let gr :: String
gr = String -> [Option] -> String
getOptionVal "givenname-disambiguation-rule" [Option]
ops
                     in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
gr then "by-cite" else String
gr
      disambdata :: [[Output]]
disambdata   = case () of
                       _ | String
"all-names-with-initials"    <- String
givenRule
                         , Bool
disWithGiven, Form
Short <- Form
f, Bool
initialize    -> [Formatted -> [Output]
longName Formatted
given]
                         | String
"primary-name-with-initials" <- String
givenRule
                         , Bool
disWithGiven, Form
Short <- Form
f, Bool
initialize, Bool
b -> [Formatted -> [Output]
longName Formatted
given]
                         | Bool
disWithGiven, Form
Short <- Form
f, Bool
b
                         , String
"primary-name" <- String
givenRule -> [Formatted -> [Output]
longName Formatted
given, Formatted -> [Output]
longName Formatted
givenLong]
                         | Bool
disWithGiven, Form
Short <- Form
f
                         , String
"all-names"    <- String
givenRule -> [Formatted -> [Output]
longName Formatted
given, Formatted -> [Output]
longName Formatted
givenLong]
                         | Bool
disWithGiven, Form
Short <- Form
f
                         , String
"by-cite"      <- String
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 -> String -> String
           -> State EvalState [Output]
formatTerm :: Form
-> Formatting
-> Bool
-> String
-> String
-> State EvalState [Output]
formatTerm f :: Form
f fm :: Formatting
fm p :: Bool
p refid :: String
refid s :: String
s = do
  Bool
plural <- if String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["page", "volume", "issue"]
               then do
                 Bool
varset <- String -> StateT EvalState Identity Bool
isVarSet String
s
                 if Bool
varset
                    then String -> Bool
isRange (String -> Bool)
-> State EvalState String -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> State EvalState String
getStringVar String
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
  String
t <- Bool -> Form -> String -> State EvalState String
getTerm Bool
plural Form
f String
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 String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "no date"
        then [String -> String -> Formatting -> Output
OYear String
t String
refid Formatting
fm]
        else String -> Formatting -> [Output]
oStr' String
t Formatting
fm

formatLabel :: Form -> Formatting -> Bool -> String -> State EvalState [Output]
formatLabel :: Form -> Formatting -> Bool -> String -> State EvalState [Output]
formatLabel f :: Form
f fm :: Formatting
fm p :: Bool
p s :: String
s
    | String
"locator" <- String
s = StateT EvalState Identity Bool
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => m Bool -> m [a] -> m [a]
when' ( String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) [] (String -> Bool)
-> State EvalState String -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> String) -> State EvalState String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> String
citeLocator (Cite -> String) -> (EvalState -> Cite) -> EvalState -> String
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
                       (l :: String
l,v :: String
v) <- State EvalState Option
getLocVar
                       (Formatting -> String -> [Output])
-> (String -> String) -> String -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (String -> b) -> String -> Bool -> StateT EvalState Identity b
form (\fm' :: Formatting
fm' -> Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> (String -> Output) -> String -> [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) -> (String -> [Output]) -> String -> Output
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> String -> [Output]
output Formatting
fm') String -> String
forall a. a -> a
id String
l (String -> Bool
isRange String
v)
    | String
"page"    <- String
s = State EvalState [Output]
checkPlural
    | String
"volume"  <- String
s = State EvalState [Output]
checkPlural
    | String
"issue"   <- String
s = State EvalState [Output]
checkPlural
    | String
"ibid"    <- String
s = String -> Bool -> State EvalState [Output]
format String
s Bool
p
    | String -> Bool
isRole       String
s = do [Agent]
a <- String -> State EvalState [Agent]
getAgents' (if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "editortranslator"
                                              then "editor"
                                              else String
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 -> String -> [Output])
-> (String -> String) -> String -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (String -> b) -> String -> Bool -> StateT EvalState Identity b
form (\fm' :: Formatting
fm' x :: String
x -> [String -> Formatting -> Output
OLabel String
x Formatting
fm']) String -> String
forall a. a -> a
id String
s Bool
p
    | Bool
otherwise      = String -> Bool -> State EvalState [Output]
format String
s Bool
p
    where
      isRole :: String -> Bool
isRole = (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ["author", "collection-editor", "composer", "container-author"
                         ,"director", "editor", "editorial-director", "editortranslator"
                         ,"illustrator", "interviewer", "original-author", "recipient"
                         ,"reviewed-author", "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' (String -> StateT EvalState Identity Bool
isVarSet String
s) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ do
                      String
v <- String -> State EvalState String
getStringVar String
s
                      String -> Bool -> State EvalState [Output]
format  String
s (String -> Bool
isRange String
v)
      format :: String -> Bool -> State EvalState [Output]
format      = (Formatting -> String -> [Output])
-> (String -> String) -> String -> Bool -> State EvalState [Output]
forall b b.
(Formatting -> b -> b)
-> (String -> b) -> String -> Bool -> StateT EvalState Identity b
form Formatting -> String -> [Output]
output String -> String
forall a. a -> a
id
      form :: (Formatting -> b -> b)
-> (String -> b) -> String -> Bool -> StateT EvalState Identity b
form o :: Formatting -> b -> b
o g :: String -> b
g t :: String
t b :: Bool
b = Formatting -> b -> b
o Formatting
fm (b -> b) -> (String -> b) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> b
g (String -> b) -> (String -> String) -> String -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
period (String -> b)
-> State EvalState String -> StateT EvalState Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Form -> String -> State EvalState String
getTerm (Bool
b Bool -> Bool -> Bool
&& Bool
p) Form
f String
t
      period :: String -> String
period      = if Formatting -> Bool
stripPeriods Formatting
fm then (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') else String -> String
forall a. a -> a
id

(<+>) :: Formatted -> Formatted -> Formatted
Formatted [] <+> :: Formatted -> Formatted -> Formatted
<+> ss :: Formatted
ss = Formatted
ss
s :: Formatted
s  <+> Formatted [] = Formatted
s
Formatted xs :: [Inline]
xs <+> Formatted ys :: [Inline]
ys =
  case [Inline] -> String
lastInline [Inline]
xs of
       "’" -> [Inline] -> Formatted
Formatted ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys)
       "-" -> [Inline] -> Formatted
Formatted ([Inline]
xs [Inline] -> [Inline] -> [Inline]
forall a. [a] -> [a] -> [a]
++ [Inline]
ys)
       _   -> [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]
<++> o :: [Output]
o  = [Output]
o
o :: [Output]
o  <++> [] = [Output]
o
o1 :: [Output]
o1 <++> o2 :: [Output]
o2 = [Output]
o1 [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output
OSpace] [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [Output]
o2