--------------------------------------------------------------------
-- |
-- Module    : Text.Feed.Util
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
module Text.Feed.Util
  ( toFeedDateString
  , toFeedDateStringUTC
  ) where

import Prelude.Compat

import Data.Time (UTCTime, formatTime)
import qualified Data.Time.Locale.Compat
import qualified System.Locale
import System.Time (ClockTime, formatCalendarTime, toUTCTime)
import Text.Feed.Types

-- | 'toFeedDateString' translates a calendar time into
-- the format expected by the feed kind.
toFeedDateString :: FeedKind -> ClockTime -> String {-Date-}
toFeedDateString :: FeedKind -> ClockTime -> String
toFeedDateString FeedKind
fk ClockTime
ct = TimeLocale -> String -> CalendarTime -> String
formatCalendarTime TimeLocale
System.Locale.defaultTimeLocale String
fmt CalendarTime
ut
  where
    fmt :: String
fmt = FeedKind -> String
feedKindTimeFormat FeedKind
fk
    ut :: CalendarTime
ut = ClockTime -> CalendarTime
toUTCTime ClockTime
ct

-- | 'toFeedDateStringUTC' translates a UTC time into
-- the format expected by the feed kind.
toFeedDateStringUTC :: FeedKind -> UTCTime -> String {-Date-}
toFeedDateStringUTC :: FeedKind -> UTCTime -> String
toFeedDateStringUTC FeedKind
fk = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
Data.Time.Locale.Compat.defaultTimeLocale String
fmt
  where
    fmt :: String
fmt = FeedKind -> String
feedKindTimeFormat FeedKind
fk

-- | Time format expected by the feed kind.
feedKindTimeFormat :: FeedKind -> String
feedKindTimeFormat :: FeedKind -> String
feedKindTimeFormat FeedKind
fk =
  case FeedKind
fk of
    AtomKind {} -> String
atomRdfTimeFormat
    RSSKind {} -> String
"%a, %d %b %Y %H:%M:%S GMT"
    RDFKind {} -> String
atomRdfTimeFormat
  where
    atomRdfTimeFormat :: String
atomRdfTimeFormat = String
"%Y-%m-%dT%H:%M:%SZ"