{-# 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)
import           Data.Maybe
import           Data.Monoid            (Any (..))
import           Data.String            (fromString)
import           Data.Text              (Text)
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          (isRange, 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
                 _   -> Text -> Text -> [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
-> [Text]
-> EvalMode
-> Bool
-> Bool
-> [Text]
-> [Text]
-> 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 :: Text -> Text
getLang = Int -> Text -> Text
T.take 2 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower in
               case (Text -> Text
getLang (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Locale -> Text
localeLang Locale
locale,
                     Text -> Text
getLang (Text -> Text) -> (Reference -> Text) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Text
unLiteral (Literal -> Text) -> (Reference -> Literal) -> Reference -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
language (Reference -> Text) -> Maybe Reference -> Maybe Text
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] -> Text
render       = Formatted -> Text
renderPlain (Formatted -> Text) -> ([Output] -> Formatted) -> [Output] -> Text
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{} = Text -> 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 -> Text -> Sorting
applySort Sorting
s (Text -> Sorting) -> ([Output] -> Text) -> [Output] -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Text
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 -> Text -> [Element] -> Layout
Layout Formatting
emptyFormatting "" [Element
e]) EvalMode
m Bool
False [Locale]
l [MacroMap]
ms [Option]
o Abbreviations
as Maybe Reference
mbr
      applySort :: Sorting -> Text -> Sorting
applySort c :: Sorting
c s :: Text
s
          | Ascending {} <- Sorting
c = Text -> Sorting
Ascending  Text
s
          | Bool
otherwise         = Text -> Sorting
Descending Text
s

      unsetOpts :: (Text, Text) -> (Text, Text)
      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, Text)
setOpts s :: a
s i :: a
i = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then (a
s, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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 :: Text
str s' :: Sorting
s'     -> (Sorting
s', ( ("name-as-sort-order","all") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
opts
                                              , [Text] -> Form -> Formatting -> Text -> Element
Variable [Text
str] Form
Long Formatting
emptyFormatting ""))
              SortMacro  str :: Text
str s' :: Sorting
s' a :: Int
a b :: Int
b c :: Text
c -> (Sorting
s', ( Text -> Int -> Option
forall a a.
(Eq a, Num a, Show a, IsString a) =>
a -> a -> (a, Text)
setOpts "et-al-min"       Int
a Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: ("et-al-use-last",Text
c) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
:
                                                Text -> Int -> Option
forall a a.
(Eq a, Num a, Show a, IsString a) =>
a -> a -> (a, Text)
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
                                              , Text -> Formatting -> Element
Macro Text
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 :: Text
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
$ Text -> [Output] -> [Output]
addSpaces Text
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 (Text -> [Inline]
readCSLString Text
s)]
                                                else [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan (Text -> [Inline]
readCSLString Text
s)] Formatting
fm]
                                    -- NOTE: this conditional seems needed for
                                    -- locator_SimpleLocators.json:
    | Number   s :: Text
s f :: NumericForm
f fm :: Formatting
fm       <- Element
el = if Text
s Text -> Text -> 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 -> Text -> State EvalState [Output]
formatRange Formatting
fm (Text -> State EvalState [Output])
-> (Option -> Text) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Text
forall a b. (a, b) -> b
snd
                                       else NumericForm
-> Formatting -> Text -> Text -> State EvalState [Output]
formatNumber NumericForm
f Formatting
fm Text
s (Text -> State EvalState [Output])
-> StateT EvalState Identity Text -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                                            Text -> StateT EvalState Identity Text
getStringVar Text
s
    | Variable s :: [Text]
