{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Eval
-- 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
    ( evalLayout
    , evalSorting
    , module Text.CSL.Eval.Common
    , module Text.CSL.Eval.Output
    ) where

import Prelude
import           Control.Arrow
import qualified Control.Exception      as E
import           Control.Monad.State
import           Data.Char              (isDigit, isLetter, toLower)
import           Data.Maybe
import           Data.Monoid            (Any (..))
import           Data.String            (fromString)
import qualified Data.Text              as T
import           Text.Pandoc.Definition (Inline (Link, Span, Str), nullAttr)
import           Text.Pandoc.Shared     (stringify, escapeURI)
import           Text.Pandoc.Walk       (walk)

import           Text.CSL.Eval.Common
import           Text.CSL.Eval.Date
import           Text.CSL.Eval.Names
import           Text.CSL.Eval.Output
import           Text.CSL.Exception
import           Text.CSL.Output.Plain
import           Text.CSL.Reference
import           Text.CSL.Style         hiding (Any)
import           Text.CSL.Util          (orIfNull, isRange, last', proc,
                                         proc', query, readNum, safeRead)

-- | Produce the output with a 'Layout', the 'EvalMode', a 'Bool'
-- 'True' if the evaluation happens for disambiguation purposes, the
-- 'Locale', the 'MacroMap', the position of the cite and the
-- 'Reference'.
evalLayout :: Layout   -> EvalMode -> Bool -> [Locale] -> [MacroMap]
           -> [Option] -> Abbreviations -> Maybe Reference -> [Output]
evalLayout :: Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [Option]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Layout _ _ es :: [Element]
es) em :: EvalMode
em b :: Bool
b l :: [Locale]
l m :: [MacroMap]
m o :: [Option]
o a :: Abbreviations
a mbr :: Maybe Reference
mbr
    = [Output] -> [Output]
cleanOutput [Output]
evalOut
    where
      evalOut :: [Output]
evalOut = case State EvalState [Output] -> EvalState -> [Output]
forall s a. State s a -> s -> a
evalState State EvalState [Output]
job EvalState
initSt of
                  x :: [Output]
x | Maybe Reference -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Reference
mbr -> [Cite -> Output
noBibDataError Cite
cit]
                    | [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
x        -> []
                    | Bool
otherwise     -> [Output] -> [Output]
suppTC [Output]
x
      locale :: Locale
locale = case [Locale]
l of
                 [x :: Locale
x] -> Locale
x
                 _   -> String -> String -> [Option] -> [CslTerm] -> [Element] -> Locale
Locale [] [] [] [] []
      job :: State EvalState [Output]
job    = [Element] -> State EvalState [Output]
evalElements [Element]
es
      cit :: Cite
cit    = case EvalMode
em of
                 EvalCite    c :: Cite
c -> Cite
c
                 EvalSorting c :: Cite
c -> Cite
c
                 EvalBiblio  c :: Cite
c -> Cite
c
      initSt :: EvalState
initSt = ReferenceMap
-> Environment
-> [String]
-> EvalMode
-> Bool
-> Bool
-> [String]
-> [String]
-> Bool
-> [[Output]]
-> [Agent]
-> [Output]
-> EvalState
EvalState (Maybe Reference -> ReferenceMap
mkRefMap Maybe Reference
mbr) (Cite
-> [CslTerm]
-> [MacroMap]
-> [Element]
-> [Option]
-> [Element]
-> Abbreviations
-> Environment
Env Cite
cit (Locale -> [CslTerm]
localeTerms Locale
locale) [MacroMap]
m
                         (Locale -> [Element]
localeDate Locale
locale) [Option]
o [] Abbreviations
a) [] EvalMode
em Bool
b Bool
False [] [] Bool
False [] [] []
      suppTC :: [Output] -> [Output]
suppTC = let getLang :: String -> String
getLang = Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower in
               case (String -> String
getLang (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Locale -> String
localeLang Locale
locale,
                     String -> String
getLang (String -> String) -> (Reference -> String) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> String
unLiteral (Literal -> String)
-> (Reference -> Literal) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
language (Reference -> String) -> Maybe Reference -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Reference
mbr) of
                 (_,  Just "en") -> [Output] -> [Output]
forall a. a -> a
id
                 (_,  Nothing)   -> [Output] -> [Output]
forall a. a -> a
id
                 ("en", Just "") -> [Output] -> [Output]
forall a. a -> a
id
                 _               -> (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc' Output -> Output
rmTitleCase'

evalSorting :: EvalMode -> [Locale] -> [MacroMap] -> [Option] ->
               [Sort] -> Abbreviations -> Maybe Reference -> [Sorting]
evalSorting :: EvalMode
-> [Locale]
-> [MacroMap]
-> [Option]
-> [Sort]
-> Abbreviations
-> Maybe Reference
-> [Sorting]
evalSorting m :: EvalMode
m l :: [Locale]
l ms :: [MacroMap]
ms opts :: [Option]
opts ss :: [Sort]
ss as :: Abbreviations
as mbr :: Maybe Reference
mbr
    = (Sort -> Sorting) -> [Sort] -> [Sorting]
forall a b. (a -> b) -> [a] -> [b]
map ((Sorting, ([Option], Element)) -> Sorting
format ((Sorting, ([Option], Element)) -> Sorting)
-> (Sort -> (Sorting, ([Option], Element))) -> Sort -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort -> (Sorting, ([Option], Element))
sorting) [Sort]
ss
    where
      render :: [Output] -> String
render       = Formatted -> String
renderPlain (Formatted -> String)
-> ([Output] -> Formatted) -> [Output] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Formatted
formatOutputList ([Output] -> Formatted)
-> ([Output] -> [Output]) -> [Output] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
removeDelimAndLabel
      removeDelimAndLabel :: Output -> Output
removeDelimAndLabel OLabel{} = Output
ONull
      removeDelimAndLabel ODel{}   = Output
ONull
      -- for sorting purposes, we need to distinguish between the space
      -- inside a last name like ben Gurion, and the space between the
      -- last name and the first.  OSpace is used for the latter.
      removeDelimAndLabel OSpace{} = String -> Formatting -> Output
OStr "," Formatting
emptyFormatting
      removeDelimAndLabel x :: Output
x          = Output
x
      format :: (Sorting, ([Option], Element)) -> Sorting
format (s :: Sorting
s,e :: ([Option], Element)
e) = Sorting -> String -> Sorting
applaySort Sorting
s (String -> Sorting) -> ([Output] -> String) -> [Output] -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> String
render ([Output] -> Sorting) -> [Output] -> Sorting
forall a b. (a -> b) -> a -> b
$ ([Option] -> Element -> [Output])
-> ([Option], Element) -> [Output]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Option] -> Element -> [Output]
eval ([Option], Element)
e
      eval :: [Option] -> Element -> [Output]
eval     o :: [Option]
o e :: Element
e = Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [Option]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Formatting -> String -> [Element] -> Layout
Layout Formatting
emptyFormatting [] [Element
e]) EvalMode
m Bool
False [Locale]
l [MacroMap]
ms [Option]
o Abbreviations
as Maybe Reference
mbr
      applaySort :: Sorting -> String -> Sorting
applaySort c :: Sorting
c s :: String
s
          | Ascending {} <- Sorting
c = String -> Sorting
Ascending  String
s
          | Bool
otherwise         = String -> Sorting
Descending String
s

      unsetOpts :: (String, String) -> (String, String)
      unsetOpts :: Option -> Option
unsetOpts ("et-al-min"                 ,_) = ("et-al-min"           ,"")
      unsetOpts ("et-al-use-first"           ,_) = ("et-al-use-first"     ,"")
      unsetOpts ("et-al-subsequent-min"      ,_) = ("et-al-subsequent-min","")
      unsetOpts ("et-al-subsequent-use-first",_) = ("et-al-subsequent-use-first","")
      unsetOpts  x :: Option
x                               = Option
x
      setOpts :: [a] -> a -> ([a], String)
setOpts s :: [a]
s i :: a
i = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then ([a]
s, a -> String
forall a. Show a => a -> String
show a
i) else ([],[])
      sorting :: Sort -> (Sorting, ([Option], Element))
sorting s :: Sort
s
          = case Sort
s of
              SortVariable str :: String
str s' :: Sorting
s'     -> (Sorting
s', ( ("name-as-sort-order","all") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
opts
                                              , [String] -> Form -> Formatting -> String -> Element
Variable [String
str] Form
Long Formatting
emptyFormatting []))
              SortMacro  str :: String
