{-# 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 Formatting
_ Delimiter
_ [Element]
es) EvalMode
em Bool
b [Locale]
l [MacroMap]
m [Option]
o Abbreviations
a 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
                  [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
                 [Locale
x] -> Locale
x
                 [Locale]
_   -> Delimiter
-> Delimiter -> [Option] -> [CslTerm] -> [Element] -> Locale
Locale Delimiter
"" Delimiter
"" [] [] []
      job :: State EvalState [Output]
job    = [Element] -> State EvalState [Output]
evalElements [Element]
es
      cit :: Cite
cit    = case EvalMode
em of
                 EvalCite    Cite
c -> Cite
c
                 EvalSorting Cite
c -> Cite
c
                 EvalBiblio  Cite
c -> Cite
c
      initSt :: EvalState
initSt = ReferenceMap
-> Environment
-> [Delimiter]
-> EvalMode
-> Bool
-> Bool
-> [Delimiter]
-> [Delimiter]
-> 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 :: Delimiter -> Delimiter
getLang = Int -> Delimiter -> Delimiter
T.take Int
2 (Delimiter -> Delimiter)
-> (Delimiter -> Delimiter) -> Delimiter -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delimiter -> Delimiter
T.toLower in
               case (Delimiter -> Delimiter
getLang (Delimiter -> Delimiter) -> Delimiter -> Delimiter
forall a b. (a -> b) -> a -> b
$ Locale -> Delimiter
localeLang Locale
locale,
                     Delimiter -> Delimiter
getLang (Delimiter -> Delimiter)
-> (Reference -> Delimiter) -> Reference -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Delimiter
unLiteral (Literal -> Delimiter)
-> (Reference -> Literal) -> Reference -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
language (Reference -> Delimiter) -> Maybe Reference -> Maybe Delimiter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Reference
mbr) of
                 (Delimiter
_,  Just Delimiter
"en") -> [Output] -> [Output]
forall a. a -> a
id
                 (Delimiter
_,  Maybe Delimiter
Nothing)   -> [Output] -> [Output]
forall a. a -> a
id
                 (Delimiter
"en", Just Delimiter
"") -> [Output] -> [Output]
forall a. a -> a
id
                 (Delimiter, Maybe Delimiter)
_               -> (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 EvalMode
m [Locale]
l [MacroMap]
ms [Option]
opts [Sort]
ss Abbreviations
as 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] -> Delimiter
render       = Formatted -> Delimiter
renderPlain (Formatted -> Delimiter)
-> ([Output] -> Formatted) -> [Output] -> Delimiter
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{} = Delimiter -> Formatting -> Output
OStr Delimiter
"," Formatting
emptyFormatting
      removeDelimAndLabel Output
x          = Output
x
      format :: (Sorting, ([Option], Element)) -> Sorting
format (Sorting
s,([Option], Element)
e) = Sorting -> Delimiter -> Sorting
applySort Sorting
s (Delimiter -> Sorting)
-> ([Output] -> Delimiter) -> [Output] -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Delimiter
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     [Option]
o Element
e = Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [Option]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Formatting -> Delimiter -> [Element] -> Layout
Layout Formatting
emptyFormatting Delimiter
"" [Element
e]) EvalMode
m Bool
False [Locale]
l [MacroMap]
ms [Option]
o Abbreviations
as Maybe Reference
mbr
      applySort :: Sorting -> Delimiter -> Sorting
applySort Sorting
c Delimiter
s
          | Ascending {} <- Sorting
c = Delimiter -> Sorting
Ascending  Delimiter
s
          | Bool
otherwise         = Delimiter -> Sorting
Descending Delimiter
s

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

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

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

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

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

      roman :: Int -> Text
      roman :: Int -> Delimiter
roman     = [Delimiter] -> Delimiter
T.concat ([Delimiter] -> Delimiter)
-> (Int -> [Delimiter]) -> Int -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Delimiter] -> [Delimiter]
forall a. [a] -> [a]
reverse ([Delimiter] -> [Delimiter])
-> (Int -> [Delimiter]) -> Int -> [Delimiter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Delimiter] -> Int -> Delimiter)
-> [[Delimiter]] -> [Int] -> [Delimiter]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Delimiter] -> Int -> Delimiter
forall a. [a] -> Int -> a
(!!) [[Delimiter]]
romanList ([Int] -> [Delimiter]) -> (Int -> [Int]) -> Int -> [Delimiter]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Delimiter -> Int
readNum (Delimiter -> Int) -> (Char -> Delimiter) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Delimiter
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 Int
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 :: [[Delimiter]]
romanList = [[ Delimiter
"", Delimiter
"i", Delimiter
"ii", Delimiter
"iii", Delimiter
"iv", Delimiter
"v", Delimiter
"vi", Delimiter
"vii", Delimiter
"viii", Delimiter
"ix" ]
                  ,[ Delimiter
"", Delimiter
"x", Delimiter
"xx", Delimiter
"xxx", Delimiter
"xl", Delimiter
"l", Delimiter
"lx", Delimiter
"lxx", Delimiter
"lxxx", Delimiter
"xc" ]
                  ,[ Delimiter
"", Delimiter
"c", Delimiter
"cc", Delimiter
"ccc", Delimiter
"cd", Delimiter
"d", Delimiter
"dc", Delimiter
"dcc", Delimiter
"dccc", Delimiter
"cm" ]
                  ,[ Delimiter
"", Delimiter
"m", Delimiter
"mm", Delimiter
"mmm", Delimiter
"mmmm", Delimiter
"mmmmm"]
                  ]