s f :: Form
f fm :: Formatting
fm d :: Text
d     <- Element
el = Text -> [Output] -> [Output]
addDelim Text
d ([Output] -> [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> State EvalState [Output])
-> [Text] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM (Form -> Formatting -> Text -> State EvalState [Output]
getVariable Form
f Formatting
fm) [Text]
s
    | Group        fm :: Formatting
fm d :: Text
d l :: [Element]
l   <- Element
el = Formatting -> Text -> [Output] -> [Output]
outputList Formatting
fm Text
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 :: Text
s f :: Form
f fm :: Formatting
fm _     <- Element
el = Form -> Formatting -> Bool -> Text -> State EvalState [Output]
formatLabel Form
f Formatting
fm Bool
True Text
s -- FIXME !!
    | Term     s :: Text
s f :: Form
f fm :: Formatting
fm p :: Bool
p     <- Element
el = Text -> StateT EvalState Identity Text
getStringVar "ref-id" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \refid :: Text
refid ->
                                      Form
-> Formatting -> Bool -> Text -> Text -> State EvalState [Output]
formatTerm  Form
f Formatting
fm Bool
p Text
refid  Text
s
    | Names    s :: [Text]
s n :: [Name]
n fm :: Formatting
fm d :: Text
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 -> [Text] -> [Name] -> Text -> State EvalState [Output]
evalNames Bool
False [Text]
s [Name]
n Text
d)
                                            ([Text]
-> Element -> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) b.
MonadState EvalState m =>
[Text] -> Element -> m b -> m b
withNames [Text]
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 :: Text
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 Text -> [MacroMap] -> Maybe [Element]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
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 (Text -> String
forall a. Show a => a -> String
show Text
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 :: Text -> [Output] -> [Output]
addSpaces strng :: Text
strng = (if Int -> Text -> Text
T.take 1 Text
strng Text -> Text -> 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 (Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Maybe Char
forall a. a -> Maybe a
Just ' ') ((Text, Char) -> Char
forall a b. (a, b) -> b
snd ((Text, Char) -> Char) -> Maybe (Text, Char) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Char)
T.unsnoc Text
strng)
                         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 :: Text
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 :: [Text]
rs [Name NotSet fm'' :: Formatting
fm'' [] "" []] fm' :: Formatting
fm' d' :: Text
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
                  [Text] -> [Name] -> Formatting -> Text -> [Element] -> Element
Names [Text]
rs [Name]
ns Formatting
nfm (if Text -> Bool
T.null Text
d' then Text
d else Text
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 :: [Text]
numVars = [Text
s | Number s :: Text
s _ _ <- [Element]
l]
                     [Text]
nums <- (Text -> StateT EvalState Identity Text)
-> [Text] -> StateT EvalState Identity [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> StateT EvalState Identity Text
getStringVar [Text]
numVars
                     let pluralizeTerm :: Element -> Element
pluralizeTerm (Term s :: Text
s f :: Form
f fm :: Formatting
fm _) = Text -> Form -> Formatting -> Bool -> Element
Term Text
s Form
f Formatting
fm (Bool -> Element) -> Bool -> Element
forall a b. (a -> b) -> a -> b
$
                            case [Text]
numVars of
                              ["number-of-volumes"] -> "1" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
nums
                              ["number-of-pages"]   -> "1" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
nums
                              _ -> (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
isRange [Text]
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 :: [Text] -> Element -> m b -> m b
withNames e :: [Text]
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 :: [Text]
authSub = [Text]
e [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ EvalState -> [Text]
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 :: [Text]
authSub = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text]
e) (EvalState -> [Text]
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 -> Text -> State EvalState [Output]
getVariable f :: Form
f fm :: Formatting
fm s :: Text
s
        | Text -> Bool
isTitleVar Text
s Bool -> Bool -> Bool
|| Text -> Bool
isTitleShortVar Text
s =
             Text -> StateT EvalState Identity ()
consumeVariable Text
s StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Form -> Formatting -> State EvalState [Output]
formatTitle Text
s Form
f Formatting
fm
        | Bool
otherwise =
             case Text -> Text
T.toLower Text
s of
               "first-reference-note-number"
                             -> do Text
refid <- Text -> StateT EvalState Identity Text
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",Text
refid)]) [Text -> Inline
Str "0"]]] Formatting
fm]

               "year-suffix" -> Text -> StateT EvalState Identity Text