str s' :: Sorting
s' a :: Int
a b :: Int
b c :: String
c -> (Sorting
s', ( String -> Int -> Option
forall a a. (Eq a, Num a, Show a) => [a] -> a -> ([a], String)
setOpts "et-al-min"       Int
a Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: ("et-al-use-last",String
c) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
:
                                                String -> Int -> Option
forall a a. (Eq a, Num a, Show a) => [a] -> a -> ([a], String)
setOpts "et-al-use-first" Int
b Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: (Option -> Option) -> [Option] -> [Option]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Option -> Option
unsetOpts [Option]
opts
                                              , String -> Formatting -> Element
Macro String
str Formatting
emptyFormatting))

evalElements :: [Element] -> State EvalState [Output]
evalElements :: [Element] -> State EvalState [Output]
evalElements = (Element -> State EvalState [Output])
-> [Element] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM Element -> State EvalState [Output]
evalElement

evalElement :: Element -> State EvalState [Output]
evalElement :: Element -> State EvalState [Output]
evalElement el :: Element
el
    | Const    s :: String
s   fm :: Formatting
fm       <- Element
el = [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]
addSpaces String
s
                                           ([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ if Formatting
fm Formatting -> Formatting -> Bool
forall a. Eq a => a -> a -> Bool
== Formatting
emptyFormatting
                                                then [[Inline] -> Output
OPan (String -> [Inline]
readCSLString String
s)]
                                                else [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan (String -> [Inline]
readCSLString String
s)] Formatting
fm]
                                    -- NOTE: this conditional seems needed for
                                    -- locator_SimpleLocators.json:
    | Number   s :: String
s f :: NumericForm
f fm :: Formatting
fm       <- Element
el = if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "locator"
                                       then State EvalState Option
getLocVar State EvalState Option
-> (Option -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm (String -> State EvalState [Output])
-> (Option -> String) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> b
snd
                                       else NumericForm
-> Formatting -> String -> String -> State EvalState [Output]
formatNumber NumericForm
f Formatting
fm String
s (String -> State EvalState [Output])
-> StateT EvalState Identity String -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                            String -> StateT EvalState Identity String
getStringVar String
s
    | Variable s :: [String]
s f :: Form
f fm :: Formatting
fm d :: String
d     <- Element
el = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> State EvalState [Output])
-> [String] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM (Form -> Formatting -> String -> State EvalState [Output]
getVariable Form
f Formatting
fm) [String]
s
    | Group        fm :: Formatting
fm d :: String
d l :: [Element]
l   <- Element
el = Formatting -> String -> [Output] -> [Output]
outputList Formatting
fm String
d ([Output] -> [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element] -> State EvalState [Output]
tryGroup [Element]
l
    | Date{} <- Element
el = Element -> State EvalState [Output]
evalDate Element
el
    | Label    s :: String
s f :: Form
f fm :: Formatting
fm _     <- Element
el = Form -> Formatting -> Bool -> String -> State EvalState [Output]
formatLabel Form
f Formatting
fm Bool
True String
s -- FIXME !!
    | Term     s :: String
s f :: Form
f fm :: Formatting
fm p :: Bool
p     <- Element
el = String -> StateT EvalState Identity String
getStringVar "ref-id" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \refid :: String
refid ->
                                      Form
-> Formatting
-> Bool
-> String
-> String
-> State EvalState [Output]
formatTerm  Form
f Formatting
fm Bool
p String
refid  String
s
    | Names    s :: [String]
s n :: [Name]
n fm :: Formatting
fm d :: String
d sub :: [Element]
sub <- Element
el = (EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: EvalState
st -> EvalState
st { contNum :: [Agent]
contNum = [] }) StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                    State EvalState [Output]
-> State EvalState [Output]
-> ([Output] -> [Output])
-> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a b.
(Monad m, Foldable t) =>
m (t a) -> m b -> (t a -> b) -> m b
ifEmpty (Bool -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames Bool
False [String]
s [Name]
n String
d)
                                            ([String]
-> Element -> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) b.
MonadState EvalState m =>
[String] -> Element -> m b -> m b
withNames [String]
s Element
el (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ [Element] -> State EvalState [Output]
evalElements [Element]
sub)
                                            (Formatting -> [Output] -> [Output]
appendOutput Formatting
fm)
    | Substitute (e :: Element
e:els :: [Element]
els)    <- Element
el = do
                        [Output]
res <- State EvalState [Output] -> State EvalState [Output]
forall a. State EvalState a -> State EvalState a
consuming (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Element -> State EvalState [Output]
substituteWith Element
e
                        if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
res
                           then if [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
els
                                   then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output
ONull]
                                   else Element -> State EvalState [Output]
evalElement ([Element] -> Element
Substitute [Element]
els)
                           else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
res
    -- All macros and conditionals should have been expanded
    | Choose i :: IfThen
i ei :: [IfThen]
ei xs :: [Element]
xs        <- Element
el = do
                        [Element]
res <- IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen IfThen
i [IfThen]
ei [Element]
xs
                        [Element] -> State EvalState [Output]
evalElements [Element]
res
    | Macro    s :: String
s   fm :: Formatting
fm       <- Element
el = do
                        [MacroMap]
ms <- (EvalState -> [MacroMap]) -> StateT EvalState Identity [MacroMap]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [MacroMap]
macros (Environment -> [MacroMap])
-> (EvalState -> Environment) -> EvalState -> [MacroMap]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
                        case String -> [MacroMap] -> Maybe [Element]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [MacroMap]
ms of
                             Nothing  -> CiteprocException -> State EvalState [Output]
forall a e. Exception e => e -> a
E.throw (CiteprocException -> State EvalState [Output])
-> CiteprocException -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
MacroNotFound (String -> String
forall a. Show a => a -> String
show String
s)
                             Just els :: [Element]
els -> do
                               [Output]
res <- [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output])
-> StateT EvalState Identity [[Output]] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> State EvalState [Output])
-> [Element] -> StateT EvalState Identity [[Output]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> State EvalState [Output]
evalElement [Element]
els
                               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 [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [Output]
res Formatting
fm]
    | Bool
otherwise                   = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    where
      addSpaces :: String -> [Output] -> [Output]
addSpaces strng :: String
strng = (if Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 String
strng String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== " " then (Output
OSpaceOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:) else [Output] -> [Output]
forall a. a -> a
id) ([Output] -> [Output])
-> ([Output] -> [Output]) -> [Output] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        (if String -> String
forall a. [a] -> [a]
last' String
strng String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== " " then ([Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++[Output
OSpace]) else [Output] -> [Output]
forall a. a -> a
id)
      substituteWith :: Element -> State EvalState [Output]
substituteWith e :: Element
e =
        (EvalState -> [Element]) -> State EvalState [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Element]
names (Environment -> [Element])
-> (EvalState -> Environment) -> EvalState -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env) State EvalState [Element]
-> ([Element] -> State EvalState [Output])
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          (Names _ ns :: [Name]
ns fm :: Formatting
fm d :: String
d _ : _) -> Element -> State EvalState [Output]
evalElement (Element -> State EvalState [Output])
-> Element -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Element -> Element) -> Element -> Element
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Element -> Element
replaceNames Element
e
             where
               replaceNames :: Element -> Element
replaceNames (Names rs :: [String]
rs [Name NotSet fm'' :: Formatting
fm'' [] [] []] fm' :: Formatting
fm' d' :: String
d' []) =
                  let nfm :: Formatting
nfm = Formatting -> Formatting -> Formatting
mergeFM Formatting
fm'' (Formatting -> Formatting) -> Formatting -> Formatting
forall a b. (a -> b) -> a -> b
$ Formatting -> Formatting -> Formatting
mergeFM Formatting
fm' Formatting
fm in
                  [String] -> [Name] -> Formatting -> String -> [Element] -> Element
Names [String]
rs [Name]
ns Formatting
nfm (String
d' String -> String -> String
forall a. [a] -> [a] -> [a]
`orIfNull` String
d) []
               replaceNames x :: Element
x = Element
x
          _ -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []

      -- from citeproc documentation: "cs:group implicitly acts as a
      -- conditional: cs:group and its child elements are suppressed if
      -- a) at least one rendering element in cs:group calls a variable
      -- (either directly or via a macro), and b) all variables that are
      -- called are empty. This accommodates descriptive cs:text elements."

      -- TODO:  problem, this approach gives wrong results when the variable
      -- is in a conditional and the other branch is followed.  the term
      -- provided by the other branch (e.g. 'n.d.') is not printed.  we
      -- should ideally expand conditionals when we expand macros.
      tryGroup :: [Element] -> State EvalState [Output]