checkRange :: [CslTerm] -> Text -> Text
checkRange :: [CslTerm] -> Delimiter -> Delimiter
checkRange [CslTerm]
ts Delimiter
txt = case Delimiter -> Maybe (Char, Delimiter)
T.uncons Delimiter
txt of
  Just (Char
x,Delimiter
xs) -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\x2013'
                 then [CslTerm] -> Delimiter
pageRange [CslTerm]
ts Delimiter -> Delimiter -> Delimiter
forall a. Semigroup a => a -> a -> a
<> [CslTerm] -> Delimiter -> Delimiter
checkRange [CslTerm]
ts Delimiter
xs
                 else Char -> Delimiter -> Delimiter
T.cons Char
x (Delimiter -> Delimiter) -> Delimiter -> Delimiter
forall a b. (a -> b) -> a -> b
$ [CslTerm] -> Delimiter -> Delimiter
checkRange [CslTerm]
ts Delimiter
xs
  Maybe (Char, Delimiter)
Nothing -> Delimiter
""

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

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

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

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

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

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

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

      process :: [Option] -> Delimiter
process = [CslTerm] -> Delimiter -> Delimiter
checkRange [CslTerm]
ts (Delimiter -> Delimiter)
-> ([Option] -> Delimiter) -> [Option] -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Delimiter] -> Delimiter
printNumStr ([Delimiter] -> Delimiter)
-> ([Option] -> [Delimiter]) -> [Option] -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Delimiter
opt of
                 Delimiter
"expanded"    -> (Option -> Delimiter) -> [Option] -> [Delimiter]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> Delimiter
forall a. (Eq a, IsString a, Semigroup a) => (a, a) -> a
joinRange (Option -> Delimiter) -> (Option -> Option) -> Option -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
expandedRange)
                 Delimiter
"chicago"     -> (Option -> Delimiter) -> [Option] -> [Delimiter]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> Delimiter
forall a. (Eq a, IsString a, Semigroup a) => (a, a) -> a
joinRange (Option -> Delimiter) -> (Option -> Option) -> Option -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
chicagoRange )
                 Delimiter
"minimal"     -> (Option -> Delimiter) -> [Option] -> [Delimiter]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> Delimiter
forall a. (Eq a, IsString a, Semigroup a) => (a, a) -> a
joinRange (Option -> Delimiter) -> (Option -> Option) -> Option -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange Int
1)
                 Delimiter
"minimal-two" -> (Option -> Delimiter) -> [Option] -> [Delimiter]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> Delimiter
forall a. (Eq a, IsString a, Semigroup a) => (a, a) -> a
joinRange (Option -> Delimiter) -> (Option -> Option) -> Option -> Delimiter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange Int
2)
                 Delimiter
_             -> (Option -> Delimiter) -> [Option] -> [Delimiter]
forall a b. (a -> b) -> [a] -> [b]
map Option -> Delimiter
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 [Delimiter -> Formatting -> Output
OStr ([Option] -> Delimiter
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 (Delimiter
sa, Delimiter
"") = (Delimiter
sa,Delimiter
"")
expandedRange (Delimiter
sa, Delimiter
sb)
  | Delimiter -> Int
T.length Delimiter
sb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Delimiter -> Int
T.length Delimiter
sa =
      case (Delimiter -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Delimiter -> m a
safeRead Delimiter
sa, Delimiter -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Delimiter -> m a
safeRead Delimiter
sb) of
           -- check to make sure we have regular numbers
           (Just (Int
_ :: Int), Just (Int
_ :: Int)) ->
             (Delimiter
sa, Int -> Delimiter -> Delimiter
T.take (Delimiter -> Int
T.length Delimiter
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- Delimiter -> Int
T.length Delimiter
sb) Delimiter
sa Delimiter -> Delimiter -> Delimiter
forall a. Semigroup a => a -> a -> a
<> Delimiter
sb)
           (Maybe Int, Maybe Int)
_ -> (Delimiter
sa, Delimiter
sb)
  | Bool
otherwise = (Delimiter
sa, Delimiter
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 Int
minDigits (Delimiter
a,Delimiter
b) =
  case Delimiter -> Delimiter -> Maybe (Delimiter, Delimiter, Delimiter)
T.commonPrefixes Delimiter
a Delimiter
b of
    Just (Delimiter
_, Delimiter
a', Delimiter
b') | Delimiter -> Int
T.length Delimiter
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Delimiter -> Int
T.length Delimiter
b' ->
                       (Delimiter
a, Int -> Delimiter -> Delimiter
T.takeEnd (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minDigits (Delimiter -> Int
T.length Delimiter
b')) Delimiter
b)
    Maybe (Delimiter, Delimiter, Delimiter)
_ -> (Delimiter
a, Delimiter
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 (Delimiter
sa, Delimiter
sb)
    = case (Delimiter -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Delimiter -> m a
safeRead Delimiter
sa :: Maybe Int) of
          Just Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100 -> Option -> Option
expandedRange (Delimiter
sa, Delimiter
sb)
                 | Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Option -> Option
expandedRange (Delimiter
sa, Delimiter
sb)
                 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000 -> let (Delimiter
sa', Delimiter
sb') = Int -> Option -> Option
minimalRange Int
1 (Delimiter
sa, Delimiter
sb)
                                in  if Delimiter -> Int
T.length Delimiter
sb' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
                                       then Option -> Option
expandedRange (Delimiter
sa, Delimiter
sb)
                                       else (Delimiter
sa', Delimiter
sb')
                  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 -> if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10
                                 then Int -> Option -> Option
minimalRange Int
1 (Delimiter
sa, Delimiter
sb)
                                 else Int -> Option -> Option
minimalRange Int
2 (Delimiter
sa, Delimiter
sb)
          Maybe Int
_ -> Option -> Option
expandedRange (Delimiter
sa, Delimiter
sb)