getStringVar "ref-id" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: Text
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
$ Text -> Text -> [Output] -> Formatting -> Output
OYearSuf "" Text
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]) -> Text -> State EvalState [Output]
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar [Output]
forall a. Monoid a => a
mempty ([Option]
-> Abbreviations -> Form -> Formatting -> Text -> Value -> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm Text
s)
                        "status"
                  Text -> StateT EvalState Identity ()
consumeVariable Text
s
                  [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r
               "page"        -> Text -> StateT EvalState Identity Text
getStringVar "page" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> Text -> 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 -> Text -> State EvalState [Output]
formatRange Formatting
fm (Text -> State EvalState [Output])
-> (Option -> Text) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Text
forall a b. (a, b) -> b
snd
               "url"         -> Text -> StateT EvalState Identity Text
getStringVar "url" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: Text
k ->
                                if Text -> Bool
T.null Text
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] -> Option -> Inline
Link Attr
nullAttr [Text -> Inline
Str Text
k] (Text -> Text
escapeURI Text
k,"")]] Formatting
fm]
               "doi"         -> do Text
d <- Text -> StateT EvalState Identity Text
getStringVar "doi"
                                   let (prefixPart :: Text
prefixPart, linkPart :: Text
linkPart) = Text -> Text -> Option
T.breakOn (String -> Text
T.pack "http") (Formatting -> Text
prefix Formatting
fm)
                                   let u :: Text
u = if Text -> Bool
T.null Text
linkPart
                                              then "https://doi.org/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d
                                              else Text
linkPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d
                                   if Text -> Bool
T.null Text
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] -> Option -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text
linkPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d)] (Text -> Text
escapeURI Text
u, "")]]
                                            Formatting
fm{ prefix :: Text
prefix = Text
prefixPart, suffix :: Text
suffix = Formatting -> Text
suffix Formatting
fm }]
               "isbn"        -> Text -> StateT EvalState Identity Text
getStringVar "isbn" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: Text
d ->
                                if Text -> Bool
T.null Text
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] -> Option -> Inline
Link Attr
nullAttr [Text -> Inline
Str Text
d] ("https://worldcat.org/isbn/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI Text
d, "")]] Formatting
fm]
               "pmid"        -> Text -> StateT EvalState Identity Text
getStringVar "pmid" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: Text
d ->
                                if Text -> Bool
T.null Text
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] -> Option -> Inline
Link Attr
nullAttr [Text -> Inline
Str Text
d] ("https://www.ncbi.nlm.nih.gov/pubmed/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI Text
d, "")]] Formatting
fm]
               "pmcid"       -> Text -> StateT EvalState Identity Text
getStringVar "pmcid" StateT EvalState Identity Text
-> (Text -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: Text
d ->
                                if Text -> Bool
T.null Text
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] -> Option -> Inline
Link Attr
nullAttr [Text -> Inline
Str Text
d] ("https://www.ncbi.nlm.nih.gov/pmc/articles/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI Text
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]) -> Text -> State EvalState [Output]
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar []
                              ([Option]
-> Abbreviations -> Form -> Formatting -> Text -> Value -> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm Text
s) Text
s
                       Text -> StateT EvalState Identity ()
consumeVariable Text
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 <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
chkType         Condition -> [Text]
isType          Condition
c Match
m
                        [Bool]
v <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
isVarSet        Condition -> [Text]
isSet           Condition
c Match
m
                        [Bool]
n <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
chkNumeric      Condition -> [Text]
isNumeric       Condition
c Match
m
                        [Bool]
d <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
chkDate         Condition -> [Text]
isUncertainDate Condition
c Match
m
                        [Bool]
p <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
forall a (m :: * -> *).
(Eq a, IsString a, MonadState EvalState m) =>
a -> m Bool
chkPosition     Condition -> [Text]
isPosition      Condition
c Match
m
                        [Bool]
a <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
forall (f :: * -> *). MonadState EvalState f => Text -> f Bool
chkDisambiguate Condition -> [Text]
disambiguation  Condition
c Match
m
                        [Bool]