tryGroup l :: [Element]
l = if Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (Element -> Any) -> [Element] -> Any
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Element -> Any
hasVar [Element]
l
                   then do
                     EvalState
oldState <- StateT EvalState Identity EvalState
forall s (m :: * -> *). MonadState s m => m s
get
                     [Output]
res <- [Element] -> State EvalState [Output]
evalElements ([Element] -> [Element]
rmTermConst [Element]
l)
                     EvalState -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put EvalState
oldState
                     let numVars :: [String]
numVars = [String
s | Number s :: String
s _ _ <- [Element]
l]
                     [String]
nums <- (String -> StateT EvalState Identity String)
-> [String] -> StateT EvalState Identity [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EvalState Identity String
getStringVar [String]
numVars
                     let pluralizeTerm :: Element -> Element
pluralizeTerm (Term s :: String
s f :: Form
f fm :: Formatting
fm _) = String -> Form -> Formatting -> Bool -> Element
Term String
s Form
f Formatting
fm (Bool -> Element) -> Bool -> Element
forall a b. (a -> b) -> a -> b
$
                            case [String]
numVars of
                              ["number-of-volumes"] -> "1" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
nums
                              ["number-of-pages"]   -> "1" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
nums
                              _ -> (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
isRange [String]
nums
                         pluralizeTerm x :: Element
x = Element
x
                     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 [Element] -> State EvalState [Output]
evalElements ([Element] -> State EvalState [Output])
-> [Element] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Element -> Element) -> [Element] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Element
pluralizeTerm [Element]
l
                   else [Element] -> State EvalState [Output]
evalElements [Element]
l
      hasVar :: Element -> Any
hasVar e :: Element
e
          | Variable {} <- Element
e = Bool -> Any
Any Bool
True
          | Date     {} <- Element
e = Bool -> Any
Any Bool
True
          | Names    {} <- Element
e = Bool -> Any
Any Bool
True
          | Number   {} <- Element
e = Bool -> Any
Any Bool
True
          | Bool
otherwise        = Bool -> Any
Any Bool
False
      rmTermConst :: [Element] -> [Element]
rmTermConst = ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc (([Element] -> [Element]) -> [Element] -> [Element])
-> ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Element -> Bool) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Bool
isTermConst)
      isTermConst :: Element -> Bool
