haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Autocomplete form widget

Browse Source
This commit is contained in:
Michael Snoyman 2010-07-06 22:36:20 +03:00
parent 5d8ee5e7fb
commit 5354c03a2c
3 changed files with 42 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Yesod/Form.hs
View File

@ -38,6 +38,7 @@ module Yesod.Form
, stringFieldProfile
, intFieldProfile
, dayFieldProfile
, jqueryDayFieldProfile
, timeFieldProfile
, htmlFieldProfile
-- * Pre-built fields
@ -56,6 +57,7 @@ module Yesod.Form
, selectField
, maybeSelectField
, boolField
, jqueryAutocompleteField
-- * Pre-built inputs
, stringInput
, maybeStringInput
@ -675,3 +677,20 @@ toLabel (x:rest) = toUpper x : go rest
go (c:cs)
| isUpper c = ' ' : c : go cs
| otherwise = c : go cs
jqueryAutocompleteField src = requiredFieldHelper
$ jqueryAutocompleteFieldProfile src
jqueryAutocompleteFieldProfile :: Route y -> FieldProfile sub y String
jqueryAutocompleteFieldProfile src = FieldProfile
{ fpParse = Right
, fpRender = id
, fpHamlet = \name val isReq -> [$hamlet|
%input.autocomplete#$name$!name=$name$!type=text!:isReq:required!value=$val$
|]
, fpWidget = \name -> do
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
addStylesheetRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
addHead [$hamlet|%script $$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})});|]
}

1
Yesod/Widget.hs
View File

@ -25,6 +25,7 @@ module Yesod.Widget
, extractBody
) where
-- FIXME add support for script contents
import Data.List (nub)
import Data.Monoid
import Control.Monad.Trans.Writer

31
hellowidget.hs
View File

@ -9,6 +9,7 @@ mkYesod "HW" [$parseRoutes|
/ RootR GET
/form FormR
/static StaticR Static hwStatic
/autocomplete AutoCompleteR GET
|]
instance Yesod HW where approot _ = ""
wrapper h = [$hamlet|
@ -33,18 +34,21 @@ getRootR = applyLayoutW $ flip wrapWidget wrapper $ do
|]
addHead [$hamlet|%meta!keywords=haskell|]
-- FIXME add coolness to day and html below
handleFormR = do
(res, form, enctype) <- runFormPost $ (,,,,,,)
<$> requiredField stringField (string "My Field") (string "Some tooltip info") Nothing
<*> requiredField stringField (string "Another field") (string "") (Just "some default text")
<*> requiredField intField (string "A number field") (string "some nums") (Just 5)
<*> requiredField dayField (string "A day field") (string "") Nothing
<*> requiredField timeField (string "A time field") (string "") Nothing
(res, form, enctype) <- runFormPost $ (,,,,,,,)
<$> stringField (string "My Field") (string "Some tooltip info") Nothing
<*> stringField (string "Another field") (string "") (Just "some default text")
<*> intField (string "A number field") (string "some nums") (Just 5)
<*> dayField (string "A day field") (string "") Nothing
<*> timeField (string "A time field") (string "") Nothing
<*> boolField (string "A checkbox") (string "") (Just False)
<*> requiredField htmlField (string "HTML") (string "")
<*> jqueryAutocompleteField AutoCompleteR
(string "Autocomplete") (string "Try it!") Nothing
<*> htmlField (string "HTML") (string "")
(Just $ string "You can put rich text here")
let mhtml = case res of
FormSuccess (_, _, _, _, _, _, x) -> Just x
FormSuccess (_, _, _, _, _, _, _, x) -> Just x
_ -> Nothing
applyLayoutW $ do
addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|]
@ -56,8 +60,17 @@ handleFormR = do
%td!colspan=2
%input!type=submit
$maybe mhtml html
$<html>$
$html$
|]
setTitle $ string "Form"
main = toWaiApp (HW $ fileLookupDir "static" typeByExt) >>= basicHandler 3000
getAutoCompleteR :: Handler HW RepJson
getAutoCompleteR = do
term <- runFormGet' $ stringInput "term"
jsonToRepJson $ jsonList
[ jsonScalar $ string $ term ++ "foo"
, jsonScalar $ string $ term ++ "bar"
, jsonScalar $ string $ term ++ "baz"
]