l <- (Text -> StateT EvalState Identity Bool)
-> (Condition -> [Text])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond Text -> StateT EvalState Identity Bool
chkLocator      Condition -> [Text]
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 :: Text -> StateT EvalState Identity Bool
chkType         t :: Text
t = let chk :: Value -> Bool
chk = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text
formatVariable Text
t) (Text -> Bool) -> (Value -> Text) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Value -> String) -> Value -> Text
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) -> Text -> StateT EvalState Identity Bool
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar Bool
False Value -> Bool
chk "ref-type"
      chkNumeric :: Text -> StateT EvalState Identity Bool
chkNumeric      v :: Text
v = do Text
val <- Text -> StateT EvalState Identity Text
getStringVar Text
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' :: Text
val' = if Text -> Bool
T.null (Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
as Text
v Text
val)
                                           then Text
val
                                           else Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
as Text
v Text
val
                             Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Bool
isNumericString Text
val')
      chkDate :: Text -> StateT EvalState Identity Bool
chkDate         v :: Text
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
<$> Text -> StateT EvalState Identity [RefDate]
getDateVar Text
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 -> Text -> Bool
forall a a. (Eq a, Eq a, IsString a, IsString a) => a -> a -> Bool
compPosition a
s (Text -> Bool) -> m Text -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> Text) -> m Text
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> Text
citePosition (Cite -> Text) -> (EvalState -> Cite) -> EvalState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Cite
cite (Environment -> Cite)
-> (EvalState -> Environment) -> EvalState -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
      chkDisambiguate :: Text -> f Bool
chkDisambiguate s :: Text
s = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text
formatVariable Text
s) (Text -> Bool) -> (Bool -> Text) -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Bool -> Text) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
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 :: Text -> StateT EvalState Identity Bool
chkLocator      v :: Text
v = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
v (Text -> Bool) -> (Option -> Text) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Text
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 -> Text -> Value -> [Output]
getFormattedValue :: [Option]
-> Abbreviations -> Form -> Formatting -> Text -> Value -> [Output]
getFormattedValue o :: [Option]
o as :: Abbreviations
as f :: Form
f fm :: Formatting
fm s :: Text
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] -> (Text -> [Inline]) -> Maybe Text -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Inline]
v (Formatted -> [Inline]
unFormatted (Formatted -> [Inline]) -> (Text -> Formatted) -> Text -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formatted
forall a. IsString a => String -> a
fromString (String -> Formatted) -> (Text -> String) -> Text -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (Maybe Text -> [Inline]) -> Maybe Text -> [Inline]
forall a b. (a -> b) -> a -> b
$
                           Text -> Maybe Text
getAbbr ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
v) of
                  [] -> []
                  ys :: [Inline]