isTermConst e :: Element
e
          | Term  {} <- Element
e = Bool
True
          | Const {} <- Element
e = Bool
True
          | Bool
otherwise     = Bool
False

      ifEmpty :: m (t a) -> m b -> (t a -> b) -> m b
ifEmpty p :: m (t a)
p t :: m b
t e :: t a -> b
e = m (t a)
p m (t a) -> (t a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: t a
r -> if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
r then m b
t else b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (t a -> b
e t a
r)

      withNames :: [String] -> Element -> m b -> m b
withNames e :: [String]
e n :: Element
n f :: m b
f = (EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: EvalState
s -> EvalState
s { authSub :: [String]
authSub = [String]
e [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ EvalState -> [String]
authSub EvalState
s
                                        , env :: Environment
env = (EvalState -> Environment
env EvalState
s)
                                          {names :: [Element]
names = Element
n Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Environment -> [Element]
names (EvalState -> Environment
env EvalState
s)}}) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
f m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: b
r ->
                         (EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: EvalState
s -> EvalState
s { authSub :: [String]
authSub = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 [String]
e) (EvalState -> [String]
authSub EvalState
s)
                                        , env :: Environment
env = (EvalState -> Environment
env EvalState
s)
                                          {names :: [Element]
names = [Element] -> [Element]
forall a. [a] -> [a]
tail ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Environment -> [Element]
names (EvalState -> Environment
env EvalState
s)}}) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r

      getVariable :: Form -> Formatting -> String -> State EvalState [Output]
getVariable f :: Form
f fm :: Formatting
fm s :: String
s
        | String -> Bool
isTitleVar String
s Bool -> Bool -> Bool
|| String -> Bool
isTitleShortVar String
s =
             String -> StateT EvalState Identity ()
consumeVariable String
s StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Form -> Formatting -> State EvalState [Output]
formatTitle String
s Form
f Formatting
fm
        | Bool
otherwise =
             case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
               "first-reference-note-number"
                             -> do String
refid <- String -> StateT EvalState Identity String
getStringVar "ref-id"
                                   [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Inline
Span ("",["first-reference-note-number"],[("refid",String -> Text
T.pack String
refid)]) [Text -> Inline
Str "0"]]] Formatting
fm]

               "year-suffix" -> String -> StateT EvalState Identity String
getStringVar "ref-id" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: String
k  ->
                                [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]
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 -> String -> [Output] -> Formatting -> Output
OYearSuf [] String
k [] Formatting
fm
               "status"      -> do
                  (opts :: [Option]
opts, as :: Abbreviations
as) <- (EvalState -> ([Option], Abbreviations))
-> StateT EvalState Identity ([Option], Abbreviations)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EvalState -> Environment
env (EvalState -> Environment)
-> (Environment -> ([Option], Abbreviations))
-> EvalState
-> ([Option], Abbreviations)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Environment -> [Option]
options (Environment -> [Option])
-> (Environment -> Abbreviations)
-> Environment
-> ([Option], Abbreviations)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Environment -> Abbreviations
abbrevs)
                  [Output]
r <- [Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [Output]
forall a. Monoid a => a
mempty ([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm String
s)
                        "status"
                  String -> StateT EvalState Identity ()
consumeVariable String
s
                  [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r
               "page"        -> String -> StateT EvalState Identity String
getStringVar "page" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm
               "locator"     -> State EvalState Option
getLocVar State EvalState Option
-> (Option -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm (String -> State EvalState [Output])
-> (Option -> String) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> b
snd
               "url"         -> String -> StateT EvalState Identity String
getStringVar "url" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: String
k ->
                                if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
k then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
k] (Text -> Text
escapeURI (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
k,"")]] Formatting
fm]
               "doi"         -> do String
d <- String -> StateT EvalState Identity String
getStringVar "doi"
                                   let (prefixPart :: Text
prefixPart, linkPart :: Text
linkPart) = Text -> Text -> Target
T.breakOn (String -> Text
T.pack "http") (String -> Text
T.pack (Formatting -> String
prefix Formatting
fm))
                                   let u :: String
u = if Text -> Bool
T.null Text
linkPart
                                              then "https://doi.org/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
                                              else Text -> String
T.unpack Text
linkPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
                                   if 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 []
                                      else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text
linkPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
d)] (Text -> Text
escapeURI (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u, "")]]
                                            Formatting
