Comment.hs

{-# LANGUAGE NoImplicitPrelude #-}
module Bamboo.View.Atom.Comment where

import Bamboo.Helper.StateHelper
import Bamboo.Model.Comment
import Bamboo.Type.State hiding (uid, config)
import Bamboo.View.Env hiding (title, AuthorEmail)


entry :: Comment -> Html
entry x = toHtml  
  [ gravatar
  , cite << a
  , toHtml " says:"
  , br
  , p ! [theclass "small"] << comment_date
  , x.markup
  ]
  where
    l = x.author_link
    a = if l.null then x.author.toHtml else toHtml $ hotlink formatted_link << x.author
    formatted_link = if l.starts_with "http://" then l else "http://" ++ l
    gravatar = 
      thediv ! [theclass "gravatar"] 
        << image ! [src (gravatar_link x)]
    comment_date = toHtml $ x.date.format_time "%b %e, %Y at %I:%M %p"

create :: State -> Comment -> Html
create s x = toHtml
  [ h2 ! [id "respond"] << "Leave a Response"
  , gui (s.config.root / "comment/create") ! [id "commentform"] <<
      [ field Author n22 n1 "Name (required)"
      , field AuthorEmail n22 n2 "Email (hidden)"
      , field AuthorLink n22 n3 "Website"
      , field HumanHack n22 n4 human_test_question
      , empty_field
      , hidden_field LeftNumber (s.show_left)
      , hidden_field RightNumber (s.show_right)
      , hidden_field Operator (s.show_op)
      , p << hidden (show_data PostId) (x.uid.uid_to_post_id)
      , p << textarea ! 
          [ name (show_data Body)
          , id "comment"
          , cols "10"
          , rows "20"
          , strAttr "tabindex" "5"
          ] << ""
      , p << submit "submit" "Submit Comment" ! [strAttr "tabindex" "6"]
      ]
  ]
  where
    human_test_question = 
      ["What", "is", s.show_left, s.show_op, s.show_right, "?"] .join " "

n22, n1, n2, n3, n4, n10 :: Int
n22 = 22 :: Int
n1 = 1 :: Int
n2 = 2 :: Int
n3 = 3 :: Int
n4 = 4 :: Int
n10 = 10 :: Int
      
      
field_with_value :: (Show a, Show b, Show c, HTML d) => 
  String -> a -> b -> c -> d -> Html
field_with_value v x' s t m = p <<
  [ label ! [thefor x] << small << m
  , br 
  , textfield x ! [size (s.show), strAttr "tabindex" (t.show), value v]
  ]
  where x = x'.show_data

field :: (Show a, Show b, Show c, HTML d) => a -> b -> c -> d -> Html
field x s t m = field_with_value "" x s t m

hidden_field :: (Show a) => a -> String -> Html
hidden_field x m = hidden_field_with_value m x m

hidden_field_with_value :: (Show a, HTML b) => String -> a -> b -> Html
hidden_field_with_value v x m = 
  thespan ! [ thestyle "display: none;" ] << field_with_value v x n22 n10 m

empty_field :: Html
empty_field = hidden_field_with_value "" EmptyField hidden_note
  where
    hidden_note = "Leave this field empty:"