ys -> [[Output] -> Formatting -> Output
Output [(if Text
s Text -> Text -> 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 :: Text
v <- Value -> Maybe Text
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Text =
         case Text -> Text
value Text
v of
            "" -> []
            xs :: Text
xs -> case Text -> Maybe Text
getAbbr Text
xs of
                    Nothing -> [Text -> Formatting -> Output
OStr Text
xs Formatting
fm]
                    Just ys :: Text
ys -> [Text -> Formatting -> Output
OStr Text
ys Formatting
fm]
    | Just (Literal v :: Text
v) <- Value -> Maybe Literal
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Literal =
         case Text -> Text
value Text
v of
            "" -> []
            xs :: Text
xs -> case Text -> Maybe Text
getAbbr Text
xs of
                    Nothing -> [Text -> Formatting -> Output
OStr Text
xs Formatting
fm]
                    Just ys :: Text
ys -> [Text -> Formatting -> Output
OStr Text
ys Formatting
fm]
    | Just v :: Int
v <- Value -> Maybe Int
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Int       = Formatting -> Text -> [Output]
output  Formatting
fm (if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "" else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
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 [Text -> Formatting -> Output
OCitLabel (CLabel -> Text
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
-> Text -> [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 :: Text -> Text
value     = if Formatting -> Bool
stripPeriods Formatting
fm then (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') else Text -> Text
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
$ Text -> Text
value Text
x
      value' x :: Inline
x       = Inline
x
      getAbbr :: Text -> Maybe Text
getAbbr v :: Text
v = if Form
f Form -> Form -> Bool
forall a. Eq a => a -> a -> Bool
== Form
Short
                  then case Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
as Text
s Text
v of
                             "" -> Maybe Text
forall a. Maybe a
Nothing
                             y :: Text
y  -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
y
                  else Maybe Text
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 = [ Text -> Text -> Text -> Formatting -> DatePart
DatePart "year"  "numeric-leading-zeros" "" Formatting
emptyFormatting
                 , Text -> Text -> Text -> Formatting -> DatePart
DatePart "month" "numeric-leading-zeros" "" Formatting
emptyFormatting
                 , Text -> Text -> Text -> Formatting -> DatePart
DatePart "day"   "numeric-leading-zeros" "" Formatting
emptyFormatting]

formatTitle :: Text -> Form -> Formatting -> State EvalState [Output]
formatTitle :: Text -> Form -> Formatting -> State EvalState [Output]
formatTitle s :: Text
s f :: Form
f fm :: Formatting
fm
    | Form
Short <- Form
f
    , Text -> Bool
isTitleVar      Text
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 (Text -> State EvalState [Output]
getIt (Text -> State EvalState [Output])
-> Text -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-short") (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Text -> State EvalState [Output]
getIt Text
s
    | Text -> Bool
isTitleShortVar Text
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 (Text -> State EvalState [Output]
getIt Text
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]) -> (Text -> Output) -> Text -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Formatting -> Output) -> Formatting -> Text -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Formatting -> Output
OStr Formatting
fm (Text -> [Output])
-> StateT EvalState Identity Text -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> StateT EvalState Identity Text
getTitleShort Text
s
    | Bool
otherwise         = Text -> State EvalState [Output]
getIt Text
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 :: Text -> State EvalState [Output]
getIt x :: Text
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]) -> Text -> State EvalState [Output]
forall a. a -> (Value -> a) -> Text -> State EvalState a
getVar [] ([Option]
-> Abbreviations -> Form -> Formatting -> Text -> Value -> [Output]
getFormattedValue [Option]
o Abbreviations
a Form
f Formatting
fm Text
x) Text
x

formatNumber :: NumericForm -> Formatting -> Text -> Text -> State EvalState [Output]
formatNumber :: NumericForm
-> Formatting -> Text -> Text -> State EvalState [Output]
formatNumber f :: NumericForm
f fm :: Formatting
fm v :: Text
v n :: Text
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 Text -> Bool
isNumericString (Abbreviations -> Text -> Text
getAbbr Abbreviations
as Text
n)
      then Formatting -> Text -> [Output]
output Formatting
fm (Text -> [Output]) -> ([CslTerm] -> Text) -> [CslTerm] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CslTerm] -> Text -> Text) -> Text -> [CslTerm] -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip [CslTerm] -> Text -> Text
process (Abbreviations -> Text -> Text
getAbbr Abbreviations
as Text
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])
-> (Text -> [Output]) -> Text -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> Text -> [Output]
output Formatting
fm (Text -> [Output]) -> (Text -> Text) -> Text -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abbreviations -> Text -> Text
getAbbr Abbreviations
as (Text -> State EvalState [Output])
-> Text -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Text
n
    where
      getAbbr :: Abbreviations -> Text -> Text
getAbbr       as :: Abbreviations
as   = if Text -> Bool
T.null (Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
as Text
v Text
n)
                              then Text -> Text
forall a. a -> a
id
                              else Abbreviations -> Text -> Text -> Text
getAbbreviation Abbreviations
as Text
v
      checkRange' :: [CslTerm] -> Text -> Text
checkRange'   ts :: [CslTerm]
ts   = if Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "page" then [CslTerm] -> Text -> Text
checkRange [CslTerm]
ts else Text -> Text
forall a. a -> a
id
      process :: [CslTerm] -> Text -> Text
process       ts :: [CslTerm]
ts   = [CslTerm] -> Text -> Text
checkRange' [CslTerm]
ts (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
printNumStr ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([CslTerm] -> Text -> Text
renderNumber [CslTerm]
ts) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           [Text] -> [Text]
breakNumericString ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
      renderNumber :: [CslTerm] -> Text -> Text
renderNumber  ts :: [CslTerm]
ts x :: Text
x = if Text -> Bool
isTransNumber Text
x then [CslTerm] -> Text -> Text
format [CslTerm]
ts Text
x else Text
x

      format :: [CslTerm] -> Text -> Text
format tm :: [CslTerm]
tm = case NumericForm
f of
                    Ordinal     -> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> Text -> Int -> Text
ordinal     [CslTerm]
tm Text
v) (Maybe Int -> Text) -> (Text -> Maybe Int) -> Text -> Text
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 -> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> Text -> Int -> Text
longOrdinal [CslTerm]
tm Text
v) (Maybe Int -> Text) -> (Text -> Maybe Int) -> Text -> Text
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       -> Text -> (Int -> Text) -> Maybe Int -> Text
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 -> Text
roman Int
x else String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
x) (Maybe Int -> Text) -> (Text -> Maybe Int) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                   Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
                    _           -> Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Maybe Int -> Text) -> (Text -> Maybe Int) -> Text -> Text
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 -> Text
      roman :: Int -> Text
