{-# 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 s :: [Text]
s f :: DateForm
f fm :: Formatting
fm dl :: Text
dl dp :: [DatePart]
dp 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 "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 :: Text
aa ab :: Text
ab ac :: Text
ac ad :: Text
ad ae :: Text
ae af :: Text
af ag :: Text
ag ah :: Text
ah ai :: Text
ai aj :: Text
aj ak :: Quote
ak al :: Bool
al am :: Bool
am an :: Bool
an ahl :: Text
ahl)
               (Formatting _  _  bc :: Text
bc bd :: Text
bd be :: Text
be bf :: Text
bf bg :: Text
bg bh :: Text
bh _  bj :: Text
bj bk :: Quote
bk _ _ _ _) =
                   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 a :: p
a b :: 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
/= "" then p
b else p
a
  case DateForm
f of
    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
    _          -> do Element
res <- DateForm -> State EvalState Element
getDate DateForm
f
                     case Element
res of
                       Date _ _ lfm :: Formatting
lfm ldl :: Text
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 -> 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
/= "" 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 l :: [DatePart]
l x :: DatePart
x@(DatePart a :: Text
a b :: Text
b c :: Text
c d :: 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 _ b' :: Text
b' c' :: Text
c' d' :: Formatting
d':_) -> 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
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
                           "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
(/=) "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
                           "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
(==) "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
                           _            -> [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
$ [Text]
-> DateForm -> Formatting -> Text -> [DatePart] -> Text -> Element
Date [] DateForm
NoFormDate Formatting
emptyFormatting "" [] ""

formatDate :: EvalMode -> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate :: EvalMode
-> Text -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
formatDate em :: EvalMode
em k :: Text
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
      -- 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 (dp' :: DatePart
dp':rest :: [DatePart]
rest) = DatePart
dp'{ dpFormatting :: Formatting
dpFormatting =
                                 (DatePart -> Formatting
dpFormatting DatePart
dp') { prefix :: Text
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 :: Text
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 -> 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  -> ["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 :: Text -> Text -> Text
term f :: Text
f t :: Text
t = let f' :: Form
f' = if Text
f Text -> [Text] -> 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) -> (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 "" 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 y :: Maybe Int
y m :: Maybe Int
m e :: Maybe Season
e d :: Maybe Int
d o :: Literal
o _) (DatePart n :: Text
n f :: Text
f _ fm :: Formatting
fm)
          | Text
"year"  <- Text
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
$ 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 m' :: 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 e' :: Season
e' <- Maybe Season
e =
               case Season
e' of
                    RawSeason s :: Text
s -> [Text -> Formatting -> Output
OStr Text
s Formatting
fm]
                    _ -> 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 "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')
          | Text
"day"   <- Text
n, Just d' :: 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 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 -> 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
                              ["-"] -> [[[Inline] -> Output
OPan [Text -> Inline
Str "\x2013"]]]
                              [s :: Text
s]   -> [[[Inline] -> Output
OPan [Text -> Inline
Str Text
s]]]
                              _     -> []) [[Output]] -> [[Output]] -> [[Output]]
forall a. [a] -> [a] -> [a]
++ [[Output]]
o2

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

      formatMonth :: Text -> Formatting -> a -> Text
formatMonth f :: Text
f fm :: Formatting
fm m :: 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 "%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 "%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
/= '.') else Text -> Text
forall a. a -> a
id
            getMonth :: (CslTerm -> Text) -> Text
getMonth g :: CslTerm -> Text
g = case Text -> Form -> [CslTerm] -> Maybe CslTerm
findTerm ("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 "%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
                           Nothing -> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
m)
                           Just x :: CslTerm
x  -> CslTerm -> Text
g CslTerm
x

      formatDay :: a -> Maybe a -> Int -> Text
formatDay f :: a
f m :: Maybe a
m d :: 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 "%02d" Int
d
          | a
"ordinal"               <- a
f = [CslTerm] -> Text -> Int -> Text
ordinal [CslTerm]
tm ("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 "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 "%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 "%d" Int
d

ordinal :: [CslTerm] -> Text -> Int -> Text
ordinal :: [CslTerm] -> Text -> Int -> Text
ordinal ts :: [CslTerm]
ts v :: Text
v s :: Int
s
    | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 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 "")
                      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
< 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
/= "last-digit")
                           then CslTerm -> Text
setOrd (Text -> CslTerm
term "")
                           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
/= "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
/= "last-digit")
                           then CslTerm -> Text
setOrd (Text -> CslTerm
term "")
                           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 "-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) -> (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 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   t :: Text
t = Text -> Text -> [CslTerm] -> CslTerm
getOrdinal Text
v ("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 ts :: [CslTerm]
ts v :: Text
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] -> 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` 10 of
                    1 -> Text -> Text
term "01"
                    2 -> Text -> Text
term "02"
                    3 -> Text -> Text
term "03"
                    4 -> Text -> Text
term "04"
                    5 -> Text -> Text
term "05"
                    6 -> Text -> Text
term "06"
                    7 -> Text -> Text
term "07"
                    8 -> Text -> Text
term "08"
                    9 -> Text -> Text
term "09"
                    _ -> Text -> Text
term "10"
    where
      term :: Text -> Text
term t :: Text
t = CslTerm -> Text
termPlural (CslTerm -> Text) -> CslTerm -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [CslTerm] -> CslTerm
getOrdinal Text
v ("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 v :: Text
v s :: Text
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
$ 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
|| "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