fm{ prefix :: String
prefix = Text -> String
T.unpack Text
prefixPart, suffix :: String
suffix = Formatting -> String
suffix Formatting
fm }]
               "isbn"        -> String -> StateT EvalState Identity String
getStringVar "isbn" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
                                if 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 []
                                   else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://worldcat.org/isbn/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
               "pmid"        -> String -> StateT EvalState Identity String
getStringVar "pmid" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
                                if 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 []
                                   else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://www.ncbi.nlm.nih.gov/pubmed/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
               "pmcid"       -> String -> StateT EvalState Identity String
getStringVar "pmcid" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
                                if 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 []
                                   else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://www.ncbi.nlm.nih.gov/pmc/articles/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
               _ -> do (opts :: [Option]
opts, as :: Abbreviations
as) <- (EvalState -> ([Option], Abbreviations))
-> StateT EvalState Identity ([Option], Abbreviations)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EvalState -> Environment
env (EvalState -> Environment)
-> (Environment -> ([Option], Abbreviations))
-> EvalState
-> ([Option], Abbreviations)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Environment -> [Option]
options (Environment -> [Option])
-> (Environment -> Abbreviations)
-> Environment
-> ([Option], Abbreviations)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Environment -> Abbreviations
abbrevs)
                       [Output]
r <- [Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar []
                              ([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm String
s) String
s
                       String -> StateT EvalState Identity ()
consumeVariable String
s
                       [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r

evalIfThen :: IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen :: IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen (IfThen c' :: Condition
c' m' :: Match
m' el' :: [Element]
el') ei :: [IfThen]
ei e :: [Element]
e = StateT EvalState Identity Bool
-> State EvalState [Element]
-> State EvalState [Element]
-> State EvalState [Element]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
whenElse (Match -> Condition -> StateT EvalState Identity Bool
evalCond Match
m' Condition
c') ([Element] -> State EvalState [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
el') State EvalState [Element]
rest
  where
      rest :: State EvalState [Element]
rest = case [IfThen]
ei of
                  []     -> [Element] -> State EvalState [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
e
                  (x :: IfThen
x:xs :: [IfThen]
xs) -> IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen IfThen
x [IfThen]
xs [Element]
e
      evalCond :: Match -> Condition -> StateT EvalState Identity Bool
evalCond m :: Match
m c :: Condition
c = do [Bool]
t <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkType         Condition -> [String]
isType          Condition
c Match
m
                        [Bool]
v <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
isVarSet        Condition -> [String]
isSet           Condition
c Match
m
                        [Bool]
n <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkNumeric      Condition -> [String]
isNumeric       Condition
c Match
m
                        [Bool]
d <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkDate         Condition -> [String]
isUncertainDate Condition
c Match
m
                        [Bool]
p <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
forall a (m :: * -> *).
(Eq a, IsString a, MonadState EvalState m) =>
a -> m Bool
chkPosition     Condition -> [String]
isPosition      Condition
c Match
m
                        [Bool]
a <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
forall (f :: * -> *). MonadState EvalState f => String -> f Bool
chkDisambiguate Condition -> [String]
disambiguation  Condition
c Match
m
                        [Bool]
l <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkLocator      Condition -> [String]
isLocator       Condition
c Match
m
                        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
$ Match -> [Bool] -> Bool
match Match
m ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]
t,[Bool]
v,[Bool]
n,[Bool]
d,[Bool]
p,[Bool]
a,[Bool]
l]

      checkCond :: (a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond a :: a -> m Bool
a f :: t -> [a]
f c :: t
c m :: Match
m = case t -> [a]
f t
c of
                               []  -> case Match
m of
                                           All -> [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool
True]
                                           _   -> [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool
False]
                               xs :: [a]
xs  -> (a -> m Bool) -> [a] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m Bool
a [a]
xs

      chkType :: String -> StateT EvalState Identity Bool
chkType         t :: String
t = let chk :: Value -> Bool
chk = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String
formatVariable String
t) (String -> Bool) -> (Value -> String) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefType -> String
forall a. Show a => a -> String
show (RefType -> String) -> (Value -> RefType) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefType -> Maybe RefType -> RefType
forall a. a -> Maybe a -> a
fromMaybe RefType
NoType (Maybe RefType -> RefType)
-> (Value -> Maybe RefType) -> Value -> RefType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe RefType
forall a. Data a => Value -> Maybe a
fromValue
                          in  Bool -> (Value -> Bool) -> String -> StateT EvalState Identity Bool
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar Bool
False Value -> Bool
chk "ref-type"
      chkNumeric :: String -> StateT EvalState Identity Bool
chkNumeric      v :: String
v = do String
val <- String -> StateT EvalState Identity String
getStringVar String
v
                             Abbreviations
as  <- (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
                             let val' :: String
val' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
val)
                                           then String
val
                                           else Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
val
                             Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Bool
isNumericString String
val')
      chkDate :: String -> StateT EvalState Identity Bool
chkDate         v :: String
v = (RefDate -> Bool) -> [RefDate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RefDate -> Bool
circa ([RefDate] -> Bool)
-> StateT EvalState Identity [RefDate]
-> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StateT EvalState Identity [RefDate]
getDateVar String
v
      chkPosition :: a -> m Bool
chkPosition     s :: a
s = if a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "near-note"
                          then (EvalState -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> Bool
nearNote (Cite -> Bool) -> (EvalState -> Cite) -> EvalState -> Bool
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)
                          else a -> String -> Bool
forall a a. (Eq a, Eq a, IsString a, IsString a) => a -> a -> Bool
compPosition a
s (String -> Bool) -> m String -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> String) -> m 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)
      chkDisambiguate :: String -> f Bool
chkDisambiguate s :: String
s = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String
formatVariable String
s) (String -> Bool) -> (Bool -> String) -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Bool -> String) -> Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> Bool) -> f Bool -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> Bool) -> f Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> Bool
disamb
      chkLocator :: String -> StateT EvalState Identity Bool