roman     = [Text] -> Text
T.concat ([Text] -> Text) -> (Int -> [Text]) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> (Int -> [Text]) -> Int -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Int -> Text) -> [[Text]] -> [Int] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Text] -> Int -> Text
forall a. [a] -> Int -> a
(!!) [[Text]]
romanList ([Int] -> [Text]) -> (Int -> [Int]) -> Int -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
readNum (Text -> Int) -> (Char -> Text) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton) (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 :: [[Text]]
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] -> Text -> Text
checkRange :: [CslTerm] -> Text -> Text
checkRange ts :: [CslTerm]
ts txt :: Text
txt = case Text -> Maybe (Char, Text)
T.uncons Text
txt of
  Just (x :: Char
x,xs :: Text
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] -> Text
pageRange [CslTerm]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [CslTerm] -> Text -> Text
checkRange [CslTerm]
ts Text
xs
                 else Char -> Text -> Text
T.cons Char
x (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [CslTerm] -> Text -> Text
checkRange [CslTerm]
ts Text
xs
  Nothing -> ""

printNumStr :: [Text] -> Text
printNumStr :: [Text] -> Text
printNumStr []  = ""
printNumStr [x :: Text
x] = Text
x
printNumStr (x :: Text
x:"-":y :: Text
y:xs :: [Text]
xs) = [Text] -> Text
T.concat [Text
x, "-" , Text
y, [Text] -> Text
printNumStr [Text]
xs]
printNumStr (x :: Text
x:",":y :: Text
y:xs :: [Text]
xs) = [Text] -> Text
T.concat [Text
x, ", ", Text
y, [Text] -> Text
printNumStr [Text]
xs]
printNumStr (x :: Text
x:xs :: [Text]
xs)
    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "-"  = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>        [Text] -> Text
printNumStr [Text]
xs
    | Bool
otherwise = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
printNumStr [Text]
xs

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

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

isTransNumber, isSpecialChar,isNumber :: Text -> Bool
isTransNumber :: Text -> Bool
isTransNumber = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit
isSpecialChar :: Text -> Bool
isSpecialChar = (Char -> Bool) -> Text -> Bool
T.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-,.\x2013" :: String))
isNumber :: Text -> Bool
isNumber   cs :: Text
cs = case [Char
c | Char
c <- Text -> String
T.unpack Text
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 :: [Text] -> [Text]
breakNumericString :: [Text] -> [Text]
breakNumericString [] = []
breakNumericString (x :: Text
x:xs :: [Text]
xs)
    | Text -> Bool
isTransNumber Text
x = Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
breakNumericString [Text]
xs
    | Bool
otherwise       = let (a :: Text
a,b :: Text
b) = (Char -> Bool) -> Text -> Option
T.break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) Text
x
                            (c :: Text
c,d :: Text
d) = if Text -> Bool
T.null Text
b
                                       then ("","")
                                       else (Char -> Bool) -> Text -> Option
T.span (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) Text
b
                        in (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
                           Text
a Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
breakNumericString (Text
d Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
xs)

formatRange :: Formatting -> Text -> State EvalState [Output]
formatRange :: Formatting -> Text -> State EvalState [Output]
formatRange _ "" = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
formatRange fm :: Formatting
fm p :: Text
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 :: Text
opt = Text -> [Option] -> Text
getOptionVal "page-range-format" [Option]
ops
      pages :: [Option]
pages = [Text] -> [Option]
tupleRange ([Text] -> [Option]) -> (Text -> [Text]) -> Text -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
breakNumericString ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Option]) -> Text -> [Option]
forall a b. (a -> b) -> a -> b
$ Text
p

      tupleRange :: [Text] -> [(Text, Text)]
      tupleRange :: [Text] -> [Option]
