    {-# 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 Control.Applicative ( (<$>) )
    import Control.Monad.State
    import Data.Char
    import Data.List
    import Data.Maybe

    import Text.CSL.Eval.Common
    import Text.CSL.Eval.Output
    import Text.CSL.Parser ( toRead )
    import Text.CSL.Reference
    import Text.CSL.Style
    import Text.Pandoc.Definition ( Inline (Str) )

    evalDate :: Element -> State EvalState [Output]
    evalDate (Date s f fm dl dp dp') = do
      tm <- gets $ terms . env
      k  <- getStringVar "ref-id"
      em <- gets mode
      let updateFM (Formatting aa ab ac ad ae af ag ah ai aj ak al am an)
                   (Formatting _  _  bc bd be bf bg bh _  bj bk _ _ _) =
                       Formatting aa ab (updateS ac bc)
                                        (updateS ad bd)
                                        (updateS ae be)
                                        (updateS af bf)
                                        (updateS ag bg)
                                        (updateS ah bh)
                                        ai
                                        (updateS aj bj)
                                        (if bk /= ak then bk else ak)
                                        al am an
          updateS a b = if b /= a && b /= [] then b else a
      case f of
        NoFormDate -> mapM getDateVar s >>= return . outputList fm dl .
                      concatMap (formatDate em k tm dp . concatMap parseRefDate)
        _          -> do Date _ _ lfm ldl ldp _ <- getDate f
                         let go dps = return . outputList (updateFM fm lfm) (if ldl /= [] then ldl else dl) .
                                      concatMap (formatDate em k tm dps . concatMap parseRefDate)
                             update l x@(DatePart a b c d) =
                                 case filter ((==) a . dpName) l of
                                   (DatePart _ b' c' d':_) -> DatePart a (updateS  b b')
                                                                         (updateS  c c')
                                                                         (updateFM d d')
                                   _                       -> x
                             updateDP = map (update dp) ldp
                             date     = mapM getDateVar s
                         case dp' of
                           "year-month" -> go (filter ((/=) "day"  . dpName) updateDP) =<< date
                           "year"       -> go (filter ((==) "year" . dpName) updateDP) =<< date
                           _            -> go                                updateDP  =<< date

    evalDate _ = return []

    getDate :: DateForm -> State EvalState Element
    getDate f = do
      x <- filter (\(Date _ df _ _ _ _) -> df == f) <$> gets (dates . env)
      case x of
        [x'] -> return x'
        _    -> return $ Date [] NoFormDate emptyFormatting [] [] []

    formatDate :: EvalMode -> String -> [CslTerm] -> [DatePart] -> [RefDate] -> [Output]
    formatDate em k tm dp date
        | [d]     <- date = concatMap (formatDatePart False d) dp
        | (a:b:_) <- date = return . ODate . concat $ (start a b ++ end a b ++ coda b)
        | otherwise       = []
        where
          start a b = map (formatDatePart False a) . init          . diff a b $ dp
          end   a b = map (formatDatePart True  a) . return . last . diff a b $ dp
          coda    b = map (formatDatePart False b) dp
          diff  a b = filter (flip elem (diffDate a b) . dpName)
          diffDate (RefDate ya ma sa da _ _)
                   (RefDate yb mb sb db _ _) = case () of
                                                 _ | ya /= yb  -> ["year","month","day"]
                                                   | ma /= mb  -> ["month","day"]
                                                   | da /= db  -> ["day"]
                                                   | sa /= sb  -> ["month"]
                                                   | otherwise -> ["year","month","day"]

          term f t = let f' = if f `elem` ["verb", "short", "verb-short", "symbol"]
                              then read $ toRead f
                              else Long
                     in maybe [] termPlural $ findTerm t f' tm

          addZero n = if length n == 1 then '0' : n else n
          addZeros  = reverse . take 5 . flip (++) (repeat '0') . reverse
          formatDatePart False (RefDate y m e d _ _) (DatePart n f _ fm)
              | "year"  <- n, y /= [] = return $ OYear (formatYear  f    y) k fm
              | "month" <- n, m /= [] = output fm      (formatMonth f fm m)
              | "day"   <- n, d /= [] = output fm      (formatDay   f m  d)
              | "month" <- n, m == []
                            , e /= [] = output fm $ term f ("season-0" ++ e)

          formatDatePart True (RefDate y m e d _ _) (DatePart n f rd fm)
              | "year"  <- n, y /= [] = OYear (formatYear  f y) k (fm {suffix = []}) : formatDelim
              | "month" <- n, m /= [] = output (fm {suffix = []}) (formatMonth f fm m) ++ formatDelim
              | "day"   <- n, d /= [] = output (fm {suffix = []}) (formatDay   f m  d) ++ formatDelim
              | "month" <- n, m == []
                            , e /= [] = output (fm {suffix = []}) (term f $ "season-0" ++ e) ++ formatDelim
              where
                formatDelim = if rd == "-" then [OPan [Str "\x2013"]] else [OPan [Str rd]]

          formatDatePart _ (RefDate _ _ _ _ o _) (DatePart n _ _ fm)
              | "year"  <- n, o /= [] = output fm o
              | otherwise             = []

          formatYear f y
              | "short" <- f = drop 2 y
              | isSorting em
              , iy < 0       = '-' : addZeros (tail y)
              | isSorting em = addZeros y
              | iy < 0       = show (abs iy) ++ term [] "bc"
              | length y < 4
              , iy /= 0      = y ++ term [] "ad"
              | iy == 0      = []
              | otherwise    = y
              where
                iy = readNum y
          formatMonth f fm m
              | "short"   <- f = getMonth $ period . termPlural
              | "long"    <- f = getMonth termPlural
              | "numeric" <- f = m
              | otherwise      = addZero m
              where
                period     = if stripPeriods fm then filter (/= '.') else id
                getMonth g = maybe m g $ findTerm ("month-" ++ addZero m) (read $ toRead f) tm
          formatDay f m d
              | "numeric-leading-zeros" <- f = addZero d
              | "ordinal"               <- f = ordinal tm ("month-" ++ addZero m) d
              | otherwise                    = d

    ordinal :: [CslTerm] -> String -> String -> String
    ordinal _ _ [] = []
    ordinal ts v s
        | length s == 1 = let a = termPlural (getWith1 s) in
                          if  a == [] then setOrd (term []) else s ++ a
        | length s == 2 = let a = termPlural (getWith2 s)
                              b = getWith1 [last s] in
                          if  a /= []
                          then s ++ a
                          else if termPlural b == [] || (termMatch b /= [] && termMatch b /= "last-digit")
                               then setOrd (term []) else setOrd b
        | otherwise     = let a = getWith2  last2
                              b = getWith1 [last s] in
                          if termPlural a /= [] && termMatch a /= "whole-number"
                          then setOrd a
                          else if termPlural b == [] || (termMatch b /= [] && termMatch b /= "last-digit")
                               then setOrd (term []) else setOrd b
        where
          setOrd   = (++) s . termPlural
          getWith1 = term . (++) "-0"
          getWith2 = term . (++) "-"
          last2    = reverse . take 2 . reverse $ s
          term   t = getOrdinal v ("ordinal" ++ t) ts

    longOrdinal :: [CslTerm] -> String -> String -> String
    longOrdinal _ _ [] = []
    longOrdinal ts v s
        | num > 10 ||
          num == 0  = ordinal ts v s
        | otherwise = case last s of
                        '1' -> term "01"
                        '2' -> term "02"
                        '3' -> term "03"
                        '4' -> term "04"
                        '5' -> term "05"
                        '6' -> term "06"
                        '7' -> term "07"
                        '8' -> term "08"
                        '9' -> term "09"
                        _   -> term "10"
        where
          num    = readNum s
          term t = termPlural $ getOrdinal v ("long-ordinal-" ++ t) ts

    getOrdinal :: String -> String -> [CslTerm] -> CslTerm
    getOrdinal v s ts
        = case findTerm' s Long gender ts of
            Just  x -> x
            Nothing -> case findTerm' s Long Neuter ts of
                         Just  x -> x
                         Nothing -> newTerm
        where
          gender = if v `elem` numericVars || "month" `isPrefixOf` v
                   then maybe Neuter termGender $ findTerm v Long ts
                   else Neuter

    parseRefDate :: RefDate -> [RefDate]
    parseRefDate r@(RefDate _ _ _ _ o c)
        = if null o then return r
          else let (a,b) = break (== '-') o
               in  if null b then return (parseRaw o) else [parseRaw a, parseRaw b]
        where
          parseRaw str =
              case words $ check str of
                [y']       | and (map isDigit y') -> RefDate y' [] [] [] o c
                [s',y']    | and (map isDigit y')
                           , and (map isDigit s') -> RefDate y' s' [] [] o c
                [s',y']    | s' `elem'` seasons   -> RefDate y' [] (select s' seasons) [] o []
                [s',y']    | s' `elem'` months    -> RefDate y' (select s'  months) [] [] o c
                [s',d',y'] | and (map isDigit s')
                           , and (map isDigit y')
                           , and (map isDigit d') -> RefDate y' s' [] d' o c
                [s',d',y'] | s' `elem'` months
                           , and (map isDigit y')
                           , and (map isDigit d') -> RefDate y' (select s'  months) [] d' o c
                [s',d',y'] | s' `elem'` months
                           , and (map isDigit y')
                           , and (map isDigit d') -> RefDate y' (select s'  months) [] d' o c
                _                                 -> r
          check []     = []
          check (x:xs) = if x `elem` ",/-" then ' ' : check xs else x : check xs
          select     x = show . (+ 1) . fromJust . elemIndex' x
          elem'      x = elem      (map toLower $ take 3 x)
          elemIndex' x = elemIndex (map toLower $ take 3 x)

          months   = ["jan","feb","mar","apr","may","jun","jul","aug","sep","oct","nov","dec"]
          seasons  = ["spr","sum","fal","win"]