chkLocator      v :: String
v = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
v (String -> Bool) -> (Option -> String) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> a
fst (Option -> Bool)
-> State EvalState Option -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State EvalState Option
getLocVar
      isIbid :: a -> Bool
isIbid          s :: a
s = Bool -> Bool
not (a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "first" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "subsequent")
      compPosition :: a -> a -> Bool
compPosition a :: a
a b :: a
b
          | a
"first"             <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "first"
          | a
"subsequent"        <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= "first"
          | a
"ibid-with-locator" <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "ibid-with-locator" Bool -> Bool -> Bool
||
                                       a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "ibid-with-locator-c"
          | Bool
otherwise                = a -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isIbid a
b

getFormattedValue :: [Option] -> Abbreviations -> Form -> Formatting -> String -> Value -> [Output]
getFormattedValue :: [Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue o :: [Option]
o as :: Abbreviations
as f :: Form
f fm :: Formatting
fm s :: String
s val :: Value
val
    | Just (Formatted v :: [Inline]
v) <- Value -> Maybe Formatted
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Formatted =
       case [Inline]
v of
          [] -> []
          _  -> case [Inline] -> (String -> [Inline]) -> Maybe String -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Inline]
v (Formatted -> [Inline]
unFormatted (Formatted -> [Inline])
-> (String -> Formatted) -> String -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formatted
forall a. IsString a => String -> a
fromString) (Maybe String -> [Inline]) -> Maybe String -> [Inline]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
getAbbr (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
v) of
                  [] -> []
                  ys :: [Inline]
ys -> [[Output] -> Formatting -> Output
Output [(if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "status"
                                     then [Inline] -> Output
OStatus
                                     else [Inline] -> Output
OPan) ([Inline] -> Output) -> [Inline] -> Output
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
value' [Inline]
ys] Formatting
fm]
    | Just v :: String
v <- Value -> Maybe String
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe String =
         case String -> String
value String
v of
            [] -> []
            xs :: String
xs -> case String -> Maybe String
getAbbr String
xs of
                    Nothing -> [String -> Formatting -> Output
OStr String
xs Formatting
fm]
                    Just ys :: String
ys -> [String -> Formatting -> Output
OStr String
ys Formatting
fm]
    | Just (Literal v :: String
v) <- Value -> Maybe Literal
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Literal =
         case String -> String
value String
v of
            [] -> []
            xs :: String
xs -> case String -> Maybe String
getAbbr String
xs of
                    Nothing -> [String -> Formatting -> Output
OStr String
xs Formatting
fm]
                    Just ys :: String
ys -> [String -> Formatting -> Output
OStr String
ys Formatting
fm]
    | Just v :: Int
v <- Value -> Maybe Int
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Int       = Formatting -> String -> [Output]
output  Formatting
fm (if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else Int -> String
forall a. Show a => a -> String
show Int
v)
    | Just v :: CNum
v <- Value -> Maybe CNum
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe CNum      = if CNum
v CNum -> CNum -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else [Int -> Formatting -> Output
OCitNum (CNum -> Int
unCNum CNum
v) Formatting
fm]
    | Just v :: CLabel
v <- Value -> Maybe CLabel
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe CLabel    = if CLabel
v CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
forall a. Monoid a => a
mempty then [] else [String -> Formatting -> Output
OCitLabel (CLabel -> String
unCLabel CLabel
v) Formatting
fm]
    | Just v :: [RefDate]
v <- Value -> Maybe [RefDate]
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe [RefDate] = EvalMode
-> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate (Cite -> EvalMode
EvalSorting Cite
emptyCite) [] [] [DatePart]
sortDate [RefDate]
v
    | Just v :: [Agent]
v <- Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe [Agent]   = (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 (Cite -> EvalMode
EvalSorting Cite
emptyCite) Bool
True Form
f
                                                              Formatting
fm [Option]
nameOpts []) [Agent]
v
    | Bool
otherwise                                  = []
    where
      value :: String -> String
value     = 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
      value' :: Inline -> Inline
value' (Str x :: Text
x) = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
value (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
      value' x :: Inline
x       = Inline
x
      getAbbr :: String -> Maybe String
getAbbr v :: String
v = if Form
f Form -> Form -> Bool
forall a. Eq a => a -> a -> Bool
== Form
Short
                  then case Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
s String
v of
                             [] -> Maybe String
forall a. Maybe a
Nothing
                             y :: String
y  -> String -> Maybe String
forall a. a -> Maybe a
Just String
y
                  else Maybe String
forall a. Maybe a
Nothing
      nameOpts :: [Option]
nameOpts = ("name-as-sort-order","all") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
o
      sortDate :: [DatePart]
sortDate = [ String -> String -> String -> Formatting -> DatePart
DatePart "year"  "numeric-leading-zeros" "" Formatting
emptyFormatting
                 , String -> String -> String -> Formatting -> DatePart
DatePart "month" "numeric-leading-zeros" "" Formatting
emptyFormatting
                 , String -> String -> String -> Formatting -> DatePart
DatePart "day"   "numeric-leading-zeros" "" Formatting
emptyFormatting]

formatTitle :: String -> Form -> Formatting -> State EvalState [Output]
formatTitle :: String -> Form -> Formatting -> State EvalState [Output]
formatTitle s :: String
s f :: Form
f fm :: Formatting
fm
    | Form
Short <- Form
f
    , String -> Bool
isTitleVar      String
s = State EvalState [Output]
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
try (String -> State EvalState [Output]
getIt (String -> State EvalState [Output])
-> String -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-short") (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> State EvalState [Output]
getIt String
s
    | String -> Bool
isTitleShortVar String
s = State EvalState [Output]
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
try (String -> State EvalState [Output]
getIt String
s) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[]) (Output -> [Output]) -> (String -> Output) -> String -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Formatting -> Output) -> Formatting -> String -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Formatting -> Output
OStr Formatting
fm (String -> [Output])
-> StateT EvalState Identity String -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StateT EvalState Identity String
getTitleShort String
s
    | Bool