tupleRange [] = []
      tupleRange [x :: Text
x, cs :: Text
cs]
        | Text
cs Text -> [Text] -> 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 (Text
x,"")
      tupleRange (x :: Text
x:cs :: Text
cs:y :: Text
y:xs :: [Text]
xs)
        | Text
cs Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["-", "--", "\x2013"] = (Text
x, Text
y) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Text] -> [Option]
tupleRange [Text]
xs
      tupleRange (x :: Text
x:      xs :: [Text]
xs) = (Text
x,"") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Text] -> [Option]
tupleRange [Text]
xs

      joinRange :: (a, a) -> a
joinRange (a :: a
a, "") = a
a
      joinRange (a :: a
a,  b :: a
b) = a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> "-" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b

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

-- Abbreviated page ranges are expanded to their non-abbreviated form:
-- 42–45, 321–328, 2787–2816
expandedRange :: (Text, Text) -> (Text, Text)
expandedRange :: Option -> Option
expandedRange (sa :: Text
sa, "") = (Text
sa,"")
expandedRange (sa :: Text
sa, sb :: Text
sb)
  | Text -> Int
T.length Text
sb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Text -> Int
T.length Text
sa =
      case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
sa, Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
sb) of
           -- check to make sure we have regular numbers
           (Just (Int
_ :: Int), Just (Int
_ :: Int)) ->
             (Text
sa, Int -> Text -> Text
T.take (Text -> Int
T.length Text
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
sb) Text
sa Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sb)
           _ -> (Text
sa, Text
sb)
  | Bool
otherwise = (Text
sa, Text
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 -> (Text, Text) -> (Text, Text)
minimalRange :: Int -> Option -> Option
minimalRange minDigits :: Int
minDigits (a :: Text
a,b :: Text
b) =
  case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
a Text
b of
    Just (_, a' :: Text
a', b' :: Text
b') | Text -> Int
T.length Text
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Int
T.length Text
b' ->
                       (Text
a, Int -> Text -> Text
T.takeEnd (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minDigits (Text -> Int
T.length Text
b')) Text
b)
    _ -> (Text
a, Text
b)

-- 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 :: (Text, Text) -> (Text, Text)
chicagoRange :: Option -> Option
chicagoRange (sa :: Text
sa, sb :: Text
sb)
    = case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead Text
sa :: Maybe Int) of
          Just n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 100 -> Option -> Option
expandedRange (Text
sa, Text
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 (Text
sa, Text
sb)
                 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 -> let (sa' :: Text
sa', sb' :: Text
sb') = Int -> Option -> Option
minimalRange 1 (Text
sa, Text
sb)
                                in  if Text -> Int
T.length Text
sb' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3
                                       then Option -> Option
expandedRange (Text
sa, Text
sb)
                                       else (Text
sa', Text
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 (Text
sa, Text
sb)
                                 else Int -> Option -> Option
minimalRange 2 (Text
sa, Text
sb)
          _ -> Option -> Option
expandedRange (Text
sa, Text
sb)