{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Text.CSL.Eval
( evalLayout
, evalSorting
, module Text.CSL.Eval.Common
, module Text.CSL.Eval.Output
) where
import Prelude
import Control.Arrow
import qualified Control.Exception as E
import Control.Monad.State
import Data.Char (isDigit, isLetter, toLower)
import Data.Maybe
import Data.Monoid (Any (..))
import Data.String (fromString)
import qualified Data.Text as T
import Text.Pandoc.Definition (Inline (Link, Span, Str), nullAttr)
import Text.Pandoc.Shared (stringify, escapeURI)
import Text.Pandoc.Walk (walk)
import Text.CSL.Eval.Common
import Text.CSL.Eval.Date
import Text.CSL.Eval.Names
import Text.CSL.Eval.Output
import Text.CSL.Exception
import Text.CSL.Output.Plain
import Text.CSL.Reference
import Text.CSL.Style hiding (Any)
import Text.CSL.Util (orIfNull, isRange, last', proc,
proc', query, readNum, safeRead)
evalLayout :: Layout -> EvalMode -> Bool -> [Locale] -> [MacroMap]
-> [Option] -> Abbreviations -> Maybe Reference -> [Output]
evalLayout :: Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [Option]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Layout _ _ es :: [Element]
es) em :: EvalMode
em b :: Bool
b l :: [Locale]
l m :: [MacroMap]
m o :: [Option]
o a :: Abbreviations
a mbr :: Maybe Reference
mbr
= [Output] -> [Output]
cleanOutput [Output]
evalOut
where
evalOut :: [Output]
evalOut = case State EvalState [Output] -> EvalState -> [Output]
forall s a. State s a -> s -> a
evalState State EvalState [Output]
job EvalState
initSt of
x :: [Output]
x | Maybe Reference -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Reference
mbr -> [Cite -> Output
noBibDataError Cite
cit]
| [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
x -> []
| Bool
otherwise -> [Output] -> [Output]
suppTC [Output]
x
locale :: Locale
locale = case [Locale]
l of
[x :: Locale
x] -> Locale
x
_ -> String -> String -> [Option] -> [CslTerm] -> [Element] -> Locale
Locale [] [] [] [] []
job :: State EvalState [Output]
job = [Element] -> State EvalState [Output]
evalElements [Element]
es
cit :: Cite
cit = case EvalMode
em of
EvalCite c :: Cite
c -> Cite
c
EvalSorting c :: Cite
c -> Cite
c
EvalBiblio c :: Cite
c -> Cite
c
initSt :: EvalState
initSt = ReferenceMap
-> Environment
-> [String]
-> EvalMode
-> Bool
-> Bool
-> [String]
-> [String]
-> Bool
-> [[Output]]
-> [Agent]
-> [Output]
-> EvalState
EvalState (Maybe Reference -> ReferenceMap
mkRefMap Maybe Reference
mbr) (Cite
-> [CslTerm]
-> [MacroMap]
-> [Element]
-> [Option]
-> [Element]
-> Abbreviations
-> Environment
Env Cite
cit (Locale -> [CslTerm]
localeTerms Locale
locale) [MacroMap]
m
(Locale -> [Element]
localeDate Locale
locale) [Option]
o [] Abbreviations
a) [] EvalMode
em Bool
b Bool
False [] [] Bool
False [] [] []
suppTC :: [Output] -> [Output]
suppTC = let getLang :: String -> String
getLang = Int -> String -> String
forall a. Int -> [a] -> [a]
take 2 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower in
case (String -> String
getLang (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Locale -> String
localeLang Locale
locale,
String -> String
getLang (String -> String) -> (Reference -> String) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> String
unLiteral (Literal -> String)
-> (Reference -> Literal) -> Reference -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Literal
language (Reference -> String) -> Maybe Reference -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Reference
mbr) of
(_, Just "en") -> [Output] -> [Output]
forall a. a -> a
id
(_, Nothing) -> [Output] -> [Output]
forall a. a -> a
id
("en", Just "") -> [Output] -> [Output]
forall a. a -> a
id
_ -> (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc' Output -> Output
rmTitleCase'
evalSorting :: EvalMode -> [Locale] -> [MacroMap] -> [Option] ->
[Sort] -> Abbreviations -> Maybe Reference -> [Sorting]
evalSorting :: EvalMode
-> [Locale]
-> [MacroMap]
-> [Option]
-> [Sort]
-> Abbreviations
-> Maybe Reference
-> [Sorting]
evalSorting m :: EvalMode
m l :: [Locale]
l ms :: [MacroMap]
ms opts :: [Option]
opts ss :: [Sort]
ss as :: Abbreviations
as mbr :: Maybe Reference
mbr
= (Sort -> Sorting) -> [Sort] -> [Sorting]
forall a b. (a -> b) -> [a] -> [b]
map ((Sorting, ([Option], Element)) -> Sorting
format ((Sorting, ([Option], Element)) -> Sorting)
-> (Sort -> (Sorting, ([Option], Element))) -> Sort -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sort -> (Sorting, ([Option], Element))
sorting) [Sort]
ss
where
render :: [Output] -> String
render = Formatted -> String
renderPlain (Formatted -> String)
-> ([Output] -> Formatted) -> [Output] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> Formatted
formatOutputList ([Output] -> Formatted)
-> ([Output] -> [Output]) -> [Output] -> Formatted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Output -> Output) -> [Output] -> [Output]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Output -> Output
removeDelimAndLabel
removeDelimAndLabel :: Output -> Output
removeDelimAndLabel OLabel{} = Output
ONull
removeDelimAndLabel ODel{} = Output
ONull
removeDelimAndLabel OSpace{} = String -> Formatting -> Output
OStr "," Formatting
emptyFormatting
removeDelimAndLabel x :: Output
x = Output
x
format :: (Sorting, ([Option], Element)) -> Sorting
format (s :: Sorting
s,e :: ([Option], Element)
e) = Sorting -> String -> Sorting
applaySort Sorting
s (String -> Sorting) -> ([Output] -> String) -> [Output] -> Sorting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Output] -> String
render ([Output] -> Sorting) -> [Output] -> Sorting
forall a b. (a -> b) -> a -> b
$ ([Option] -> Element -> [Output])
-> ([Option], Element) -> [Output]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Option] -> Element -> [Output]
eval ([Option], Element)
e
eval :: [Option] -> Element -> [Output]
eval o :: [Option]
o e :: Element
e = Layout
-> EvalMode
-> Bool
-> [Locale]
-> [MacroMap]
-> [Option]
-> Abbreviations
-> Maybe Reference
-> [Output]
evalLayout (Formatting -> String -> [Element] -> Layout
Layout Formatting
emptyFormatting [] [Element
e]) EvalMode
m Bool
False [Locale]
l [MacroMap]
ms [Option]
o Abbreviations
as Maybe Reference
mbr
applaySort :: Sorting -> String -> Sorting
applaySort c :: Sorting
c s :: String
s
| Ascending {} <- Sorting
c = String -> Sorting
Ascending String
s
| Bool
otherwise = String -> Sorting
Descending String
s
unsetOpts :: (String, String) -> (String, String)
unsetOpts :: Option -> Option
unsetOpts ("et-al-min" ,_) = ("et-al-min" ,"")
unsetOpts ("et-al-use-first" ,_) = ("et-al-use-first" ,"")
unsetOpts ("et-al-subsequent-min" ,_) = ("et-al-subsequent-min","")
unsetOpts ("et-al-subsequent-use-first",_) = ("et-al-subsequent-use-first","")
unsetOpts x :: Option
x = Option
x
setOpts :: [a] -> a -> ([a], String)
setOpts s :: [a]
s i :: a
i = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then ([a]
s, a -> String
forall a. Show a => a -> String
show a
i) else ([],[])
sorting :: Sort -> (Sorting, ([Option], Element))
sorting s :: Sort
s
= case Sort
s of
SortVariable str :: String
str s' :: Sorting
s' -> (Sorting
s', ( ("name-as-sort-order","all") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
opts
, [String] -> Form -> Formatting -> String -> Element
Variable [String
str] Form
Long Formatting
emptyFormatting []))
SortMacro str :: String
str s' :: Sorting
s' a :: Int
a b :: Int
b c :: String
c -> (Sorting
s', ( String -> Int -> Option
forall a a. (Eq a, Num a, Show a) => [a] -> a -> ([a], String)
setOpts "et-al-min" Int
a Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: ("et-al-use-last",String
c) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
:
String -> Int -> Option
forall a a. (Eq a, Num a, Show a) => [a] -> a -> ([a], String)
setOpts "et-al-use-first" Int
b Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: (Option -> Option) -> [Option] -> [Option]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Option -> Option
unsetOpts [Option]
opts
, String -> Formatting -> Element
Macro String
str Formatting
emptyFormatting))
evalElements :: [Element] -> State EvalState [Output]
evalElements :: [Element] -> State EvalState [Output]
evalElements = (Element -> State EvalState [Output])
-> [Element] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM Element -> State EvalState [Output]
evalElement
evalElement :: Element -> State EvalState [Output]
evalElement :: Element -> State EvalState [Output]
evalElement el :: Element
el
| Const s :: String
s fm :: Formatting
fm <- Element
el = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> [Output] -> [Output]
addSpaces String
s
([Output] -> [Output]) -> [Output] -> [Output]
forall a b. (a -> b) -> a -> b
$ if Formatting
fm Formatting -> Formatting -> Bool
forall a. Eq a => a -> a -> Bool
== Formatting
emptyFormatting
then [[Inline] -> Output
OPan (String -> [Inline]
readCSLString String
s)]
else [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan (String -> [Inline]
readCSLString String
s)] Formatting
fm]
| Number s :: String
s f :: NumericForm
f fm :: Formatting
fm <- Element
el = if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "locator"
then State EvalState Option
getLocVar State EvalState Option
-> (Option -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm (String -> State EvalState [Output])
-> (Option -> String) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> b
snd
else NumericForm
-> Formatting -> String -> String -> State EvalState [Output]
formatNumber NumericForm
f Formatting
fm String
s (String -> State EvalState [Output])
-> StateT EvalState Identity String -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
String -> StateT EvalState Identity String
getStringVar String
s
| Variable s :: [String]
s f :: Form
f fm :: Formatting
fm d :: String
d <- Element
el = String -> [Output] -> [Output]
addDelim String
d ([Output] -> [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> State EvalState [Output])
-> [String] -> State EvalState [Output]
forall (m :: * -> *) b a.
(Monad m, Functor m, Eq b) =>
(a -> m [b]) -> [a] -> m [b]
concatMapM (Form -> Formatting -> String -> State EvalState [Output]
getVariable Form
f Formatting
fm) [String]
s
| Group fm :: Formatting
fm d :: String
d l :: [Element]
l <- Element
el = Formatting -> String -> [Output] -> [Output]
outputList Formatting
fm String
d ([Output] -> [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element] -> State EvalState [Output]
tryGroup [Element]
l
| Date{} <- Element
el = Element -> State EvalState [Output]
evalDate Element
el
| Label s :: String
s f :: Form
f fm :: Formatting
fm _ <- Element
el = Form -> Formatting -> Bool -> String -> State EvalState [Output]
formatLabel Form
f Formatting
fm Bool
True String
s
| Term s :: String
s f :: Form
f fm :: Formatting
fm p :: Bool
p <- Element
el = String -> StateT EvalState Identity String
getStringVar "ref-id" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \refid :: String
refid ->
Form
-> Formatting
-> Bool
-> String
-> String
-> State EvalState [Output]
formatTerm Form
f Formatting
fm Bool
p String
refid String
s
| Names s :: [String]
s n :: [Name]
n fm :: Formatting
fm d :: String
d sub :: [Element]
sub <- Element
el = (EvalState -> EvalState) -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: EvalState
st -> EvalState
st { contNum :: [Agent]
contNum = [] }) StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
State EvalState [Output]
-> State EvalState [Output]
-> ([Output] -> [Output])
-> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a b.
(Monad m, Foldable t) =>
m (t a) -> m b -> (t a -> b) -> m b
ifEmpty (Bool -> [String] -> [Name] -> String -> State EvalState [Output]
evalNames Bool
False [String]
s [Name]
n String
d)
([String]
-> Element -> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) b.
MonadState EvalState m =>
[String] -> Element -> m b -> m b
withNames [String]
s Element
el (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ [Element] -> State EvalState [Output]
evalElements [Element]
sub)
(Formatting -> [Output] -> [Output]
appendOutput Formatting
fm)
| Substitute (e :: Element
e:els :: [Element]
els) <- Element
el = do
[Output]
res <- State EvalState [Output] -> State EvalState [Output]
forall a. State EvalState a -> State EvalState a
consuming (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ Element -> State EvalState [Output]
substituteWith Element
e
if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
res
then if [Element] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Element]
els
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output
ONull]
else Element -> State EvalState [Output]
evalElement ([Element] -> Element
Substitute [Element]
els)
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
res
| Choose i :: IfThen
i ei :: [IfThen]
ei xs :: [Element]
xs <- Element
el = do
[Element]
res <- IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen IfThen
i [IfThen]
ei [Element]
xs
[Element] -> State EvalState [Output]
evalElements [Element]
res
| Macro s :: String
s fm :: Formatting
fm <- Element
el = do
[MacroMap]
ms <- (EvalState -> [MacroMap]) -> StateT EvalState Identity [MacroMap]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [MacroMap]
macros (Environment -> [MacroMap])
-> (EvalState -> Environment) -> EvalState -> [MacroMap]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
case String -> [MacroMap] -> Maybe [Element]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s [MacroMap]
ms of
Nothing -> CiteprocException -> State EvalState [Output]
forall a e. Exception e => e -> a
E.throw (CiteprocException -> State EvalState [Output])
-> CiteprocException -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> CiteprocException
MacroNotFound (String -> String
forall a. Show a => a -> String
show String
s)
Just els :: [Element]
els -> do
[Output]
res <- [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output])
-> StateT EvalState Identity [[Output]] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> State EvalState [Output])
-> [Element] -> StateT EvalState Identity [[Output]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> State EvalState [Output]
evalElement [Element]
els
if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
res
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [Output]
res Formatting
fm]
| Bool
otherwise = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
where
addSpaces :: String -> [Output] -> [Output]
addSpaces strng :: String
strng = (if Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 String
strng String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== " " then (Output
OSpaceOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:) else [Output] -> [Output]
forall a. a -> a
id) ([Output] -> [Output])
-> ([Output] -> [Output]) -> [Output] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if String -> String
forall a. [a] -> [a]
last' String
strng String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== " " then ([Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++[Output
OSpace]) else [Output] -> [Output]
forall a. a -> a
id)
substituteWith :: Element -> State EvalState [Output]
substituteWith e :: Element
e =
(EvalState -> [Element]) -> State EvalState [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Element]
names (Environment -> [Element])
-> (EvalState -> Environment) -> EvalState -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env) State EvalState [Element]
-> ([Element] -> State EvalState [Output])
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(Names _ ns :: [Name]
ns fm :: Formatting
fm d :: String
d _ : _) -> Element -> State EvalState [Output]
evalElement (Element -> State EvalState [Output])
-> Element -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Element -> Element) -> Element -> Element
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc Element -> Element
replaceNames Element
e
where
replaceNames :: Element -> Element
replaceNames (Names rs :: [String]
rs [Name NotSet fm'' :: Formatting
fm'' [] [] []] fm' :: Formatting
fm' d' :: String
d' []) =
let nfm :: Formatting
nfm = Formatting -> Formatting -> Formatting
mergeFM Formatting
fm'' (Formatting -> Formatting) -> Formatting -> Formatting
forall a b. (a -> b) -> a -> b
$ Formatting -> Formatting -> Formatting
mergeFM Formatting
fm' Formatting
fm in
[String] -> [Name] -> Formatting -> String -> [Element] -> Element
Names [String]
rs [Name]
ns Formatting
nfm (String
d' String -> String -> String
forall a. [a] -> [a] -> [a]
`orIfNull` String
d) []
replaceNames x :: Element
x = Element
x
_ -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
tryGroup :: [Element] -> State EvalState [Output]
tryGroup l :: [Element]
l = if Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (Element -> Any) -> [Element] -> Any
forall a b m. (Typeable a, Data b, Monoid m) => (a -> m) -> b -> m
query Element -> Any
hasVar [Element]
l
then do
EvalState
oldState <- StateT EvalState Identity EvalState
forall s (m :: * -> *). MonadState s m => m s
get
[Output]
res <- [Element] -> State EvalState [Output]
evalElements ([Element] -> [Element]
rmTermConst [Element]
l)
EvalState -> StateT EvalState Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put EvalState
oldState
let numVars :: [String]
numVars = [String
s | Number s :: String
s _ _ <- [Element]
l]
[String]
nums <- (String -> StateT EvalState Identity String)
-> [String] -> StateT EvalState Identity [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EvalState Identity String
getStringVar [String]
numVars
let pluralizeTerm :: Element -> Element
pluralizeTerm (Term s :: String
s f :: Form
f fm :: Formatting
fm _) = String -> Form -> Formatting -> Bool -> Element
Term String
s Form
f Formatting
fm (Bool -> Element) -> Bool -> Element
forall a b. (a -> b) -> a -> b
$
case [String]
numVars of
["number-of-volumes"] -> "1" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
nums
["number-of-pages"] -> "1" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
nums
_ -> (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
isRange [String]
nums
pluralizeTerm x :: Element
x = Element
x
if [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Output]
res
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Element] -> State EvalState [Output]
evalElements ([Element] -> State EvalState [Output])
-> [Element] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Element -> Element) -> [Element] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Element
pluralizeTerm [Element]
l
else [Element] -> State EvalState [Output]
evalElements [Element]
l
hasVar :: Element -> Any
hasVar e :: Element
e
| Variable {} <- Element
e = Bool -> Any
Any Bool
True
| Date {} <- Element
e = Bool -> Any
Any Bool
True
| Names {} <- Element
e = Bool -> Any
Any Bool
True
| Number {} <- Element
e = Bool -> Any
Any Bool
True
| Bool
otherwise = Bool -> Any
Any Bool
False
rmTermConst :: [Element] -> [Element]
rmTermConst = ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (Typeable a, Data b) => (a -> a) -> b -> b
proc (([Element] -> [Element]) -> [Element] -> [Element])
-> ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Element -> Bool) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Bool
isTermConst)
isTermConst :: Element -> Bool
isTermConst e :: Element
e
| Term {} <- Element
e = Bool
True
| Const {} <- Element
e = Bool
True
| Bool
otherwise = Bool
False
ifEmpty :: m (t a) -> m b -> (t a -> b) -> m b
ifEmpty p :: m (t a)
p t :: m b
t e :: t a -> b
e = m (t a)
p m (t a) -> (t a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: t a
r -> if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
r then m b
t else b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (t a -> b
e t a
r)
withNames :: [String] -> Element -> m b -> m b
withNames e :: [String]
e n :: Element
n f :: m b
f = (EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: EvalState
s -> EvalState
s { authSub :: [String]
authSub = [String]
e [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ EvalState -> [String]
authSub EvalState
s
, env :: Environment
env = (EvalState -> Environment
env EvalState
s)
{names :: [Element]
names = Element
n Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: Environment -> [Element]
names (EvalState -> Environment
env EvalState
s)}}) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
f m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: b
r ->
(EvalState -> EvalState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\s :: EvalState
s -> EvalState
s { authSub :: [String]
authSub = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String]
e) (EvalState -> [String]
authSub EvalState
s)
, env :: Environment
env = (EvalState -> Environment
env EvalState
s)
{names :: [Element]
names = [Element] -> [Element]
forall a. [a] -> [a]
tail ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Environment -> [Element]
names (EvalState -> Environment
env EvalState
s)}}) m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
getVariable :: Form -> Formatting -> String -> State EvalState [Output]
getVariable f :: Form
f fm :: Formatting
fm s :: String
s
| String -> Bool
isTitleVar String
s Bool -> Bool -> Bool
|| String -> Bool
isTitleShortVar String
s =
String -> StateT EvalState Identity ()
consumeVariable String
s StateT EvalState Identity ()
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Form -> Formatting -> State EvalState [Output]
formatTitle String
s Form
f Formatting
fm
| Bool
otherwise =
case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
s of
"first-reference-note-number"
-> do String
refid <- String -> StateT EvalState Identity String
getStringVar "ref-id"
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Inline
Span ("",["first-reference-note-number"],[("refid",String -> Text
T.pack String
refid)]) [Text -> Inline
Str "0"]]] Formatting
fm]
"year-suffix" -> String -> StateT EvalState Identity String
getStringVar "ref-id" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: String
k ->
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> (Output -> [Output]) -> Output -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> State EvalState [Output])
-> Output -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> String -> [Output] -> Formatting -> Output
OYearSuf [] String
k [] Formatting
fm
"status" -> do
(opts :: [Option]
opts, as :: Abbreviations
as) <- (EvalState -> ([Option], Abbreviations))
-> StateT EvalState Identity ([Option], Abbreviations)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EvalState -> Environment
env (EvalState -> Environment)
-> (Environment -> ([Option], Abbreviations))
-> EvalState
-> ([Option], Abbreviations)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Environment -> [Option]
options (Environment -> [Option])
-> (Environment -> Abbreviations)
-> Environment
-> ([Option], Abbreviations)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Environment -> Abbreviations
abbrevs)
[Output]
r <- [Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [Output]
forall a. Monoid a => a
mempty ([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm String
s)
"status"
String -> StateT EvalState Identity ()
consumeVariable String
s
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r
"page" -> String -> StateT EvalState Identity String
getStringVar "page" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm
"locator" -> State EvalState Option
getLocVar State EvalState Option
-> (Option -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Formatting -> String -> State EvalState [Output]
formatRange Formatting
fm (String -> State EvalState [Output])
-> (Option -> String) -> Option -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> b
snd
"url" -> String -> StateT EvalState Identity String
getStringVar "url" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \k :: String
k ->
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
k then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
k] (Text -> Text
escapeURI (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
k,"")]] Formatting
fm]
"doi" -> do String
d <- String -> StateT EvalState Identity String
getStringVar "doi"
let (prefixPart :: Text
prefixPart, linkPart :: Text
linkPart) = Text -> Text -> Target
T.breakOn (String -> Text
T.pack "http") (String -> Text
T.pack (Formatting -> String
prefix Formatting
fm))
let u :: String
u = if Text -> Bool
T.null Text
linkPart
then "https://doi.org/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
else Text -> String
T.unpack Text
linkPart String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text
linkPart Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
d)] (Text -> Text
escapeURI (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u, "")]]
Formatting
fm{ prefix :: String
prefix = Text -> String
T.unpack Text
prefixPart, suffix :: String
suffix = Formatting -> String
suffix Formatting
fm }]
"isbn" -> String -> StateT EvalState Identity String
getStringVar "isbn" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://worldcat.org/isbn/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
"pmid" -> String -> StateT EvalState Identity String
getStringVar "pmid" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://www.ncbi.nlm.nih.gov/pubmed/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
"pmcid" -> String -> StateT EvalState Identity String
getStringVar "pmcid" StateT EvalState Identity String
-> (String -> State EvalState [Output]) -> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: String
d ->
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d
then [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
Output [[Inline] -> Output
OPan [Attr -> [Inline] -> Target -> Inline
Link Attr
nullAttr [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
d] ("https://www.ncbi.nlm.nih.gov/pmc/articles/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeURI (String -> Text
T.pack String
d), "")]] Formatting
fm]
_ -> do (opts :: [Option]
opts, as :: Abbreviations
as) <- (EvalState -> ([Option], Abbreviations))
-> StateT EvalState Identity ([Option], Abbreviations)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (EvalState -> Environment
env (EvalState -> Environment)
-> (Environment -> ([Option], Abbreviations))
-> EvalState
-> ([Option], Abbreviations)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Environment -> [Option]
options (Environment -> [Option])
-> (Environment -> Abbreviations)
-> Environment
-> ([Option], Abbreviations)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Environment -> Abbreviations
abbrevs)
[Output]
r <- [Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar []
([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
opts Abbreviations
as Form
f Formatting
fm String
s) String
s
String -> StateT EvalState Identity ()
consumeVariable String
s
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
r
evalIfThen :: IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen :: IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen (IfThen c' :: Condition
c' m' :: Match
m' el' :: [Element]
el') ei :: [IfThen]
ei e :: [Element]
e = StateT EvalState Identity Bool
-> State EvalState [Element]
-> State EvalState [Element]
-> State EvalState [Element]
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
whenElse (Match -> Condition -> StateT EvalState Identity Bool
evalCond Match
m' Condition
c') ([Element] -> State EvalState [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
el') State EvalState [Element]
rest
where
rest :: State EvalState [Element]
rest = case [IfThen]
ei of
[] -> [Element] -> State EvalState [Element]
forall (m :: * -> *) a. Monad m => a -> m a
return [Element]
e
(x :: IfThen
x:xs :: [IfThen]
xs) -> IfThen -> [IfThen] -> [Element] -> State EvalState [Element]
evalIfThen IfThen
x [IfThen]
xs [Element]
e
evalCond :: Match -> Condition -> StateT EvalState Identity Bool
evalCond m :: Match
m c :: Condition
c = do [Bool]
t <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkType Condition -> [String]
isType Condition
c Match
m
[Bool]
v <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
isVarSet Condition -> [String]
isSet Condition
c Match
m
[Bool]
n <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkNumeric Condition -> [String]
isNumeric Condition
c Match
m
[Bool]
d <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkDate Condition -> [String]
isUncertainDate Condition
c Match
m
[Bool]
p <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
forall a (m :: * -> *).
(Eq a, IsString a, MonadState EvalState m) =>
a -> m Bool
chkPosition Condition -> [String]
isPosition Condition
c Match
m
[Bool]
a <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
forall (f :: * -> *). MonadState EvalState f => String -> f Bool
chkDisambiguate Condition -> [String]
disambiguation Condition
c Match
m
[Bool]
l <- (String -> StateT EvalState Identity Bool)
-> (Condition -> [String])
-> Condition
-> Match
-> StateT EvalState Identity [Bool]
forall (m :: * -> *) a t.
Monad m =>
(a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond String -> StateT EvalState Identity Bool
chkLocator Condition -> [String]
isLocator Condition
c Match
m
Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> StateT EvalState Identity Bool)
-> Bool -> StateT EvalState Identity Bool
forall a b. (a -> b) -> a -> b
$ Match -> [Bool] -> Bool
match Match
m ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Bool]] -> [Bool]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Bool]
t,[Bool]
v,[Bool]
n,[Bool]
d,[Bool]
p,[Bool]
a,[Bool]
l]
checkCond :: (a -> m Bool) -> (t -> [a]) -> t -> Match -> m [Bool]
checkCond a :: a -> m Bool
a f :: t -> [a]
f c :: t
c m :: Match
m = case t -> [a]
f t
c of
[] -> case Match
m of
All -> [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool
True]
_ -> [Bool] -> m [Bool]
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool
False]
xs :: [a]
xs -> (a -> m Bool) -> [a] -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m Bool
a [a]
xs
chkType :: String -> StateT EvalState Identity Bool
chkType t :: String
t = let chk :: Value -> Bool
chk = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String
formatVariable String
t) (String -> Bool) -> (Value -> String) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefType -> String
forall a. Show a => a -> String
show (RefType -> String) -> (Value -> RefType) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefType -> Maybe RefType -> RefType
forall a. a -> Maybe a -> a
fromMaybe RefType
NoType (Maybe RefType -> RefType)
-> (Value -> Maybe RefType) -> Value -> RefType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe RefType
forall a. Data a => Value -> Maybe a
fromValue
in Bool -> (Value -> Bool) -> String -> StateT EvalState Identity Bool
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar Bool
False Value -> Bool
chk "ref-type"
chkNumeric :: String -> StateT EvalState Identity Bool
chkNumeric v :: String
v = do String
val <- String -> StateT EvalState Identity String
getStringVar String
v
Abbreviations
as <- (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
let val' :: String
val' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
val)
then String
val
else Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
val
Bool -> StateT EvalState Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Bool
isNumericString String
val')
chkDate :: String -> StateT EvalState Identity Bool
chkDate v :: String
v = (RefDate -> Bool) -> [RefDate] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any RefDate -> Bool
circa ([RefDate] -> Bool)
-> StateT EvalState Identity [RefDate]
-> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StateT EvalState Identity [RefDate]
getDateVar String
v
chkPosition :: a -> m Bool
chkPosition s :: a
s = if a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "near-note"
then (EvalState -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> Bool
nearNote (Cite -> Bool) -> (EvalState -> Cite) -> EvalState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Cite
cite (Environment -> Cite)
-> (EvalState -> Environment) -> EvalState -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
else a -> String -> Bool
forall a a. (Eq a, Eq a, IsString a, IsString a) => a -> a -> Bool
compPosition a
s (String -> Bool) -> m String -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> String) -> m String
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Cite -> String
citePosition (Cite -> String) -> (EvalState -> Cite) -> EvalState -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Cite
cite (Environment -> Cite)
-> (EvalState -> Environment) -> EvalState -> Cite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
chkDisambiguate :: String -> f Bool
chkDisambiguate s :: String
s = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String
formatVariable String
s) (String -> Bool) -> (Bool -> String) -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Bool -> String) -> Bool -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> Bool) -> f Bool -> f Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> Bool) -> f Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> Bool
disamb
chkLocator :: String -> StateT EvalState Identity Bool
chkLocator v :: String
v = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
v (String -> Bool) -> (Option -> String) -> Option -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> String
forall a b. (a, b) -> a
fst (Option -> Bool)
-> State EvalState Option -> StateT EvalState Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State EvalState Option
getLocVar
isIbid :: a -> Bool
isIbid s :: a
s = Bool -> Bool
not (a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "first" Bool -> Bool -> Bool
|| a
s a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "subsequent")
compPosition :: a -> a -> Bool
compPosition a :: a
a b :: a
b
| a
"first" <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "first"
| a
"subsequent" <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= "first"
| a
"ibid-with-locator" <- a
a = a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "ibid-with-locator" Bool -> Bool -> Bool
||
a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "ibid-with-locator-c"
| Bool
otherwise = a -> Bool
forall a. (Eq a, IsString a) => a -> Bool
isIbid a
b
getFormattedValue :: [Option] -> Abbreviations -> Form -> Formatting -> String -> Value -> [Output]
getFormattedValue :: [Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue o :: [Option]
o as :: Abbreviations
as f :: Form
f fm :: Formatting
fm s :: String
s val :: Value
val
| Just (Formatted v :: [Inline]
v) <- Value -> Maybe Formatted
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Formatted =
case [Inline]
v of
[] -> []
_ -> case [Inline] -> (String -> [Inline]) -> Maybe String -> [Inline]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Inline]
v (Formatted -> [Inline]
unFormatted (Formatted -> [Inline])
-> (String -> Formatted) -> String -> [Inline]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Formatted
forall a. IsString a => String -> a
fromString) (Maybe String -> [Inline]) -> Maybe String -> [Inline]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
getAbbr (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
v) of
[] -> []
ys :: [Inline]
ys -> [[Output] -> Formatting -> Output
Output [(if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "status"
then [Inline] -> Output
OStatus
else [Inline] -> Output
OPan) ([Inline] -> Output) -> [Inline] -> Output
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
value' [Inline]
ys] Formatting
fm]
| Just v :: String
v <- Value -> Maybe String
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe String =
case String -> String
value String
v of
[] -> []
xs :: String
xs -> case String -> Maybe String
getAbbr String
xs of
Nothing -> [String -> Formatting -> Output
OStr String
xs Formatting
fm]
Just ys :: String
ys -> [String -> Formatting -> Output
OStr String
ys Formatting
fm]
| Just (Literal v :: String
v) <- Value -> Maybe Literal
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Literal =
case String -> String
value String
v of
[] -> []
xs :: String
xs -> case String -> Maybe String
getAbbr String
xs of
Nothing -> [String -> Formatting -> Output
OStr String
xs Formatting
fm]
Just ys :: String
ys -> [String -> Formatting -> Output
OStr String
ys Formatting
fm]
| Just v :: Int
v <- Value -> Maybe Int
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe Int = Formatting -> String -> [Output]
output Formatting
fm (if Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else Int -> String
forall a. Show a => a -> String
show Int
v)
| Just v :: CNum
v <- Value -> Maybe CNum
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe CNum = if CNum
v CNum -> CNum -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [] else [Int -> Formatting -> Output
OCitNum (CNum -> Int
unCNum CNum
v) Formatting
fm]
| Just v :: CLabel
v <- Value -> Maybe CLabel
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe CLabel = if CLabel
v CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
forall a. Monoid a => a
mempty then [] else [String -> Formatting -> Output
OCitLabel (CLabel -> String
unCLabel CLabel
v) Formatting
fm]
| Just v :: [RefDate]
v <- Value -> Maybe [RefDate]
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe [RefDate] = EvalMode
-> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate (Cite -> EvalMode
EvalSorting Cite
emptyCite) [] [] [DatePart]
sortDate [RefDate]
v
| Just v :: [Agent]
v <- Value -> Maybe [Agent]
forall a. Data a => Value -> Maybe a
fromValue Value
val :: Maybe [Agent] = (Agent -> [Output]) -> [Agent] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EvalMode
-> Bool
-> Form
-> Formatting
-> [Option]
-> [NamePart]
-> Agent
-> [Output]
formatName (Cite -> EvalMode
EvalSorting Cite
emptyCite) Bool
True Form
f
Formatting
fm [Option]
nameOpts []) [Agent]
v
| Bool
otherwise = []
where
value :: String -> String
value = if Formatting -> Bool
stripPeriods Formatting
fm then (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.') else String -> String
forall a. a -> a
id
value' :: Inline -> Inline
value' (Str x :: Text
x) = Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
value (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
x
value' x :: Inline
x = Inline
x
getAbbr :: String -> Maybe String
getAbbr v :: String
v = if Form
f Form -> Form -> Bool
forall a. Eq a => a -> a -> Bool
== Form
Short
then case Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
s String
v of
[] -> Maybe String
forall a. Maybe a
Nothing
y :: String
y -> String -> Maybe String
forall a. a -> Maybe a
Just String
y
else Maybe String
forall a. Maybe a
Nothing
nameOpts :: [Option]
nameOpts = ("name-as-sort-order","all") Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [Option]
o
sortDate :: [DatePart]
sortDate = [ String -> String -> String -> Formatting -> DatePart
DatePart "year" "numeric-leading-zeros" "" Formatting
emptyFormatting
, String -> String -> String -> Formatting -> DatePart
DatePart "month" "numeric-leading-zeros" "" Formatting
emptyFormatting
, String -> String -> String -> Formatting -> DatePart
DatePart "day" "numeric-leading-zeros" "" Formatting
emptyFormatting]
formatTitle :: String -> Form -> Formatting -> State EvalState [Output]
formatTitle :: String -> Form -> Formatting -> State EvalState [Output]
formatTitle s :: String
s f :: Form
f fm :: Formatting
fm
| Form
Short <- Form
f
, String -> Bool
isTitleVar String
s = State EvalState [Output]
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
try (String -> State EvalState [Output]
getIt (String -> State EvalState [Output])
-> String -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-short") (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String -> State EvalState [Output]
getIt String
s
| String -> Bool
isTitleShortVar String
s = State EvalState [Output]
-> State EvalState [Output] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Foldable t) =>
m (t a) -> m (t a) -> m (t a)
try (String -> State EvalState [Output]
getIt String
s) (State EvalState [Output] -> State EvalState [Output])
-> State EvalState [Output] -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ (Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[]) (Output -> [Output]) -> (String -> Output) -> String -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Formatting -> Output) -> Formatting -> String -> Output
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Formatting -> Output
OStr Formatting
fm (String -> [Output])
-> StateT EvalState Identity String -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> StateT EvalState Identity String
getTitleShort String
s
| Bool
otherwise = String -> State EvalState [Output]
getIt String
s
where
try :: m (t a) -> m (t a) -> m (t a)
try g :: m (t a)
g h :: m (t a)
h = m (t a)
g m (t a) -> (t a -> m (t a)) -> m (t a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \r :: t a
r -> if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
r then m (t a)
h else t a -> m (t a)
forall (m :: * -> *) a. Monad m => a -> m a
return t a
r
getIt :: String -> State EvalState [Output]
getIt x :: String
x = do
[Option]
o <- (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
Abbreviations
a <- (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
[Output]
-> (Value -> [Output]) -> String -> State EvalState [Output]
forall a. a -> (Value -> a) -> String -> State EvalState a
getVar [] ([Option]
-> Abbreviations
-> Form
-> Formatting
-> String
-> Value
-> [Output]
getFormattedValue [Option]
o Abbreviations
a Form
f Formatting
fm String
x) String
x
formatNumber :: NumericForm -> Formatting -> String -> String -> State EvalState [Output]
formatNumber :: NumericForm
-> Formatting -> String -> String -> State EvalState [Output]
formatNumber f :: NumericForm
f fm :: Formatting
fm v :: String
v n :: String
n
= (EvalState -> Abbreviations)
-> StateT EvalState Identity Abbreviations
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> Abbreviations
abbrevs (Environment -> Abbreviations)
-> (EvalState -> Environment) -> EvalState -> Abbreviations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env) StateT EvalState Identity Abbreviations
-> (Abbreviations -> State EvalState [Output])
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \as :: Abbreviations
as ->
if String -> Bool
isNumericString (Abbreviations -> String -> String
getAbbr Abbreviations
as String
n)
then Formatting -> String -> [Output]
output Formatting
fm (String -> [Output])
-> ([CslTerm] -> String) -> [CslTerm] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CslTerm] -> String -> String) -> String -> [CslTerm] -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip [CslTerm] -> String -> String
process (Abbreviations -> String -> String
getAbbr Abbreviations
as String
n) ([CslTerm] -> [Output])
-> StateT EvalState Identity [CslTerm] -> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
else [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> State EvalState [Output])
-> (String -> [Output]) -> String -> State EvalState [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> String -> [Output]
output Formatting
fm (String -> [Output]) -> (String -> String) -> String -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Abbreviations -> String -> String
getAbbr Abbreviations
as (String -> State EvalState [Output])
-> String -> State EvalState [Output]
forall a b. (a -> b) -> a -> b
$ String
n
where
getAbbr :: Abbreviations -> String -> String
getAbbr as :: Abbreviations
as = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v String
n)
then String -> String
forall a. a -> a
id
else Abbreviations -> String -> String -> String
getAbbreviation Abbreviations
as String
v
checkRange' :: [CslTerm] -> String -> String
checkRange' ts :: [CslTerm]
ts = if String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "page" then [CslTerm] -> String -> String
checkRange [CslTerm]
ts else String -> String
forall a. a -> a
id
process :: [CslTerm] -> String -> String
process ts :: [CslTerm]
ts = [CslTerm] -> String -> String
checkRange' [CslTerm]
ts (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
printNumStr ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([CslTerm] -> String -> String
renderNumber [CslTerm]
ts) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[String] -> [String]
breakNumericString ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
renderNumber :: [CslTerm] -> String -> String
renderNumber ts :: [CslTerm]
ts x :: String
x = if String -> Bool
isTransNumber String
x then [CslTerm] -> Text -> String
format [CslTerm]
ts (String -> Text
T.pack String
x) else String
x
format :: [CslTerm] -> Text -> String
format tm :: [CslTerm]
tm = case NumericForm
f of
Ordinal -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> String -> Int -> String
ordinal [CslTerm]
tm String
v) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
LongOrdinal -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([CslTerm] -> String -> Int -> String
longOrdinal [CslTerm]
tm String
v) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
Roman -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ""
(\x :: Int
x -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 6000 then Int -> String
roman Int
x else Int -> String
forall a. Show a => a -> String
show Int
x) (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
_ -> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" Int -> String
forall a. Show a => a -> String
show (Maybe Int -> String) -> (Text -> Maybe Int) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead :: T.Text -> Maybe Int)
roman :: Int -> String
roman :: Int -> String
roman = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (Int -> [String]) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> (Int -> [String]) -> Int -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Int -> String) -> [[String]] -> [Int] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> Int -> String
forall a. [a] -> Int -> a
(!!) [[String]]
romanList ([Int] -> [String]) -> (Int -> [Int]) -> Int -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
readNum (String -> Int) -> (Char -> String) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
forall (m :: * -> *) a. Monad m => a -> m a
return) (String -> [Int]) -> (Int -> String) -> Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take 4 (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
romanList :: [[String]]
romanList = [[ "", "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix" ]
,[ "", "x", "xx", "xxx", "xl", "l", "lx", "lxx", "lxxx", "xc" ]
,[ "", "c", "cc", "ccc", "cd", "d", "dc", "dcc", "dccc", "cm" ]
,[ "", "m", "mm", "mmm", "mmmm", "mmmmm"]
]
checkRange :: [CslTerm] -> String -> String
checkRange :: [CslTerm] -> String -> String
checkRange _ [] = []
checkRange ts :: [CslTerm]
ts (x :: Char
x:xs :: String
xs) = if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\x2013'
then [CslTerm] -> String
pageRange [CslTerm]
ts String -> String -> String
forall a. [a] -> [a] -> [a]
++ [CslTerm] -> String -> String
checkRange [CslTerm]
ts String
xs
else Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: [CslTerm] -> String -> String
checkRange [CslTerm]
ts String
xs
printNumStr :: [String] -> String
printNumStr :: [String] -> String
printNumStr [] = []
printNumStr [x :: String
x] = String
x
printNumStr (x :: String
x:"-":y :: String
y:xs :: [String]
xs) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
printNumStr (x :: String
x:",":y :: String
y:xs :: [String]
xs) = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
printNumStr (x :: String
x:xs :: [String]
xs)
| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-" = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
| Bool
otherwise = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
printNumStr [String]
xs
pageRange :: [CslTerm] -> String
= String -> (CslTerm -> String) -> Maybe CslTerm -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "\x2013" CslTerm -> String
termPlural (Maybe CslTerm -> String)
-> ([CslTerm] -> Maybe CslTerm) -> [CslTerm] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm "page-range-delimiter" Form
Long
isNumericString :: String -> Bool
isNumericString :: String -> Bool
isNumericString [] = Bool
False
isNumericString s :: String
s = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\c :: String
c -> String -> Bool
isNumber String
c Bool -> Bool -> Bool
|| String -> Bool
isSpecialChar String
c) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
s
isTransNumber, isSpecialChar,isNumber :: String -> Bool
isTransNumber :: String -> Bool
isTransNumber = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit
isSpecialChar :: String -> Bool
isSpecialChar = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-,.\x2013" :: String))
isNumber :: String -> Bool
isNumber cs :: String
cs = case [Char
c | Char
c <- String
cs
, Bool -> Bool
not (Char -> Bool
isLetter Char
c)
, Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ("&-.,\x2013" :: String)] of
[] -> Bool
False
xs :: String
xs -> (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
xs
breakNumericString :: [String] -> [String]
breakNumericString :: [String] -> [String]
breakNumericString [] = []
breakNumericString (x :: String
x:xs :: [String]
xs)
| String -> Bool
isTransNumber String
x = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
breakNumericString [String]
xs
| Bool
otherwise = let (a :: String
a,b :: String
b) = (Char -> Bool) -> String -> Option
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) String
x
(c :: String
c,d :: String
d) = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b
then ("","")
else (Char -> Bool) -> String -> Option
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("&-\x2013," :: String)) String
b
in (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= []) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
breakNumericString (String
d String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
xs)
formatRange :: Formatting -> String -> State EvalState [Output]
formatRange :: Formatting -> String -> State EvalState [Output]
formatRange _ [] = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
formatRange fm :: Formatting
fm p :: String
p = do
[Option]
ops <- (EvalState -> [Option]) -> StateT EvalState Identity [Option]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Option]
options (Environment -> [Option])
-> (EvalState -> Environment) -> EvalState -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
[CslTerm]
ts <- (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
let opt :: String
opt = String -> [Option] -> String
getOptionVal "page-range-format" [Option]
ops
pages :: [Option]
pages = [String] -> [Option]
tupleRange ([String] -> [Option])
-> (String -> [String]) -> String -> [Option]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
breakNumericString ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [Option]) -> String -> [Option]
forall a b. (a -> b) -> a -> b
$ String
p
tupleRange :: [String] -> [Option]
tupleRange [] = []
tupleRange [x :: String
x, cs :: String
cs]
| String
cs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["-", "--", "\x2013"] = Option -> [Option]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x,[])
tupleRange (x :: String
x:cs :: String
cs:y :: String
y:xs :: [String]
xs)
| String
cs String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["-", "--", "\x2013"] = (String
x, String
y) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [String] -> [Option]
tupleRange [String]
xs
tupleRange (x :: String
x: xs :: [String]
xs) = (String
x,[]) Option -> [Option] -> [Option]
forall a. a -> [a] -> [a]
: [String] -> [Option]
tupleRange [String]
xs
joinRange :: Option -> String
joinRange (a :: String
a, []) = String
a
joinRange (a :: String
a, b :: String
b) = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
process :: [Option] -> String
process = [CslTerm] -> String -> String
checkRange [CslTerm]
ts (String -> String) -> ([Option] -> String) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
printNumStr ([String] -> String)
-> ([Option] -> [String]) -> [Option] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case String
opt of
"expanded" -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
expandedRange)
"chicago" -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Option
chicagoRange )
"minimal" -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange 1)
"minimal-two" -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Option -> String
joinRange (Option -> String) -> (Option -> Option) -> Option -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Option -> Option
minimalRange 2)
_ -> (Option -> String) -> [Option] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Option -> String
joinRange
[Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Output] -> Formatting -> Output
OLoc [String -> Formatting -> Output
OStr ([Option] -> String
process [Option]
pages) Formatting
emptyFormatting] Formatting
fm]
expandedRange :: (String, String) -> (String, String)
expandedRange :: Option -> Option
expandedRange (sa :: String
sa, []) = (String
sa,[])
expandedRange (sa :: String
sa, sb :: String
sb)
| String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sa =
case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sa), Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sb)) of
(Just (Int
_ :: Int), Just (Int
_ :: Int)) ->
(String
sa, Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sa Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb) String
sa String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sb)
_ -> (String
sa, String
sb)
| Bool
otherwise = (String
sa, String
sb)
minimalRange :: Int -> (String, String) -> (String, String)
minimalRange :: Int -> Option -> Option
minimalRange minDigits :: Int
minDigits (a :: Char
a:as :: String
as, b :: Char
b:bs :: String
bs)
| Char
a Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b
, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs
, String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minDigits =
let (_, bs' :: String
bs') = Int -> Option -> Option
minimalRange Int
minDigits (String
as, String
bs)
in (Char
aChar -> String -> String
forall a. a -> [a] -> [a]
:String
as, String
bs')
minimalRange _ (as :: String
as, bs :: String
bs) = (String
as, String
bs)
chicagoRange :: (String, String) -> (String, String)
chicagoRange :: Option -> Option
chicagoRange (sa :: String
sa, sb :: String
sb)
= case (Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (String -> Text
T.pack String
sa) :: Maybe Int) of
Just n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 100 -> Option -> Option
expandedRange (String
sa, String
sb)
| Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 -> Option -> Option
expandedRange (String
sa, String
sb)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1000 -> let (sa' :: String
sa', sb' :: String
sb') = Int -> Option -> Option
minimalRange 1 (String
sa, String
sb)
in if String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sb' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 3
then Option -> Option
expandedRange (String
sa, String
sb)
else (String
sa', String
sb')
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 100 -> if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 100 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10
then Int -> Option -> Option
minimalRange 1 (String
sa, String
sb)
else Int -> Option -> Option
minimalRange 2 (String
sa, String
sb)
_ -> Option -> Option
expandedRange (String
sa, String
sb)