[Last-Modified support for feeds. prb@mult.ifario.us**20080228182224] { hunk ./servletsrc/perpubplat.hs 19 +import qualified Utilities as Utils hunk ./servletsrc/perpubplat.hs 30 - , chrome_b :: ChromeB.ChromeBackEnd } + , chrome_b :: ChromeB.ChromeBackEnd + {-, referer_stream :: RefererStream -} + } hunk ./servletsrc/perpubplat.hs 38 + hunk ./servletsrc/perpubplat.hs 49 +-- Drafts functionality +-- (ReviewDrafts n) -> review_drafts con n +-- (ReviewDraft n) -> review_drafts con n hunk ./servletsrc/perpubplat.hs 58 -serve_content con v = do { m <- liftIO $ DataC.get_model (data_c con) +serve_content con v = do { --requestHeader "Referer" >>= liftIO $ send_referer hunk ./servletsrc/perpubplat.hs 61 - ; h <- liftIO $ P.assemble_page v (chrome_b con) m + ; h <- liftIO $ DataC.get_model (data_c con) >>= P.assemble_page v (chrome_b con) hunk ./servletsrc/perpubplat.hs 66 - ; setStatus 200 "OK" - ; setHeader "Content-type" "application/atom+xml" - ; output $ S.assemble_feed f m } + ; setStatus 200 "OK" + ; let items = F.items f m + ; setHeader "Content-type" "application/atom+xml" + ; setHeader "Last-Modified" $ Utils.iso8601toRfc1123 $ S.last_updated items + ; output $ S.assemble_feed f m items } hunk ./src/Blog/FrontEnd/Syndication.hs 1 -module Blog.FrontEnd.Syndication ( assemble_feed ) where +module Blog.FrontEnd.Syndication ( assemble_feed, last_updated ) where hunk ./src/Blog/FrontEnd/Syndication.hs 9 -assemble_feed :: (F.Feedable f) => f -> B.Model -> String -assemble_feed g m +assemble_feed :: (F.Feedable f) => f -> B.Model -> [B.Item] -> String +assemble_feed g m items hunk ./src/Blog/FrontEnd/Syndication.hs 24 - items = F.items g m hunk ./src/Utilities.hs 2 - , map_by, paginate, last_page, days_since ) where + , map_by, paginate, last_page, days_since + , iso8601toRfc1123, rfc1123toIso8601 ) where hunk ./src/Utilities.hs 6 +import qualified Data.Time.Format as DTF +import Text.ParserCombinators.Parsec as P hunk ./src/Utilities.hs 14 +import qualified Data.Time.Clock as DTC hunk ./src/Utilities.hs 16 +import qualified System.Locale as SL hunk ./src/Utilities.hs 161 +iso8601toRfc1123 :: String -> String +iso8601toRfc1123 = (flip (++) $ " GMT") . (DTF.formatTime SL.defaultTimeLocale rfc1123DateFormat) . iso8601toUTCTime + +iso8601toUTCTime :: String -> DTC.UTCTime +iso8601toUTCTime ts = DTC.UTCTime (toDay ts) (toSecondsSinceMidnight ts) + hunk ./src/Utilities.hs 174 +toSecondsSinceMidnight :: String -> DTC.DiffTime +toSecondsSinceMidnight ts = DTC.secondsToDiffTime $ _h * 3600 + _m * 60 + _s + where + ts' = drop 11 ts + _h = read . (take 2) $ ts' + _m = read . (take 2) . (drop 3) $ ts' + _s = read . (take 2) . (drop 6) $ ts' + hunk ./src/Utilities.hs 186 + +rfc1123DateFormat :: String +rfc1123DateFormat = "%a, %d %b %Y %T" -- and then a " GMT" on the end + +rfc1123toIso8601 :: String -> String +rfc1123toIso8601 d = case P.parse rfc1123DateParser "" d of + Left _ -> + "" + Right d' -> + d' + +rfc1123DateParser :: P.Parser String +rfc1123DateParser = do { P.choice $ map P.string [ "Sun", "Mon", "Tue", "Wed", "Thu" + , "Fri","Sat","Sun"] + ; P.string ", " + ; day <- count 2 digit + ; space + ; month <- P.choice $ map (\(n,s) -> P.string s >> return n) + $ zip [1..12] [ "Jan", "Feb", "Mar", "Apr", "May", "Jun" + , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ] + ; space + ; year <- count 4 digit + ; space + ; hour <- count 2 digit + ; char ':' + ; minute <- count 2 digit + ; char ':' + ; seconds <- count 2 digit + ; string " GMT" + ; return $ concat [ year, "-", (zpad $ show month), "-", day, "T" + , hour, ":", minute, ":", seconds, "Z" ] } + }