otherwise         = String -> State EvalState [Output]
getIt String
s
    where
      try :: m (t a) -> m (t a) -> m (t a)
try g :: m (t a)
g h :: m (t a)
h = m (t a)
g m (t a) -> (t a -> m (t a)) -> m (t a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: t a
r -> if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
r then m (t a)
h else t a -> m (t a)
forall (m :: * -> *) a. Monad m => a -> m a
return t a
r
      getIt :: String -> State EvalState [Output]
getIt x :: String
x = 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)
        Abbreviations
a <- (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
        [Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [] ([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
o Abbreviations
a Form
f Formatting
fm String
x) String
x

formatNumber :: NumericForm -> Formatting -> String -> String -> State EvalState [Output]
formatNumber :: NumericForm
-> Formatting -> String -> String -> State EvalState [Output]
formatNumber f :: NumericForm
f fm :: Formatting
fm v :: String
v n :: String
n
    = (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env) StateT EvalState Identity Abbreviations
-> (Abbreviations -> State EvalState [Output])
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \as :: Abbreviations
as ->
      if String -> Bool
isNumericString (Abbreviations -> String -> String
getAbbr Abbreviations
as String
n)
      then Formatting -> String -> [Output]
output Formatting
fm (String -> [Output])
-> ([CslTerm] -> String) -> [CslTerm] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CslTerm] -> String -> String) -> String -> [CslTerm] -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip [CslTerm] -> String -> String
process (Abbreviations -> String -> String
getAbbr Abbreviations
as String
n) ([CslTerm] -> [Output])
-> StateT EvalState Identity [CslTerm] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
      else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> (String -> [Output]) -> String -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> String -> [Output]
output Formatting
fm (String -> [Output]) -> (String -> String) -> String -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abbreviations -> String -> String
getAbbr Abbreviations
as (String -> State EvalState [Output])
-> String -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String
n
    where
      getAbbr :: Abbreviations -> String -> String
getAbbr       as :: Abbreviations
as   = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
n)
                              then String -> String
forall a. a -> a
id
                              else Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v
      checkRange' :: [CslTerm] -> String -> String
checkRange'   ts :: [CslTerm]
ts   = if String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "page" then [CslTerm] -> String -> String
checkRange [CslTerm]
ts else String -> String
forall a. a -> a
id
      process :: [CslTerm] -> String -> String
process       ts :: [CslTerm]
ts   = [CslTerm] -> String -> String
checkRange' [CslTerm]
ts (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
printNumStr ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([CslTerm] -> String -> String
renderNumber [CslTerm]
ts) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           [String] -> [String]
breakNumericString ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
      renderNumber :: [CslTerm] -> String -> String
renderNumber  ts :: [CslTerm]
ts x :: String
x = if String -> Bool
isTransNumber String
x then [CslTerm] -> Text -> String
format [CslTerm]
ts (String -> Text
T.pack String
x) else String
x

      format :: [CslTerm] -> Text -> String
format tm :: [CslTerm]
tm = case NumericForm
f of
                    Ordinal     -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> String -> Int -> String
ordinal     [CslTerm]
tm String
v) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
                    LongOrdinal -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> String -> Int -> String
longOrdinal [CslTerm]
tm String
v) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
                    Roman       -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ""
                                   (\x :: Int
x -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 6000 then Int -> String
roman Int
x else Int -> String
forall a. Show a => a -> String
show Int
x) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
                    _           -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Int -> String
forall a. Show a => a -> String
show (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead :: T.Text -> Maybe Int)

      roman :: Int -> String
      roman :: Int -> String
roman     = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Int -> [String]) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> (Int -> [String]) -> Int -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Int -> String) -> [[String]] -> [Int] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> Int -> String
forall a. [a] -> Int -> a
(!!) [[String]]
romanList ([Int] -> [String]) -> (Int -> [Int]) -> Int -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
readNum (String -> Int) -> (Char -> String) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return) (String -> [Int]) -> (Int -> String) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take 4 (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
      romanList :: [[String]]
romanList = [[ "", "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix" ]
                  ,[ "", "x", "xx", "xxx", "xl", "l", "lx", "lxx", "lxxx", "xc" ]
                  ,[ "", "c", "cc", "ccc", "cd", "d", "dc", "dcc", "dccc", "cm" ]
                  ,[ "", "m", "mm", "mmm", "mmmm", "mmmmm"]
                  ]


checkRange :: [CslTerm] -> String -> String
checkRange :: [CslTerm] -> String -> String
checkRange _ [] = []
checkRange ts :: [CslTerm]
ts (x :: Char
x:xs :: String
xs) = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\x2013'
                       then [CslTerm] -> String
pageRange [CslTerm]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ [CslTerm] -> String -> String
checkRange [CslTerm]
ts String
xs
                       else Char
x             Char -> String -> String
forall a. a -> [a] -> [a]
: [CslTerm] -> String -> String
checkRange [CslTerm]
ts String
xs

printNumStr :: [String] -> String
printNumStr :: [String] -> String
printNumStr []     = []
printNumStr [x :: String
x] = String
x
printNumStr (x :: String
x:"-":y :: String
y:xs :: [String]
xs) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
printNumStr (x :: String
x:",":y :: String
y:xs :: [String]
xs) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
printNumStr (x :: String
x:xs :: [String]
xs)
    | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-"  = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++        [String] -> String
printNumStr [String]
xs
    | Bool
otherwise = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs

pageRange :: [CslTerm] -> String
pageRange :: [CslTerm] -> String
pageRange = String -> (CslTerm -> String) -> Maybe CslTerm -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "\x2013" CslTerm -> String
termPlural (Maybe CslTerm -> String)
-> ([CslTerm] -> Maybe CslTerm) -> [CslTerm] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm "page-range-delimiter" Form
Long

isNumericString :: String -> Bool
isNumericString :: String -> Bool
isNumericString [] = Bool
False
isNumericString s :: String
s  = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\c :: String
c -> String -> Bool
isNumber String
c Bool -> Bool -> Bool
|| String -> Bool
isSpecialChar String
c) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s

