{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Text.CSL.Eval.Date where
import Prelude
import qualified Control.Exception as E
import Control.Monad.State
import Data.List
import Data.List.Split
import Data.Maybe (fromMaybe, isNothing)
import qualified Data.Text as T
import Text.CSL.Exception
import Text.CSL.Eval.Common
import Text.CSL.Eval.Output
import Text.CSL.Style
import Text.CSL.Reference
import Text.CSL.Util ( toRead, last' )
import Text.Pandoc.Definition ( Inline (Str) )
import Text.Printf (printf)
evalDate :: Element -> State EvalState [Output]
evalDate :: Element -> State EvalState [Output]
evalDate (Date s :: [String]
s f :: DateForm
f fm :: Formatting
fm dl :: String
dl dp :: [DatePart]
dp dp' :: String
dp') = do
[CslTerm]
tm <- (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm])
-> (EvalState -> [CslTerm]) -> StateT EvalState Identity [CslTerm]
forall a b. (a -> b) -> a -> b
$ Environment -> [CslTerm]
terms (Environment -> [CslTerm])
-> (EvalState -> Environment) -> EvalState -> [CslTerm]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env
String
k <- String -> State EvalState String
getStringVar "ref-id"
EvalMode
em <- (EvalState -> EvalMode) -> StateT EvalState Identity EvalMode
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EvalState -> EvalMode
mode
let updateFM :: Formatting -> Formatting -> Formatting
updateFM (Formatting aa :: String
aa ab :: String
ab ac :: String
ac ad :: String
ad ae :: String
ae af :: String
af ag :: String
ag ah :: String
ah ai :: String
ai aj :: String
aj ak :: Quote
ak al :: Bool
al am :: Bool
am an :: Bool
an ahl :: String
ahl)
(Formatting _ _ bc :: String
bc bd :: String
bd be :: String
be bf :: String
bf bg :: String
bg bh :: String
bh _ bj :: String
bj bk :: Quote
bk _ _ _ _) =
String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> String
-> Quote
-> Bool
-> Bool
-> Bool
-> String
-> Formatting
Formatting String
aa String
ab (String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
ac String
bc)
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
ad String
bd)
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
ae String
be)
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
af String
bf)
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
ag String
bg)
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
ah String
bh)
String
ai
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
aj String
bj)
(if Quote
bk Quote -> Quote -> Bool
forall a. Eq a => a -> a -> Bool
/= Quote
ak then Quote
bk else Quote
ak)
Bool
al Bool
am Bool
an String
ahl
updateS :: [a] -> [a] -> [a]
updateS a :: [a]
a b :: [a]
b = if [a]
b [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [a]
a Bool -> Bool -> Bool
&& [a]
b [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then [a]
b else [a]
a
case DateForm
f of
NoFormDate -> Formatting -> String -> [Output] -> [Output]
outputList Formatting
fm String
dl ([Output] -> [Output])
-> ([[RefDate]] -> [Output]) -> [[RefDate]] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([RefDate] -> [Output]) -> [[RefDate]] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EvalMode
-> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate EvalMode
em String
k [CslTerm]
tm [DatePart]
dp) ([[RefDate]] -> [Output])
-> StateT EvalState Identity [[RefDate]]
-> State EvalState [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> StateT EvalState Identity [RefDate])
-> [String] -> StateT EvalState Identity [[RefDate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EvalState Identity [RefDate]
getDateVar [String]
s
_ -> do Element
res <- DateForm -> State EvalState Element
getDate DateForm
f
case Element
res of
Date _ _ lfm :: Formatting
lfm ldl :: String
ldl ldp :: [DatePart]
ldp _ -> do
let go :: [DatePart] -> t [RefDate] -> m [Output]
go dps :: [DatePart]
dps = [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output])
-> (t [RefDate] -> [Output]) -> t [RefDate] -> m [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formatting -> String -> [Output] -> [Output]
outputList (Formatting -> Formatting -> Formatting
updateFM Formatting
fm Formatting
lfm) (if String
ldl String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then String
ldl else String
dl) ([Output] -> [Output])
-> (t [RefDate] -> [Output]) -> t [RefDate] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([RefDate] -> [Output]) -> t [RefDate] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (EvalMode
-> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate EvalMode
em String
k [CslTerm]
tm [DatePart]
dps)
update :: [DatePart] -> DatePart -> DatePart
update l :: [DatePart]
l x :: DatePart
x@(DatePart a :: String
a b :: String
b c :: String
c d :: Formatting
d) =
case (DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
a (String -> Bool) -> (DatePart -> String) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> String
dpName) [DatePart]
l of
(DatePart _ b' :: String
b' c' :: String
c' d' :: Formatting
d':_) -> String -> String -> String -> Formatting -> DatePart
DatePart String
a (String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
b String
b')
(String -> String -> String
forall a. Eq a => [a] -> [a] -> [a]
updateS String
c String
c')
(Formatting -> Formatting -> Formatting
updateFM Formatting
d Formatting
d')
_ -> DatePart
x
updateDP :: [DatePart]
updateDP = (DatePart -> DatePart) -> [DatePart] -> [DatePart]
forall a b. (a -> b) -> [a] -> [b]
map ([DatePart] -> DatePart -> DatePart
update [DatePart]
dp) [DatePart]
ldp
date :: StateT EvalState Identity [[RefDate]]
date = (String -> StateT EvalState Identity [RefDate])
-> [String] -> StateT EvalState Identity [[RefDate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> StateT EvalState Identity [RefDate]
getDateVar [String]
s
case String
dp' of
"year-month" -> [DatePart] -> [[RefDate]] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *).
(Monad m, Foldable t) =>
[DatePart] -> t [RefDate] -> m [Output]
go ((DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) "day" (String -> Bool) -> (DatePart -> String) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> String
dpName) [DatePart]
updateDP) ([[RefDate]] -> State EvalState [Output])
-> StateT EvalState Identity [[RefDate]]
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT EvalState Identity [[RefDate]]
date
"year" -> [DatePart] -> [[RefDate]] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *).
(Monad m, Foldable t) =>
[DatePart] -> t [RefDate] -> m [Output]
go ((DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) "year" (String -> Bool) -> (DatePart -> String) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> String
dpName) [DatePart]
updateDP) ([[RefDate]] -> State EvalState [Output])
-> StateT EvalState Identity [[RefDate]]
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT EvalState Identity [[RefDate]]
date
_ -> [DatePart] -> [[RefDate]] -> State EvalState [Output]
forall (m :: * -> *) (t :: * -> *).
(Monad m, Foldable t) =>
[DatePart] -> t [RefDate] -> m [Output]
go [DatePart]
updateDP ([[RefDate]] -> State EvalState [Output])
-> StateT EvalState Identity [[RefDate]]
-> State EvalState [Output]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT EvalState Identity [[RefDate]]
date
_ -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
evalDate _ = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
getDate :: DateForm -> State EvalState Element
getDate :: DateForm -> State EvalState Element
getDate f :: DateForm
f = do
[Element]
x <- (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Date _ df :: DateForm
df _ _ _ _) -> DateForm
df DateForm -> DateForm -> Bool
forall a. Eq a => a -> a -> Bool
== DateForm
f) ([Element] -> [Element])
-> StateT EvalState Identity [Element]
-> StateT EvalState Identity [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EvalState -> [Element]) -> StateT EvalState Identity [Element]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Environment -> [Element]
dates (Environment -> [Element])
-> (EvalState -> Environment) -> EvalState -> [Element]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalState -> Environment
env)
case [Element]
x of
[x' :: Element
x'] -> Element -> State EvalState Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
x'
_ -> Element -> State EvalState Element
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> State EvalState Element)
-> Element -> State EvalState Element
forall a b. (a -> b) -> a -> b
$ [String]
-> DateForm
-> Formatting
-> String
-> [DatePart]
-> String
-> Element
Date [] DateForm
NoFormDate Formatting
emptyFormatting [] [] []
formatDate :: EvalMode -> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate :: EvalMode
-> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate em :: EvalMode
em k :: String
k tm :: [CslTerm]
tm dp :: [DatePart]
dp date :: [RefDate]
date
| [d :: RefDate
d] <- [RefDate]
date = (DatePart -> [Output]) -> [DatePart] -> [Output]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RefDate -> DatePart -> [Output]
formatDatePart RefDate
d) [DatePart]
dp
| (a :: RefDate
a:b :: RefDate
b:_) <- [RefDate]
date = [Output] -> [Output]
addODate ([Output] -> [Output])
-> ([[Output]] -> [Output]) -> [[Output]] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output]) -> [[Output]] -> [Output]
forall a b. (a -> b) -> a -> b
$ RefDate -> RefDate -> [[Output]]
doRange RefDate
a RefDate
b
| Bool
otherwise = []
where
addODate :: [Output] -> [Output]
addODate [] = []
addODate xs :: [Output]
xs = [[Output] -> Output
ODate [Output]
xs]
splitDate :: RefDate -> RefDate -> ([DatePart], [DatePart], [DatePart])
splitDate a :: RefDate
a b :: RefDate
b = case Splitter DatePart -> [DatePart] -> [[DatePart]]
forall a. Splitter a -> [a] -> [[a]]
split ([DatePart] -> Splitter DatePart
forall a. Eq a => [a] -> Splitter a
onSublist ([DatePart] -> Splitter DatePart)
-> [DatePart] -> Splitter DatePart
forall a b. (a -> b) -> a -> b
$ RefDate -> RefDate -> [DatePart] -> [DatePart]
diff RefDate
a RefDate
b [DatePart]
dp) [DatePart]
dp of
[x :: [DatePart]
x,y :: [DatePart]
y,z :: [DatePart]
z] -> ([DatePart]
x,[DatePart]
y,[DatePart]
z)
_ -> CiteprocException -> ([DatePart], [DatePart], [DatePart])
forall a e. Exception e => e -> a
E.throw CiteprocException
ErrorSplittingDate
doRange :: RefDate -> RefDate -> [[Output]]
doRange a :: RefDate
a b :: RefDate
b = let (x :: [DatePart]
x,y :: [DatePart]
y,z :: [DatePart]
z) = RefDate -> RefDate -> ([DatePart], [DatePart], [DatePart])
splitDate RefDate
a RefDate
b in
(DatePart -> [Output]) -> [DatePart] -> [[Output]]
forall a b. (a -> b) -> [a] -> [b]
map (RefDate -> DatePart -> [Output]
formatDatePart RefDate
a) [DatePart]
x [[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++
[DatePart] -> [[Output]] -> [[Output]] -> [[Output]]
withDelim [DatePart]
y
((DatePart -> [Output]) -> [DatePart] -> [[Output]]
forall a b. (a -> b) -> [a] -> [b]
map (RefDate -> DatePart -> [Output]
formatDatePart RefDate
a) ([DatePart] -> [DatePart]
rmSuffix [DatePart]
y))
((DatePart -> [Output]) -> [DatePart] -> [[Output]]
forall a b. (a -> b) -> [a] -> [b]
map (RefDate -> DatePart -> [Output]
formatDatePart RefDate
b) ([DatePart] -> [DatePart]
rmPrefix [DatePart]
y))
[[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++
(DatePart -> [Output]) -> [DatePart] -> [[Output]]
forall a b. (a -> b) -> [a] -> [b]
map (RefDate -> DatePart -> [Output]
formatDatePart RefDate
b) [DatePart]
z
rmPrefix :: [DatePart] -> [DatePart]
rmPrefix (dp' :: DatePart
dp':rest :: [DatePart]
rest) = DatePart
dp'{ dpFormatting :: Formatting
dpFormatting =
(DatePart -> Formatting
dpFormatting DatePart
dp') { prefix :: String
prefix = "" } } DatePart -> [DatePart] -> [DatePart]
forall a. a -> [a] -> [a]
: [DatePart]
rest
rmPrefix [] = []
rmSuffix :: [DatePart] -> [DatePart]
rmSuffix (dp' :: DatePart
dp':rest :: [DatePart]
rest)
| [DatePart] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DatePart]
rest = [DatePart
dp'{ dpFormatting :: Formatting
dpFormatting =
(DatePart -> Formatting
dpFormatting DatePart
dp') { suffix :: String
suffix = "" } }]
| Bool
otherwise = DatePart
dp'DatePart -> [DatePart] -> [DatePart]
forall a. a -> [a] -> [a]
:[DatePart] -> [DatePart]
rmSuffix [DatePart]
rest
rmSuffix [] = []
diff :: RefDate -> RefDate -> [DatePart] -> [DatePart]
diff (RefDate ya :: Maybe Int
ya ma :: Maybe Int
ma sa :: Maybe Season
sa da :: Maybe Int
da _ _)
(RefDate yb :: Maybe Int
yb mb :: Maybe Int
mb sb :: Maybe Season
sb db :: Maybe Int
db _ _)
= (DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (\x :: DatePart
x -> DatePart -> String
dpName DatePart
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ns)
where ns :: [String]
ns =
case () of
_ | Maybe Int
ya Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
yb -> ["year","month","day"]
| Maybe Int
ma Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
mb Bool -> Bool -> Bool
|| Maybe Season
sa Maybe Season -> Maybe Season -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Season
sb ->
if Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
da Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
db
then ["month"]
else ["month","day"]
| Maybe Int
da Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
db -> ["day"]
| Bool
otherwise -> ["year","month","day"]
term :: String -> String -> String
term f :: String
f t :: String
t = let f' :: Form
f' = if String
f String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["verb", "short", "verb-short", "symbol"]
then String -> Form
forall a. Read a => String -> a
read (String -> Form) -> String -> Form
forall a b. (a -> b) -> a -> b
$ String -> String
toRead String
f
else Form
Long
in String -> (CslTerm -> String) -> Maybe CslTerm -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CslTerm -> String
termPlural (Maybe CslTerm -> String) -> Maybe CslTerm -> String
forall a b. (a -> b) -> a -> b
$ String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm String
t Form
f' [CslTerm]
tm
formatDatePart :: RefDate -> DatePart -> [Output]
formatDatePart (RefDate y :: Maybe Int
y m :: Maybe Int
m e :: Maybe Season
e d :: Maybe Int
d o :: Literal
o _) (DatePart n :: String
n f :: String
f _ fm :: Formatting
fm)
| String
"year" <- String
n, Just y' :: Int
y' <- Maybe Int
y = Output -> [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> [Output]) -> Output -> [Output]
forall a b. (a -> b) -> a -> b
$ String -> String -> Formatting -> Output
OYear (String -> Int -> String
forall a t.
(IsString a, PrintfArg t, Ord t, Num t, Eq a) =>
a -> t -> String
formatYear String
f Int
y') String
k Formatting
fm
| String
"month" <- String
n, Just m' :: Int
m' <- Maybe Int
m = Formatting -> String -> [Output]
output Formatting
fm (String -> Formatting -> Int -> String
forall a.
(PrintfArg a, Show a) =>
String -> Formatting -> a -> String
formatMonth String
f Formatting
fm Int
m')
| String
"month" <- String
n, Just e' :: Season
e' <- Maybe Season
e =
case Season
e' of
RawSeason s :: String
s -> [String -> Formatting -> Output
OStr String
s Formatting
fm]
_ -> Formatting -> String -> [Output]
output Formatting
fm (String -> [Output]) -> String -> [Output]
forall a b. (a -> b) -> a -> b
$ String -> String -> String
term String
f (String -> Int -> String
forall r. PrintfType r => String -> r
printf "season-%02d"
(Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Season -> Maybe Int
seasonToInt Season
e')
| String
"day" <- String
n, Just d' :: Int
d' <- Maybe Int
d = Formatting -> String -> [Output]
output Formatting
fm (String -> Maybe Int -> Int -> String
forall a a.
(Eq a, IsString a, PrintfArg a) =>
a -> Maybe a -> Int -> String
formatDay String
f Maybe Int
m Int
d')
| String
"year" <- String
n, Literal
o Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
/= Literal
forall a. Monoid a => a
mempty = Formatting -> String -> [Output]
output Formatting
fm (Literal -> String
unLiteral Literal
o)
| Bool
otherwise = []
withDelim :: [DatePart] -> [[Output]] -> [[Output]] -> [[Output]]
withDelim xs :: [DatePart]
xs o1 :: [[Output]]
o1 o2 :: [[Output]]
o2
| [Output] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Output]]
o1 [Output] -> [Output] -> [Output]
forall a. [a] -> [a] -> [a]
++ [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Output]]
o2) = []
| Bool
otherwise = [[Output]]
o1 [[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++ (case DatePart -> String
dpRangeDelim (DatePart -> String) -> [DatePart] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DatePart] -> [DatePart]
forall a. [a] -> [a]
last' [DatePart]
xs of
["-"] -> [[[Inline] -> Output
OPan [Text -> Inline
Str "\x2013"]]]
[s :: String
s] -> [[[Inline] -> Output
OPan [Text -> Inline
Str (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s]]]
_ -> []) [[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++ [[Output]]
o2
formatYear :: a -> t -> String
formatYear f :: a
f y :: t
y
| a
"short" <- a
f = String -> t -> String
forall r. PrintfType r => String -> r
printf "%02d" t
y
| EvalMode -> Bool
isSorting EvalMode
em
, t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> t -> String
forall r. PrintfType r => String -> r
printf "-%04d" (t -> t
forall a. Num a => a -> a
abs t
y)
| EvalMode -> Bool
isSorting EvalMode
em = String -> t -> String
forall r. PrintfType r => String -> r
printf "%04d" t
y
| t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> t -> String
forall r. PrintfType r => String -> r
printf "%d" (t -> t
forall a. Num a => a -> a
abs t
y) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
term [] "bc"
| t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< 1000
, t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = String -> t -> String
forall r. PrintfType r => String -> r
printf "%d" t
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
term [] "ad"
| t
y t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
| Bool
otherwise = String -> t -> String
forall r. PrintfType r => String -> r
printf "%d" t
y
formatMonth :: String -> Formatting -> a -> String
formatMonth f :: String
f fm :: Formatting
fm m :: a
m
| String
"short" <- String
f = (CslTerm -> String) -> String
getMonth ((CslTerm -> String) -> String) -> (CslTerm -> String) -> String
forall a b. (a -> b) -> a -> b
$ String -> String
period (String -> String) -> (CslTerm -> String) -> CslTerm -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CslTerm -> String
termPlural
| String
"long" <- String
f = (CslTerm -> String) -> String
getMonth CslTerm -> String
termPlural
| String
"numeric" <- String
f = String -> a -> String
forall r. PrintfType r => String -> r
printf "%d" a
m
| Bool
otherwise = String -> a -> String
forall r. PrintfType r => String -> r
printf "%02d" a
m
where
period :: String -> String
period = 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
getMonth :: (CslTerm -> String) -> String
getMonth g :: CslTerm -> String
g = String -> (CslTerm -> String) -> Maybe CslTerm -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> String
forall a. Show a => a -> String
show a
m) CslTerm -> String
g (Maybe CslTerm -> String) -> Maybe CslTerm -> String
forall a b. (a -> b) -> a -> b
$ String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm ("month-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> a -> String
forall r. PrintfType r => String -> r
printf "%02d" a
m) (String -> Form
forall a. Read a => String -> a
read (String -> Form) -> String -> Form
forall a b. (a -> b) -> a -> b
$ String -> String
toRead String
f) [CslTerm]
tm
formatDay :: a -> Maybe a -> Int -> String
formatDay f :: a
f m :: Maybe a
m d :: Int
d
| a
"numeric-leading-zeros" <- a
f = String -> Int -> String
forall r. PrintfType r => String -> r
printf "%02d" Int
d
| a
"ordinal" <- a
f = [CslTerm] -> String -> Int -> String
ordinal [CslTerm]
tm ("month-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "0" (String -> a -> String
forall r. PrintfType r => String -> r
printf "%02d") Maybe a
m) Int
d
| Bool
otherwise = String -> Int -> String
forall r. PrintfType r => String -> r
printf "%d" Int
d
ordinal :: [CslTerm] -> String -> Int -> String
ordinal :: [CslTerm] -> String -> Int -> String
ordinal ts :: [CslTerm]
ts v :: String
v s :: Int
s
| Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 = let a :: String
a = CslTerm -> String
termPlural (String -> CslTerm
getWith1 (Int -> String
forall a. Show a => a -> String
show Int
s)) in
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a then CslTerm -> String
setOrd (String -> CslTerm
term []) else Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
| Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 100 = let a :: String
a = CslTerm -> String
termPlural (String -> CslTerm
getWith2 (Int -> String
forall a. Show a => a -> String
show Int
s))
b :: CslTerm
b = String -> CslTerm
getWith1 [String -> Char
forall a. [a] -> a
last (Int -> String
forall a. Show a => a -> String
show Int
s)] in
if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
a)
then Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a
else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CslTerm -> String
termPlural CslTerm
b) Bool -> Bool -> Bool
||
(Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CslTerm -> String
termMatch CslTerm
b)) Bool -> Bool -> Bool
&&
CslTerm -> String
termMatch CslTerm
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "last-digit")
then CslTerm -> String
setOrd (String -> CslTerm
term [])
else CslTerm -> String
setOrd CslTerm
b
| Bool
otherwise = let a :: CslTerm
a = String -> CslTerm
getWith2 String
last2
b :: CslTerm
b = String -> CslTerm
getWith1 [String -> Char
forall a. [a] -> a
last (Int -> String
forall a. Show a => a -> String
show Int
s)] in
if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CslTerm -> String
termPlural CslTerm
a)) Bool -> Bool -> Bool
&&
CslTerm -> String
termMatch CslTerm
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "whole-number"
then CslTerm -> String
setOrd CslTerm
a
else if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CslTerm -> String
termPlural CslTerm
b) Bool -> Bool -> Bool
||
(Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CslTerm -> String
termMatch CslTerm
b)) Bool -> Bool -> Bool
&&
CslTerm -> String
termMatch CslTerm
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "last-digit")
then CslTerm -> String
setOrd (String -> CslTerm
term [])
else CslTerm -> String
setOrd CslTerm
b
where
setOrd :: CslTerm -> String
setOrd = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (Int -> String
forall a. Show a => a -> String
show Int
s) (String -> String) -> (CslTerm -> String) -> CslTerm -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CslTerm -> String
termPlural
getWith1 :: String -> CslTerm
getWith1 = String -> CslTerm
term (String -> CslTerm) -> (String -> String) -> String -> CslTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) "-0"
getWith2 :: String -> CslTerm
getWith2 = String -> CslTerm
term (String -> CslTerm) -> (String -> String) -> String -> CslTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
forall a. [a] -> [a] -> [a]
(++) "-"
last2 :: String
last2 = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
s
term :: String -> CslTerm
term t :: String
t = String -> String -> [CslTerm] -> CslTerm
getOrdinal String
v ("ordinal" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t) [CslTerm]
ts
longOrdinal :: [CslTerm] -> String -> Int -> String
longOrdinal :: [CslTerm] -> String -> Int -> String
longOrdinal ts :: [CslTerm]
ts v :: String
v s :: Int
s
| Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10 Bool -> Bool -> Bool
||
Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = [CslTerm] -> String -> Int -> String
ordinal [CslTerm]
ts String
v Int
s
| Bool
otherwise = case Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 10 of
1 -> String -> String
term "01"
2 -> String -> String
term "02"
3 -> String -> String
term "03"
4 -> String -> String
term "04"
5 -> String -> String
term "05"
6 -> String -> String
term "06"
7 -> String -> String
term "07"
8 -> String -> String
term "08"
9 -> String -> String
term "09"
_ -> String -> String
term "10"
where
term :: String -> String
term t :: String
t = CslTerm -> String
termPlural (CslTerm -> String) -> CslTerm -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> [CslTerm] -> CslTerm
getOrdinal String
v ("long-ordinal-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t) [CslTerm]
ts
getOrdinal :: String -> String -> [CslTerm] -> CslTerm
getOrdinal :: String -> String -> [CslTerm] -> CslTerm
getOrdinal v :: String
v s :: String
s ts :: [CslTerm]
ts
= CslTerm -> Maybe CslTerm -> CslTerm
forall a. a -> Maybe a -> a
fromMaybe CslTerm
newTerm (Maybe CslTerm -> CslTerm) -> Maybe CslTerm -> CslTerm
forall a b. (a -> b) -> a -> b
$ String -> Form -> Gender -> [CslTerm] -> Maybe CslTerm
findTerm' String
s Form
Long Gender
gender [CslTerm]
ts Maybe CslTerm -> Maybe CslTerm -> Maybe CslTerm
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
String -> Form -> Gender -> [CslTerm] -> Maybe CslTerm
findTerm' String
s Form
Long Gender
Neuter [CslTerm]
ts
where
gender :: Gender
gender = if String
v String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
numericVars Bool -> Bool -> Bool
|| "month" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
v
then Gender -> (CslTerm -> Gender) -> Maybe CslTerm -> Gender
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Gender
Neuter CslTerm -> Gender
termGender (Maybe CslTerm -> Gender) -> Maybe CslTerm -> Gender
forall a b. (a -> b) -> a -> b
$ String -> Form -> [CslTerm] -> Maybe CslTerm
findTerm String
v Form
Long [CslTerm]
ts
else Gender
Neuter