lucienne-0.0.1: Lucienne/View/Feed.hs

module Lucienne.View.Feed
  (feed, home)
where

import           Control.Monad (when)
import           Text.Blaze ((!))
import qualified Text.Blaze.Html4.Strict as H
import qualified Text.Blaze.Html4.Strict.Attributes as A
import           Lucienne.Constant (programName)
import           Lucienne.View.Common
  (Infos,template,stringHtml,stringValue,symbol,form,hidden,button,setTitle)
import qualified Lucienne.View.Link as L
import           Lucienne.Model.Feed (Feed)
import qualified Lucienne.Model.Feed as F
import           Lucienne.Model.FeedItem (FeedItem)
import qualified Lucienne.Model.FeedItem as FI
import qualified Lucienne.Model.FeedItemState as S
import           Lucienne.Model.Util (showObjectId)
import           Lucienne.Model.User (User)
import qualified Lucienne.Model.User as U
import qualified Lucienne.Url as Url

feed :: User -> Feed -> [FeedItem] -> [Feed] -> H.Html
feed user feed fItems allFeeds =
  template (F.title feed) [] [] $ do
    H.div ! A.class_ "leftMenu" $ do
      feedsOverview (Just feed) allFeeds
      controlPanel user $ Just feed
    feedItems (Just feed) fItems

home :: User -> Infos -> [FeedItem] -> [Feed] -> H.Html
home user infos fItems allFeeds =
  template programName infos [] $ do
    H.div ! A.class_ "leftMenu" $ do
      feedsOverview Nothing allFeeds
      controlPanel user Nothing
    feedItems Nothing fItems

feedsOverview :: Maybe Feed -> [Feed] -> H.Html
feedsOverview viewed items =
  let feedLink False feed = H.li . L.toFeed feed L.Default    . stringHtml
      feedLink True  feed = H.li . L.toFeed feed L.Highlight  . stringHtml
      overview feed = case viewed of
        Nothing -> feedLink False                feed (F.title feed)
        Just v  -> feedLink (F.id v == F.id feed) feed (F.title feed)
  in
   H.ul $ do
     H.li $ L.toHome $ stringHtml "All feeds"
     mapM_ overview items

controlPanel :: User -> Maybe Feed -> H.Html
controlPanel user mFeed =
  H.ul $ do
    H.li $ L.to Url.addNewFeed     $ stringHtml "Add new feed"
    when (U.mayAddUsers user) $ H.li $ L.to Url.addNewUser $ stringHtml "Add new user"
    H.li $ L.to Url.changePassword $ stringHtml "Change password"
    H.li $ L.to Url.deleteUser     $ stringHtml "Delete user"
    case mFeed of
         Nothing   -> return ()
         Just feed -> H.li $ L.toDeleteFeed feed $ stringHtml "Delete feed"

feedItems :: Maybe Feed -> [FeedItem] -> H.Html
feedItems mFeed items =
  form Url.doChangeFeedItemState $ do
    hidden "numItems" $ show $ length items
    maybe (return ()) (hidden "feedId" . showObjectId . F.id) mFeed
    H.table $ do
      H.tr $    H.th ! A.colspan "2" ! A.class_ "feedTitle" $ header

      H.tr $ do H.td ""
                H.td $ markAsReadButton >> symbol " " >> deleteButton
      mapM_ feedItemHeader $ zip [0..] items
      H.tr $ do H.td ""
                H.td $ markAsReadButton >> symbol " " >> deleteButton
  where
    header = maybe (stringHtml programName)
             (\f -> stringHtml (F.title f) >> (L.toFeedUrl f $ symbol "↗")
             ) mFeed
    markAsReadButton = button "markAsRead" "Mark as read [r]" (Just "r")
    deleteButton     = button "delete" "Delete [d]" (Just "d")

feedItemHeader :: (Integer,FeedItem) -> H.Html
feedItemHeader (index,item) =
  H.tr $ do H.td ! A.class_ "feedItemHeaderSymbols" $ feedItemHeaderSymbols index item
            H.td $ L.toFeedItem item style !
              A.title (stringValue $ show $ FI.dateFetched item) $
              (stringHtml $ FI.title item)
  where
    style = case FI.state item of
      S.Read -> L.Inactive
      _      -> L.Active

feedItemHeaderSymbols :: Integer -> FeedItem -> H.Html
feedItemHeaderSymbols index item = do

  setTitle "Toggle mark for all older items" $ L.to runJS  $ symbol "↑"
  symbol " "

  H.input ! A.type_ "checkbox"
    ! A.name (stringValue $ "feedItem" ++ show index)
    ! A.value (stringValue $ showObjectId $ FI.id item)

  symbol " "
  symbol " "
    where
      runJS = "javascript:toggleMarkOlder (" ++ show index ++ ")"