{-# LANGUAGE PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Eval.Date -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Andrea Rossato -- 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 -> [TermMap] -> [DatePart] -> [RefDate] -> [Output] formatDate em k tm dp date | [d] <- date = concatMap (formatDatePart False d) dp | (a:b:_) <- date = 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 [] fst $ lookup (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 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 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 . fst | "long" <- f = getMonth fst | "numeric" <- f = m | otherwise = addZero m where period = if stripPeriods fm then filter (/= '.') else id getMonth g = maybe m g $ lookup ("month-" ++ addZero m, read $ toRead f) tm formatDay f d | "numeric-leading-zeros" <- f = addZero d | "ordinal" <- f = ordinal tm d | otherwise = d ordinal :: [TermMap] -> String -> String ordinal _ [] = [] ordinal tm s = case last s of '1' -> s ++ term "1" '2' -> s ++ term "2" '3' -> s ++ term "3" _ -> s ++ term "4" where term t = maybe [] fst $ lookup ("ordinal-0" ++ t, Long) tm longOrdinal :: [TermMap] -> String -> String longOrdinal _ [] = [] longOrdinal tm s | num > 10 || num == 0 = ordinal tm 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 = maybe [] fst $ lookup ("long-ordinal-" ++ t, Long) tm 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"]