{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.CSL.Eval.Date
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unitn.it>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The CSL implementation
--
-----------------------------------------------------------------------------

module Text.CSL.Eval.Date where

import Prelude
import qualified Control.Exception      as E
import           Control.Monad.State

import           Data.List.Split
import           Data.Maybe (fromMaybe, isNothing)
import           Data.Text              (Text)
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 [Text]
s DateForm
f Formatting
fm Text
dl [DatePart]
dp Text
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
  Text
k  <- Text -> State EvalState Text
getStringVar Text
"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 Text
aa Text
ab Text
ac Text
ad Text
ae Text
af Text
ag Text
ah Text
ai Text
aj Quote
ak Bool
al Bool
am Bool
an Text
ahl)
               (Formatting Text
_  Text
_  Text
bc Text
bd Text
be Text
bf Text
bg Text
bh Text
_  Text
bj Quote
bk Bool
_ Bool
_ Bool
_ Text
_) =
                   Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Quote
-> Bool
-> Bool
-> Bool
-> Text
-> Formatting
Formatting Text
aa Text
ab (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
ac Text
bc)
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
ad Text
bd)
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
ae Text
be)
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
af Text
bf)
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
ag Text
bg)
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
ah Text
bh)
                                    Text
ai
                                    (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS Text
aj Text
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 Text
ahl
      updateS :: p -> p -> p
updateS p
a p
b = if p
b p -> p -> Bool
forall a. Eq a => a -> a -> Bool
/= p
a Bool -> Bool -> Bool
&& p
b p -> p -> Bool
forall a. Eq a => a -> a -> Bool
/= p
"" then p
b else p
a
  case DateForm
f of
    DateForm
NoFormDate -> Formatting -> Text -> [Output] -> [Output]
outputList Formatting
fm Text
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
-> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate EvalMode
em Text
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
<$> (Text -> StateT EvalState Identity [RefDate])
-> [Text] -> StateT EvalState Identity [[RefDate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> StateT EvalState Identity [RefDate]
getDateVar [Text]
s
    DateForm
_          -> do Element
res <- DateForm -> State EvalState Element
getDate DateForm
f
                     case Element
res of
                       Date [Text]
_ DateForm
_ Formatting
lfm Text
ldl [DatePart]
ldp Text
_ -> do
                         let go :: [DatePart] -> t [RefDate] -> m [Output]
go [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 -> Text -> [Output] -> [Output]
outputList (Formatting -> Formatting -> Formatting
updateFM Formatting
fm Formatting
lfm) (if Text
ldl Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then Text
ldl else Text
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
-> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate EvalMode
em Text
k [CslTerm]
tm [DatePart]
dps)
                             update :: [DatePart] -> DatePart -> DatePart
update [DatePart]
l x :: DatePart
x@(DatePart Text
a Text
b Text
c Formatting
d) =
                                 case (DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
a (Text -> Bool) -> (DatePart -> Text) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> Text
dpName) [DatePart]
l of
                                   (DatePart Text
_ Text
b' Text
c' Formatting
d':[DatePart]
_) -> Text -> Text -> Text -> Formatting -> DatePart
DatePart Text
a (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS  Text
b Text
b')
                                                                         (Text -> Text -> Text
forall p. (Eq p, IsString p) => p -> p -> p
updateS  Text
c Text
c')
                                                                         (Formatting -> Formatting -> Formatting
updateFM Formatting
d Formatting
d')
                                   [DatePart]
_                       -> 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     = (Text -> StateT EvalState Identity [RefDate])
-> [Text] -> StateT EvalState Identity [[RefDate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> StateT EvalState Identity [RefDate]
getDateVar [Text]
s
                         case Text
dp' of
                           Text
"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 (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Text
"day"  (Text -> Bool) -> (DatePart -> Text) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> Text
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
                           Text
"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 (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) Text
"year" (Text -> Bool) -> (DatePart -> Text) -> DatePart -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatePart -> Text
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
                           Text
_            -> [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
                       Element
_ -> [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
evalDate Element
_ = [Output] -> State EvalState [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []

getDate :: DateForm -> State EvalState Element
getDate :: DateForm -> State EvalState Element
getDate DateForm
f = do
  [Element]
x <- (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Date [Text]
_ DateForm
df Formatting
_ Text
_ [DatePart]
_ Text
_) -> 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
    [Element
x'] -> Element -> State EvalState Element
forall (m :: * -> *) a. Monad m => a -> m a
return Element
x'
    [Element]
_    -> 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
$ [Text]
-> DateForm -> Formatting -> Text -> [DatePart] -> Text -> Element
Date [] DateForm
NoFormDate Formatting
emptyFormatting Text
"" [] Text
""

formatDate :: EvalMode -> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate :: EvalMode
-> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate EvalMode
em Text
k [CslTerm]
tm [DatePart]
dp [RefDate]
date
    | [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
    | (RefDate
a:RefDate
b:[RefDate]
_) <- [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 [Output]
xs = [[Output] -> Output
ODate [Output]
xs]
      splitDate :: RefDate -> RefDate -> ([DatePart], [DatePart], [DatePart])
splitDate RefDate
a 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
                        [[DatePart]
x,[DatePart]
y,[DatePart]
z] -> ([DatePart]
x,[DatePart]
y,[DatePart]
z)
                        [[DatePart]]
_       -> CiteprocException -> ([DatePart], [DatePart], [DatePart])
forall a e. Exception e => e -> a
E.throw CiteprocException
ErrorSplittingDate
      doRange :: RefDate -> RefDate -> [[Output]]
doRange   RefDate
a RefDate
b = let ([DatePart]
x,[DatePart]
y,[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
      -- the point of rmPrefix is to remove the blank space that otherwise
      -- gets added after the delimiter in a range:  24- 26.
      rmPrefix :: [DatePart] -> [DatePart]
rmPrefix (DatePart
dp':[DatePart]
rest) = DatePart
dp'{ dpFormatting :: Formatting
dpFormatting =
                                 (DatePart -> Formatting
dpFormatting DatePart
dp') { prefix :: Text
prefix = Text
"" } } DatePart -> [DatePart] -> [DatePart]
forall a. a -> [a] -> [a]
: [DatePart]
rest
      rmPrefix []         = []
      rmSuffix :: [DatePart] -> [DatePart]
rmSuffix (DatePart
dp':[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 :: Text
suffix = Text
"" } }]
         | 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 Maybe Int
ya Maybe Int
ma Maybe Season
sa Maybe Int
da Literal
_ Bool
_)
           (RefDate Maybe Int
yb Maybe Int
mb Maybe Season
sb Maybe Int
db Literal
_ Bool
_)
           = (DatePart -> Bool) -> [DatePart] -> [DatePart]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DatePart
x -> DatePart -> Text
dpName DatePart
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
ns)
              where ns :: [Text]
ns =
                      case () of
                        ()
_ | Maybe Int
ya Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
yb  -> [Text
"year",Text
"month",Text
"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 [Text
"month"]
                               else [Text
"month",Text
"day"]
                          | Maybe Int
da Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
db  -> [Text
"day"]
                          | Bool
otherwise -> [Text
"year",Text
"month",Text
"day"]

      term :: Text -> Text -> Text
term Text
f Text
t = let f' :: Form
f' = if Text
f Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"verb", Text
"short", Text
"verb-short", Text
"symbol"]
                          then String -> Form
forall a. Read a => String -> a
read (String -> Form) -> (Text -> String) -> Text -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Form) -> Text -> Form
forall a b. (a -> b) -> a -> b
$ Text -> Text
toRead Text
f
                          else Form
Long
                 in Text -> (CslTerm -> Text) -> Maybe CslTerm -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" CslTerm -> Text
termPlural (Maybe CslTerm -> Text) -> Maybe CslTerm -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Form -> [CslTerm] -> Maybe CslTerm
findTerm Text
t Form
f' [CslTerm]
tm

      formatDatePart :: RefDate -> DatePart -> [Output]
formatDatePart (RefDate Maybe Int
y Maybe Int
m Maybe Season
e Maybe Int
d Literal
o Bool
_) (DatePart Text
n Text
f Text
_ Formatting
fm)
          | Text
"year"  <- Text
n, Just 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
$ Text -> Text -> Formatting -> Output
OYear (Text -> Int -> Text
forall a t.
(IsString a, PrintfArg t, Ord t, Num t, Eq a) =>
a -> t -> Text
formatYear  Text
f    Int
y') Text
k Formatting
fm
          | Text
"month" <- Text
n, Just Int
m' <- Maybe Int
m = Formatting -> Text -> [Output]
output Formatting
fm      (Text -> Formatting -> Int -> Text
forall a. (PrintfArg a, Show a) => Text -> Formatting -> a -> Text
formatMonth Text
f Formatting
fm Int
m')
          | Text
"month" <- Text
n, Just Season
e' <- Maybe Season
e =
               case Season
e' of
                    RawSeason Text
s -> [Text -> Formatting -> Output
OStr Text
s Formatting
fm]
                    Season
_ -> Formatting -> Text -> [Output]
output Formatting
fm (Text -> [Output]) -> (String -> Text) -> String -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
term Text
f (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> [Output]) -> String -> [Output]
forall a b. (a -> b) -> a -> b
$
                         (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"season-%02d" (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Season -> Maybe Int
seasonToInt Season
e')
          | Text
"day"   <- Text
n, Just Int
d' <- Maybe Int
d = Formatting -> Text -> [Output]
output Formatting
fm      (Text -> Maybe Int -> Int -> Text
forall a a.
(Eq a, IsString a, PrintfArg a) =>
a -> Maybe a -> Int -> Text
formatDay   Text
f Maybe Int
m  Int
d')
          | Text
"year"  <- Text
n, Literal
o Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
/= Literal
forall a. Monoid a => a
mempty = Formatting -> Text -> [Output]
output Formatting
fm (Literal -> Text
unLiteral Literal
o)
          | Bool
otherwise                 = []

      withDelim :: [DatePart] -> [[Output]] -> [[Output]] -> [[Output]]
withDelim [DatePart]
xs [[Output]]
o1 [[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 -> Text
dpRangeDelim (DatePart -> Text) -> [DatePart] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DatePart] -> [DatePart]
forall a. [a] -> [a]
last' [DatePart]
xs of
                              [Text
"-"] -> [[[Inline] -> Output
OPan [Text -> Inline
Str Text
"\x2013"]]]
                              [Text
s]   -> [[[Inline] -> Output
OPan [Text -> Inline
Str Text
s]]]
                              [Text]
_     -> []) [[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++ [[Output]]
o2

      formatYear :: a -> t -> Text
formatYear a
f t
y
          | a
"short" <- a
f = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%02d" t
y
          | EvalMode -> Bool
isSorting EvalMode
em
          , t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0        = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"-%04d" (t -> t
forall a. Num a => a -> a
abs t
y)
          | EvalMode -> Bool
isSorting EvalMode
em = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%04d" t
y
          | t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0        = (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%d" (t -> t
forall a. Num a => a -> a
abs t
y)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
term Text
"" Text
"bc"
          | t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
1000
          , t
y t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0        = (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%d" t
y) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
term Text
"" Text
"ad"
          | t
y t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0       = Text
""
          | Bool
otherwise    = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> t -> String
forall r. PrintfType r => String -> r
printf String
"%d" t
y

      formatMonth :: Text -> Formatting -> a -> Text
formatMonth Text
f Formatting
fm a
m
          | Text
"short"   <- Text
f = (CslTerm -> Text) -> Text
getMonth ((CslTerm -> Text) -> Text) -> (CslTerm -> Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
period (Text -> Text) -> (CslTerm -> Text) -> CslTerm -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CslTerm -> Text
termPlural
          | Text
"long"    <- Text
f = (CslTerm -> Text) -> Text
getMonth CslTerm -> Text
termPlural
          | Text
"numeric" <- Text
f = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> a -> String
forall r. PrintfType r => String -> r
printf String
"%d" a
m
          | Bool
otherwise      = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> a -> String
forall r. PrintfType r => String -> r
printf String
"%02d" a
m
          where
            period :: Text -> Text
period     = if Formatting -> Bool
stripPeriods Formatting
fm then (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') else Text -> Text
forall a. a -> a
id
            getMonth :: (CslTerm -> Text) -> Text
getMonth CslTerm -> Text
g = case Text -> Form -> [CslTerm] -> Maybe CslTerm
findTerm (Text
"month-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String -> a -> String
forall r. PrintfType r => String -> r
printf String
"%02d" a
m))
                                       (String -> Form
forall a. Read a => String -> a
read (String -> Form) -> (Text -> String) -> Text -> Form
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Form) -> Text -> Form
forall a b. (a -> b) -> a -> b
$ Text -> Text
toRead Text
f) [CslTerm]
tm of
                           Maybe CslTerm
Nothing -> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
m)
                           Just CslTerm
x  -> CslTerm -> Text
g CslTerm
x

      formatDay :: a -> Maybe a -> Int -> Text
formatDay a
f Maybe a
m Int
d
          | a
"numeric-leading-zeros" <- a
f = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02d" Int
d
          | a
"ordinal"               <- a
f = [CslTerm] -> Text -> Int -> Text
ordinal [CslTerm]
tm (Text
"month-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (a -> Text) -> Maybe a -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"0" (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> String
forall r. PrintfType r => String -> r
printf String
"%02d") Maybe a
m) Int
d
          | Bool
otherwise                    = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%d" Int
d

ordinal :: [CslTerm] -> Text -> Int -> Text
ordinal :: [CslTerm] -> Text -> Int -> Text
ordinal [CslTerm]
ts Text
v Int
s
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10        = let a :: Text
a = CslTerm -> Text
termPlural (String -> CslTerm
getWith1 (Int -> String
forall a. Show a => a -> String
show Int
s)) in
                      if Text -> Bool
T.null Text
a
                      then CslTerm -> Text
setOrd (Text -> CslTerm
term Text
"")
                      else String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100       = let a :: Text
a = CslTerm -> Text
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 (Text -> Bool
T.null Text
a)
                      then String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
s) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
                      else if Text -> Bool
T.null (CslTerm -> Text
termPlural CslTerm
b) Bool -> Bool -> Bool
||
                              (Bool -> Bool
not (Text -> Bool
T.null (CslTerm -> Text
termMatch CslTerm
b)) Bool -> Bool -> Bool
&&
                               CslTerm -> Text
termMatch CslTerm
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"last-digit")
                           then CslTerm -> Text
setOrd (Text -> CslTerm
term Text
"")
                           else CslTerm -> Text
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 (Text -> Bool
T.null (CslTerm -> Text
termPlural CslTerm
a)) Bool -> Bool -> Bool
&&
                         CslTerm -> Text
termMatch CslTerm
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"whole-number"
                      then CslTerm -> Text
setOrd CslTerm
a
                      else if Text -> Bool
T.null (CslTerm -> Text
termPlural CslTerm
b) Bool -> Bool -> Bool
||
                              (Bool -> Bool
not (Text -> Bool
T.null (CslTerm -> Text
termMatch CslTerm
b)) Bool -> Bool -> Bool
&&
                               CslTerm -> Text
termMatch CslTerm
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"last-digit")
                           then CslTerm -> Text
setOrd (Text -> CslTerm
term Text
"")
                           else CslTerm -> Text
setOrd CslTerm
b
    where
      setOrd :: CslTerm -> Text
setOrd   = Text -> Text -> Text
T.append (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
s) (Text -> Text) -> (CslTerm -> Text) -> CslTerm -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CslTerm -> Text
termPlural
      getWith1 :: String -> CslTerm
getWith1 = Text -> CslTerm
term (Text -> CslTerm) -> (String -> Text) -> String -> CslTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"-0" (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      getWith2 :: String -> CslTerm
getWith2 = Text -> CslTerm
term (Text -> CslTerm) -> (String -> Text) -> String -> CslTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
T.append Text
"-" (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
      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 Int
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 :: Text -> CslTerm
term   Text
t = Text -> Text -> [CslTerm] -> CslTerm
getOrdinal Text
v (Text
"ordinal" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) [CslTerm]
ts

longOrdinal :: [CslTerm] -> Text -> Int -> Text
longOrdinal :: [CslTerm] -> Text -> Int -> Text
longOrdinal [CslTerm]
ts Text
v Int
s
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10 Bool -> Bool -> Bool
||
      Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = [CslTerm] -> Text -> Int -> Text
ordinal [CslTerm]
ts Text
v Int
s
    | Bool
otherwise = case Int
s Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10 of
                    Int
1 -> Text -> Text
term Text
"01"
                    Int
2 -> Text -> Text
term Text
"02"
                    Int
3 -> Text -> Text
term Text
"03"
                    Int
4 -> Text -> Text
term Text
"04"
                    Int
5 -> Text -> Text
term Text
"05"
                    Int
6 -> Text -> Text
term Text
"06"
                    Int
7 -> Text -> Text
term Text
"07"
                    Int
8 -> Text -> Text
term Text
"08"
                    Int
9 -> Text -> Text
term Text
"09"
                    Int
_ -> Text -> Text
term Text
"10"
    where
      term :: Text -> Text
term Text
t = CslTerm -> Text
termPlural (CslTerm -> Text) -> CslTerm -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [CslTerm] -> CslTerm
getOrdinal Text
v (Text
"long-ordinal-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t) [CslTerm]
ts

getOrdinal :: Text -> Text -> [CslTerm] -> CslTerm
getOrdinal :: Text -> Text -> [CslTerm] -> CslTerm
getOrdinal Text
v Text
s [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
$ Text -> Form -> Gender -> [CslTerm] -> Maybe CslTerm
findTerm' Text
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`
                          Text -> Form -> Gender -> [CslTerm] -> Maybe CslTerm
findTerm' Text
s Form
Long Gender
Neuter [CslTerm]
ts
    where
      gender :: Gender
gender = if Text
v Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
numericVars Bool -> Bool -> Bool
|| Text
"month" Text -> Text -> Bool
`T.isPrefixOf` Text
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
$ Text -> Form -> [CslTerm] -> Maybe CslTerm
findTerm Text
v Form
Long [CslTerm]
ts
               else Gender
Neuter