Add code for parsing time and printing it in a uniform format

app/Main.hs

@@ -8,6 +8,7 @@ import Control.Monad (replicateM, mapM_)
 import System.Directory (getHomeDirectory)
 import System.FilePath ((</>))
 import Data.Text () -- Instances
+import Data.Time.LocalTime (TimeZone, getCurrentTimeZone)
 
 import Control.Lens ((^.))
 
@@ -49,9 +50,9 @@ theMap = attrMap V.defAttr
     , ("FetchOK",           V.withForeColor V.currentAttr V.green)
     ]
 
-app :: (FilePath -> IO ()) -> App State WorkerEvent ()
-app q = App
-  { appDraw = draw
+app :: TimeZone -> (FilePath -> IO ()) -> App State WorkerEvent ()
+app z q = App
+  { appDraw = draw z
   , appHandleEvent = handle q
   , appStartEvent = return
   , appAttrMap = const $ theMap
@@ -108,5 +109,6 @@ main = do
   from <- newBChan 100
   to <- newBChan 20
   th <- replicateM 10 $ async $ workerThread from to
-  writeCacheFile oCache =<< cacheFromState <$> defaultMain' to (app $ writeBChan from) s
+  z <- getCurrentTimeZone
+  writeCacheFile oCache =<< cacheFromState <$> defaultMain' to (app z $ writeBChan from) s
   mapM_ cancel th

package.yaml

@@ -30,6 +30,7 @@ dependencies:
   - pandoc >= 2.3 && < 3
   - containers >= 0.6 && < 1
   - binary >= 0.8 && < 1
+  - time
 
 ghc-options:
 - -Wall -threaded

src/GenericFeed.hs

@@ -8,6 +8,10 @@ module GenericFeed where
 
 import Control.Arrow ((&&&))
 import Control.Monad (join)
+import Data.Semigroup (First(..))
+import Data.Time.Clock (UTCTime)
+import Data.Time.Format (parseTimeM, parseTimeOrError, formatTime, defaultTimeLocale, iso8601DateFormat, rfc822DateFormat)
+import Data.Foldable (fold)
 
 import Control.Lens
 
@@ -16,17 +20,37 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 
 import GHC.Generics (Generic)
-import Data.Binary (Binary) -- only to derive instances here
+import Data.Binary (Binary(..)) -- only to derive instances here
 
 import Text.Feed.Types
 import qualified Text.Atom.Feed as A
 import qualified Text.RSS.Syntax as R
 import qualified Text.RSS1.Syntax as R1
 
+-- This type allows to create a custom Binary instance for UTCTime. We can't
+-- derive one, since UTCTime isn't declared as Generic in time package.
+newtype MyTime = MyTime { getMyTime :: UTCTime }
+  deriving (Show, Eq, Read)
+
+instance Binary MyTime where
+    put = put . formatTime defaultTimeLocale rfc822DateFormat . getMyTime
+    get = (MyTime . parseTimeOrError False defaultTimeLocale rfc822DateFormat) <$> get
+
+parseDate :: String -> Maybe MyTime
+parseDate t = fmap MyTime $ first $ map (\f -> parseTimeM True defaultTimeLocale f t) dateFormats
+  where
+    dateFormats =
+      [ iso8601DateFormat $ Just "%H:%M:%S%Z"
+      , rfc822DateFormat
+      , "%d %b %Y %H:%M:%S %Z"
+      ]
+    first :: [Maybe a] -> Maybe a
+    first = fmap getFirst . fold . map (fmap First)
+
 data GenericItem = GenericItem
   { giTitle :: Maybe Text -- Title displayed in list
   , giURL :: Maybe Text -- URL to follow
-  , giDate :: Maybe Text -- TODO: Replace this with some better type for date.
+  , giDate :: Maybe MyTime
                          -- Also, newsboat seems to write `now` into this field instead of Nothing
   , giAuthor :: Maybe Text
   , giBody :: Maybe Text -- Contents displayed when Enter is pressed (HTML by default)
@@ -54,7 +78,7 @@ atomItemToGeneric :: A.Entry -> GenericItem
 atomItemToGeneric e = GenericItem
   { giTitle = Just $ removeBadCharacters $ textContentToText $ A.entryTitle e
   , giURL = Just $ A.entryId e
-  , giDate = Just $ removeBadCharacters $ A.entryUpdated e
+  , giDate = parseDate $ T.unpack $ removeBadCharacters $ A.entryUpdated e
   , giAuthor = Just $ removeBadCharacters $ T.pack $ show $ A.entryAuthors e
   , giBody = entryContentToText <$> A.entryContent e
   }
@@ -63,7 +87,7 @@ rssItemToGeneric :: R.RSSItem -> GenericItem
 rssItemToGeneric e = GenericItem
   { giTitle = removeBadCharacters <$> R.rssItemTitle e
   , giURL = R.rssItemLink e
-  , giDate = removeBadCharacters <$> R.rssItemPubDate e
+  , giDate = parseDate =<< T.unpack <$> removeBadCharacters <$> R.rssItemPubDate e
   , giAuthor = removeBadCharacters <$> R.rssItemAuthor e
   , giBody = R.rssItemDescription e
   }

src/Interface.hs

@@ -7,6 +7,9 @@ import Data.Maybe
 import Data.Text () -- Instances
 import qualified Data.Text as T
 
+import Data.Time.LocalTime (TimeZone, utcToLocalTime)
+import Data.Time.Format (formatTime, defaultTimeLocale)
+
 import Control.Lens
 
 import GenericFeed
@@ -25,13 +28,16 @@ import State.Menu
 import State.Fetch
 import Interface.Actions
 
-renderContents :: GenericItem -> Widget ()
-renderContents (GenericItem {..}) =
+timeToText :: TimeZone -> MyTime -> T.Text
+timeToText z = T.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M %Z" . utcToLocalTime z . getMyTime
+
+renderContents :: TimeZone -> GenericItem -> Widget ()
+renderContents z (GenericItem {..}) =
     txtWrap $ T.unlines $ catMaybes
       [ ("Title: " <>) <$> giTitle
       , ("Link: " <>) <$> giURL
       , ("Author: " <>) <$> giAuthor
-      , ("Date: " <>) <$> giDate
+      , ("Date: " <>) <$> timeToText z <$> giDate
       , Just ""
       , f <$> giBody
       ]
@@ -41,11 +47,11 @@ renderContents (GenericItem {..}) =
       Left e -> T.pack $ show e
       Right b -> b
 
-renderItem :: Bool -> (GenericItem , ItemStatus)-> Widget ()
-renderItem _ (GenericItem {..}, r) = padRight Max $ markup
+renderItem :: TimeZone -> Bool -> (GenericItem , ItemStatus)-> Widget ()
+renderItem z _ (GenericItem {..}, r) = padRight Max $ markup
   $ (@? if r then "read-item" else "unread-item") $
       (if r then "   " else " N ")
-   <> (fromMaybe "" giDate)
+   <> (fromMaybe "" $ timeToText z <$> giDate)
    <> "  "
    <> (T.unwords $ T.words $ fromMaybe "*Empty*" giTitle)
 
@@ -84,17 +90,17 @@ helpWidget = vBox
   where
     hl = "hightlight"
 
-drawMenu :: State -> Widget ()
-drawMenu s =
+drawMenu :: TimeZone -> State -> Widget ()
+drawMenu tz s =
     if s ^. displayHelp then
       helpWidget
     else
       case s ^. menuState of
         MenuFeeds z -> g $ renderList (renderFeed $ s ^. fetchState) True $ z ^. listState . listStateFilter (feedsFilterPredicate $ s ^. menuPrefs)
-        MenuItems False is -> g $ renderList renderItem True $ is ^. liItems ^. listState ^. listStateFilter (itemsFilterPredicate $ s ^. menuPrefs)
+        MenuItems False is -> g $ renderList (renderItem tz) True $ is ^. liItems ^. listState ^. listStateFilter (itemsFilterPredicate $ s ^. menuPrefs)
         -- TODO: maybe I should split the True and False versions of MenuItems into different constructors to get
         -- rid of the fromJust on the next line. The True option must always have a non-empty zipper.
-        MenuItems True is -> f $ padBottom Max $ renderContents $ fromJust $ is ^? (liItems . mFocus . _1)
+        MenuItems True is -> f $ padBottom Max $ renderContents tz $ fromJust $ is ^? (liItems . mFocus . _1)
   where
     f x = vBox
       [ withAttr "title" $ padRight Max $ str "Title"
@@ -110,8 +116,8 @@ helpLine = border $ vLimit 1 $ padRight Max $
   <+> str " ? - help "
 
 
-draw :: State -> [Widget ()]
-draw s = [drawMenu s]
+draw :: TimeZone -> State -> [Widget ()]
+draw z s = [drawMenu z s]
 
 queueHelper :: (FilePath -> IO ()) -> FetchState -> FilePath -> IO ()
 queueHelper q s u = if fetchLookup u s == FetchStarted