isTransNumber, isSpecialChar,isNumber :: String -> Bool
isTransNumber :: String -> Bool
isTransNumber = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit
isSpecialChar :: String -> Bool
isSpecialChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-,.\x2013" :: String))
isNumber :: String -> Bool
isNumber   cs :: String
cs = case [Char
c | Char
c <- String
cs
                        , Bool -> Bool
not (Char -> Bool
isLetter Char
c)
                        , Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ("&-.,\x2013" :: String)] of
                     [] -> Bool
False
                     xs :: String
xs -> (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
xs

breakNumericString :: [String] -> [String]
breakNumericString :: [String] -> [String]
breakNumericString [] = []
breakNumericString (x :: String
x:xs :: [String]
xs)
    | String -> Bool
isTransNumber String
x = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
breakNumericString [String]
xs
    | Bool
otherwise       = let (a :: String
a,b :: String
b) = (Char -> Bool) -> String -> Option
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) String
x
                            (c :: String
c,d :: String
d) = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b
                                       then ("","")
                                       else (Char -> Bool) -> String -> Option
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) String
b
                        in (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= []) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$  String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
breakNumericString (String
d String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)

formatRange :: Formatting -> String -> State EvalState [Output]
formatRange :: Formatting -> String -> State EvalState [Output]
formatRange _ [] = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
formatRange fm :: Formatting
fm p :: String
p = do
  [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)
  [CslTerm]
ts  <- (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
  let opt :: String
opt = String -> [Option] -> String
getOptionVal "page-range-format" [Option]
ops
      pages :: [Option]
pages = [String] -> [Option]
tupleRange ([String] -> [Option])
-> (String -> [String]) -> String -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
breakNumericString ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [Option]) -> String -> [Option]
forall a b. (a -> b) -> a -> b
$ String
p

      tupleRange :: [String] -> [Option]
tupleRange [] = []
      tupleRange [x :: String
x, cs :: String
cs]
        | String
cs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["-", "--", "\x2013"] = Option -> [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x,[])
      tupleRange (x :: String
x:cs :: String
cs:y :: String
y:xs :: [String]
xs)
        | String
cs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["-", "--", "\x2013"] = (String
x, String
y) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [String] -> [Option]
tupleRange [String]
xs
      tupleRange (x :: String
x:      xs :: [String]
xs) = (String
x,[]) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [String] -> [Option]
tupleRange [String]
xs

      joinRange :: Option -> String
joinRange (a :: String
a, []) = String
a
      joinRange (a :: String
a,  b :: String
b) = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b

      process :: [Option] -> String
process = [CslTerm] -> String -> String
checkRange [CslTerm]
ts (String -> String) -> ([Option] -> String) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
printNumStr ([String] -> String)
-> ([Option] -> [String]) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case String
opt of
                 "expanded"    -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
expandedRange)
                 "chicago"     -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
chicagoRange )
                 "minimal"     -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange 1)
                 "minimal-two" -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange 2)
                 _             -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
joinRange
  [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
OLoc [String -> Formatting -> Output
OStr ([Option] -> String
process [Option]
pages) Formatting
emptyFormatting] Formatting
fm]

-- Abbreviated page ranges are expanded to their non-abbreviated form:
-- 42–45, 321–328, 2787–2816
expandedRange :: (String, String) -> (String, String)
expandedRange :: Option -> Option
expandedRange (sa :: String
sa, []) = (String
sa,[])
expandedRange (sa :: String
sa, sb :: String
sb)
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sa =
      case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sa), Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sb)) of
           -- check to make sure we have regular numbers
           (Just (Int
_ :: Int), Just (Int
_ :: Int)) ->
             (String
sa, Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb) String
sa String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb)
           _ -> (String
sa, String
sb)
  | Bool
otherwise = (String
sa, String
sb)

-- All digits repeated in the second number are left out:
-- 42–5, 321–8, 2787–816.  The minDigits parameter indicates
-- a minimum number of digits for the second number; thus, with
-- minDigits = 2, we have 328-28.
minimalRange :: Int -> (String, String) -> (String, String)
minimalRange :: Int -> Option -> Option
minimalRange minDigits :: Int
minDigits (a :: Char
a:as :: String
as, b :: Char
b:bs :: String
bs)
  | Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b
  , String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs
  , String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minDigits =
                let (_, bs' :: String
bs') = Int -> Option -> Option
minimalRange Int
minDigits (String
as, String
bs)
                in  (Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String
as, String
bs')
minimalRange _ (as :: String
as, bs :: String
bs) = (String
as, String
bs)

-- Page ranges are abbreviated according to the Chicago Manual of Style-rules:
-- First number             Second number    Examples
-- Less than 100            Use all digits   3–10; 71–72
-- 100 or multiple of 100   Use all digits   100–104; 600–613; 1100–1123
-- 101 through 109 (in multiples of 100) Use changed part only  10002-6, 505-17
-- 110 through 199          Use 2 digits or more  321-25, 415-532
-- if numbers are 4 digits long or more and 3 digits change, use all digits
--         1496-1504
chicagoRange :: (String, String) -> (String, String)
chicagoRange :: Option -> Option
chicagoRange (sa :: String
sa, sb :: String
sb)
    = case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sa) :: Maybe Int) of
          Just n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 100 -> Option -> Option
expandedRange (String
sa, String
sb)
                 | Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Option -> Option
expandedRange (String
sa, String
sb)
                 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 -> let (sa' :: String
sa', sb' :: String
sb') = Int -> Option -> Option
minimalRange 1 (String
sa, String
sb)
                                in  if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3
                                       then Option -> Option
expandedRange (String
sa, String
sb)
                                       else (String
sa', String
sb')
                  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 100 -> if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 100 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10
                                 then Int -> Option -> Option
minimalRange 1 (String
sa, String
sb)
                                 else Int -> Option -> Option
minimalRange 2 (String
sa, String
sb)
          _ -> Option -> Option
expandedRange (String
sa, String
sb)