{-# 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
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
      -- 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 :: 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