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