diff --git a/Yesod/Form.hs b/Yesod/Form.hs index 1de50d89..eb34510c 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -16,6 +16,9 @@ module Yesod.Form , Enctype (..) , FieldInfo (..) , FieldProfile (..) + -- * Newtype wrappers + , JqueryDay (..) + , NicHtml (..) -- * Unwrapping functions , runFormGet , runFormPost @@ -59,7 +62,7 @@ import Control.Monad ((<=<), liftM, join) import Data.Monoid (Monoid (..)) import Control.Monad.Trans.State import Language.Haskell.TH.Syntax -import Database.Persist.Base (EntityDef (..)) +import Database.Persist.Base (EntityDef (..), PersistField) import Data.Char (toUpper, isUpper) import Data.Int (Int64) import qualified Data.ByteString.Lazy.UTF8 as U @@ -268,6 +271,23 @@ dayField = FieldProfile , fpRender = show , fpHamlet = \name val isReq -> [$hamlet| %input#$$!name=$$!type=date!:isReq:required!value=$$ +|] + , fpWidget = const $ return () + } +instance IsFormField Day where + toFormField = requiredField dayField +instance IsFormField (Maybe Day) where + toFormField = optionalField dayField + +jqueryDayField :: FieldProfile sub y JqueryDay +jqueryDayField = dayField + { fpParse = maybe + (Left "Invalid day, must be in YYYY-MM-DD format") + (Right . JqueryDay) + . readMay + , fpRender = show . unJqueryDay + , fpHamlet = \name val isReq -> [$hamlet| +%input#$$!name=$$!type=date!:isReq:required!value=$$ |] , fpWidget = \name -> do addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js" @@ -275,10 +295,15 @@ dayField = FieldProfile addStylesheetRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css" addHead [$hamlet|%script $$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})})|] } -instance IsFormField Day where - toFormField = requiredField dayField -instance IsFormField (Maybe Day) where - toFormField = optionalField dayField + +-- | A newtype wrapper around 'Day', using jQuery UI date picker for the +-- 'IsFormField' instance. +newtype JqueryDay = JqueryDay { unJqueryDay :: Day } + deriving PersistField +instance IsFormField JqueryDay where + toFormField = requiredField jqueryDayField +instance IsFormField (Maybe JqueryDay) where + toFormField = optionalField jqueryDayField parseTime :: String -> Either String TimeOfDay parseTime (h2:':':m1:m2:[]) = parseTimeHelper ['0', h2, m1, m2, '0', '0'] @@ -350,15 +375,32 @@ htmlField = FieldProfile , fpHamlet = \name val _isReq -> [$hamlet| %textarea.html#$$!name=$$ $$ |] - , fpWidget = \name -> do - addScriptRemote "http://js.nicedit.com/nicEdit-latest.js" - addHead [$hamlet|%script bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")})|] + , fpWidget = const $ return () } instance IsFormField (Html ()) where toFormField = requiredField htmlField instance IsFormField (Maybe (Html ())) where toFormField = optionalField htmlField +newtype NicHtml = NicHtml { unNicHtml :: Html () } + deriving PersistField + +nicHtmlField :: FieldProfile sub y NicHtml +nicHtmlField = FieldProfile + { fpParse = Right . NicHtml . preEscapedString + , fpRender = U.toString . renderHtml . unNicHtml + , fpHamlet = \name val _isReq -> [$hamlet| +%textarea.html#$$!name=$$ $$ +|] + , fpWidget = \name -> do + addScriptRemote "http://js.nicedit.com/nicEdit-latest.js" + addHead [$hamlet|%script bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("$name$")})|] + } +instance IsFormField NicHtml where + toFormField = requiredField nicHtmlField +instance IsFormField (Maybe NicHtml) where + toFormField = optionalField nicHtmlField + readMay :: Read a => String -> Maybe a readMay s = case reads s of (x, _):_ -> Just x diff --git a/blog.hs b/blog.hs index 24d7c974..10c8c387 100644 --- a/blog.hs +++ b/blog.hs @@ -5,12 +5,11 @@ import Yesod.Helpers.Crud import Database.Persist.Sqlite import Data.Time (Day) -type Html' = Html () share2 mkPersist mkIsForm [$persist| Entry title String "label=Entry title" "tooltip=Make it something cool" - posted Day Desc - content Html' + posted JqueryDay Desc + content NicHtml deriving |] instance Item Entry where @@ -101,8 +100,8 @@ getEntryR eid = do setTitle $ string $ entryTitle entry addBody [$hamlet| %h1 $entryTitle.entry$ -%h2 $show.entryPosted.entry$ -#content $$ +%h2 $show.unJqueryDay.entryPosted.entry$ +#content $$ |] main = withSqlite "blog.db3" $ \conn -> do flip runSqlite conn $ initialize (undefined :: Entry)