{-# OPTIONS_GHC -package parsedate #-}
module Entry where

import Data.List
import Data.Time
import System.Locale
import Text.XHtml.Strict

import Data.Time.Parse ()


-- * Types

type Feed = [Entry]

type EntryID = Int

data Entry
    = Entry {
             entryID :: EntryID, -- ^ Only Nothing before the entry is saved the first time.
             entryTitle :: String,
             entryContent :: String,
             entryPublished :: ZonedTime,
             entryUpdated :: ZonedTime,
             entryAuthor :: Person
            }
      deriving (Show,Read)

data Person = Person {
                      personName :: String,
                      personURL :: URL,
                      personEMail :: String
                     }
            deriving (Show,Read)


-- * HTML

feed :: [Entry] -> Html
feed es = divc "hfeed" << map hentry es

-- A partial implementation of the hAtom microformat,
-- http://microformats.org/wiki/hatom
hentry :: Entry -> Html
hentry e = divc "hentry" << 
               [h2 ! [theclass "entry-title"] << entryTitle e, 
                divc "entry-content" << formatContent (entryContent e),
                dlist ! [theclass "byline"] <<
                           [published,
                            datetime "updated" (entryUpdated e),
                            person "author" (entryAuthor e)]]
  where published = if entryPublished e `eqZonedTime` entryUpdated e
                      then noHtml
                      else datetime "published" (entryPublished e)
        eqZonedTime t1 t2 = zonedTimeToUTC t1 == zonedTimeToUTC t2

formatContent :: String -> Html
formatContent = 
    toHtml . map (p <<) . filter (not . null) . splitBy null . lines


-- A partial implementation of the hCard microformat,
-- http://microformats.org/wiki/hcard
person :: String -> Person -> Html
person cls (Person { personName = n, personURL = u, personEMail = e})
    = address ! [classes [cls,"vcard"]] << joinHtml [name, email]
        where 
          name | null u = spanc "fn" << n
               | True = anchor ! [classes ["fn","url"], href u] << n
          email | null e = noHtml
                | True = anchor ! [theclass "email", href ("mailto:"++e)] << e

-- The microformat datetime design pattern, 
-- see http://microformats.org/wiki/datetime-design-pattern
datetime :: String -> ZonedTime -> Html
datetime cls t = abbr ! [classes [cls, "datetime"], title md] << hd
      where md = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%z" t
            hd = formatTime defaultTimeLocale "%Y-%m-%d %H:%M %Z" t



-- * HTML utilities

divc :: String -> Html -> Html
divc c = thediv ! [theclass c]

spanc :: String -> Html -> Html
spanc c = thespan ! [theclass c]

classes :: [String] -> HtmlAttr
classes = theclass . unwords

joinHtml :: [Html] -> Html
joinHtml = concatHtml . intersperse (toHtml " ")


-- * List utilities

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy _ [] = []
splitBy f list = first : case rest of
                           []     -> []
                           [x]    -> [[]]
                           (_:xs) -> splitBy f xs
   where (first, rest) = break f list