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

removed QQ hacks from yesod-form

Browse Source
This commit is contained in:
Pascal Wittmann 2012-03-15 21:57:32 +01:00
parent 18d4b98d41
commit ba1e083edc
6 changed files with 41 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
yesod-form/Yesod/Form/Fields.hs
View File

@ -2,7 +2,6 @@
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Yesod.Form.Fields module Yesod.Form.Fields
( -- * i18n ( -- * i18n
@ -82,20 +81,6 @@ import Yesod.Core (toPathPiece, GHandler, PathPiece)
import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistQuery) import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistQuery)
import Control.Arrow ((&&&)) import Control.Arrow ((&&&))
#if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet
#define HAMLET hamlet
#define CASSIUS cassius
#define JULIUS julius
#define HTML html
#else
#define WHAMLET $whamlet
#define HAMLET $hamlet
#define CASSIUS $cassius
#define JULIUS $julius
#define HTML $html
#endif
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
defaultFormMessage :: FormMessage -> Text defaultFormMessage :: FormMessage -> Text
@ -115,7 +100,7 @@ intField = Field
_ -> Left $ MsgInvalidInteger s _ -> Left $ MsgInvalidInteger s
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="number" :isReq:required="" value="#{showVal val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="number" :isReq:required="" value="#{showVal val}">
|] |]
} }
@ -131,7 +116,7 @@ doubleField = Field
_ -> Left $ MsgInvalidNumber s _ -> Left $ MsgInvalidNumber s
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{showVal val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{showVal val}">
|] |]
} }
@ -141,7 +126,7 @@ dayField :: RenderMessage master FormMessage => Field sub master Day
dayField = Field dayField = Field
{ fieldParse = blank $ parseDate . unpack { fieldParse = blank $ parseDate . unpack
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}">
|] |]
} }
@ -151,7 +136,7 @@ timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
timeField = Field timeField = Field
{ fieldParse = blank $ parseTime . unpack { fieldParse = blank $ parseTime . unpack
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate "" theClass}" :isReq:required="" value="#{showVal val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate "" theClass}" :isReq:required="" value="#{showVal val}">
|] |]
} }
@ -167,7 +152,7 @@ htmlField = Field
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance { fieldParse = blank $ Right . preEscapedText . sanitizeBalance
, fieldView = \theId name theClass val _isReq -> addHamlet , fieldView = \theId name theClass val _isReq -> addHamlet
-- FIXME: There was a class="html" attribute, for what purpose? -- FIXME: There was a class="html" attribute, for what purpose?
[HAMLET|\ [hamlet|
<textarea id="#{theId}" name="#{name}" :not (null theClass):class=#{T.intercalate " " theClass}>#{showVal val} <textarea id="#{theId}" name="#{name}" :not (null theClass):class=#{T.intercalate " " theClass}>#{showVal val}
|] |]
} }
@ -195,7 +180,7 @@ textareaField :: RenderMessage master FormMessage => Field sub master Textarea
textareaField = Field textareaField = Field
{ fieldParse = blank $ Right . Textarea { fieldParse = blank $ Right . Textarea
, fieldView = \theId name theClass val _isReq -> addHamlet , fieldView = \theId name theClass val _isReq -> addHamlet
[HAMLET|\ [hamlet|
<textarea id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}">#{either id unTextarea val} <textarea id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}">#{either id unTextarea val}
|] |]
} }
@ -204,7 +189,7 @@ hiddenField :: RenderMessage master FormMessage => Field sub master Text
hiddenField = Field hiddenField = Field
{ fieldParse = blank $ Right { fieldParse = blank $ Right
, fieldView = \theId name theClass val _isReq -> addHamlet , fieldView = \theId name theClass val _isReq -> addHamlet
[HAMLET|\ [hamlet|
<input type="hidden" id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" value="#{either id id val}"> <input type="hidden" id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" value="#{either id id val}">
|] |]
} }
@ -213,7 +198,7 @@ textField :: RenderMessage master FormMessage => Field sub master Text
textField = Field textField = Field
{ fieldParse = blank $ Right { fieldParse = blank $ Right
, fieldView = \theId name theClass val isReq -> , fieldView = \theId name theClass val isReq ->
[WHAMLET| [whamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required value="#{either id id val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required value="#{either id id val}">
|] |]
} }
@ -222,7 +207,7 @@ passwordField :: RenderMessage master FormMessage => Field sub master Text
passwordField = Field passwordField = Field
{ fieldParse = blank $ Right { fieldParse = blank $ Right
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="password" :isReq:required="" value="#{either id id val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="password" :isReq:required="" value="#{either id id val}">
|] |]
} }
@ -272,7 +257,7 @@ emailField = Field
then Right s then Right s
else Left $ MsgInvalidEmail s else Left $ MsgInvalidEmail s
, fieldView = \theId name theClass val isReq -> addHamlet , fieldView = \theId name theClass val isReq -> addHamlet
[HAMLET|\ [hamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="email" :isReq:required="" value="#{either id id val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="email" :isReq:required="" value="#{either id id val}">
|] |]
} }
@ -282,14 +267,14 @@ searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master
searchField autoFocus = Field searchField autoFocus = Field
{ fieldParse = blank Right { fieldParse = blank Right
, fieldView = \theId name theClass val isReq -> do , fieldView = \theId name theClass val isReq -> do
[WHAMLET|\ [whamlet|
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
|] |]
when autoFocus $ do when autoFocus $ do
-- we want this javascript to be placed immediately after the field -- we want this javascript to be placed immediately after the field
[WHAMLET|\<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}</script> [whamlet|<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}</script>
|] |]
addCassius [CASSIUS| addCassius [cassius|
#{theId} #{theId}
-webkit-appearance: textfield -webkit-appearance: textfield
|] |]
@ -302,7 +287,7 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s Just _ -> Right s
, fieldView = \theId name theClass val isReq -> , fieldView = \theId name theClass val isReq ->
[WHAMLET| [whamlet|
<input ##{theId} name=#{name} :not (null theClass):class="#{T.intercalate " " theClass}" type=url :isReq:required value=#{either id id val}> <input ##{theId} name=#{name} :not (null theClass):class="#{T.intercalate " " theClass}" type=url :isReq:required value=#{either id id val}>
|] |]
} }
@ -312,9 +297,9 @@ selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
selectField = selectFieldHelper selectField = selectFieldHelper
(\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside (\theId name inside -> [whamlet|<select ##{theId} name=#{name}>^{inside}|]) -- outside
(\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt (\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
(\_theId _name theClass value isSel text -> [WHAMLET|<option value=#{value} :isSel:selected :not (null theClass):class="#{T.intercalate " " theClass}">#{text}|]) -- inside (\_theId _name theClass value isSel text -> [whamlet|<option value=#{value} :isSel:selected :not (null theClass):class="#{T.intercalate " " theClass}">#{text}|]) -- inside
multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a] multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
multiSelectFieldList = multiSelectField . optionsPairs multiSelectFieldList = multiSelectField . optionsPairs
@ -349,13 +334,13 @@ radioFieldList = radioField . optionsPairs
radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a radioField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
radioField = selectFieldHelper radioField = selectFieldHelper
(\theId _name inside -> [WHAMLET|<div ##{theId}>^{inside}|]) (\theId _name inside -> [whamlet|<div ##{theId}>^{inside}|])
(\theId name isSel -> [WHAMLET| (\theId name isSel -> [whamlet|
<div> <div>
<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked> <input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
<label for=#{theId}-none>_{MsgSelectNone} <label for=#{theId}-none>_{MsgSelectNone}
|]) |])
(\theId name theClass value isSel text -> [WHAMLET| (\theId name theClass value isSel text -> [whamlet|
<div> <div>
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :not (null theClass):class="#{T.intercalate " " theClass}"> <input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :not (null theClass):class="#{T.intercalate " " theClass}">
<label for=#{theId}-#{value}>#{text} <label for=#{theId}-#{value}>#{text}
@ -364,7 +349,7 @@ radioField = selectFieldHelper
boolField :: RenderMessage master FormMessage => Field sub master Bool boolField :: RenderMessage master FormMessage => Field sub master Bool
boolField = Field boolField = Field
{ fieldParse = return . boolParser { fieldParse = return . boolParser
, fieldView = \theId name theClass val isReq -> [WHAMLET| , fieldView = \theId name theClass val isReq -> [whamlet|
$if not isReq $if not isReq
<input id=#{theId}-none :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=none checked> <input id=#{theId}-none :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=none checked>
<label for=#{theId}-none>_{MsgSelectNone} <label for=#{theId}-none>_{MsgSelectNone}
@ -512,7 +497,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id' , fvId = id'
, fvInput = [WHAMLET| , fvInput = [whamlet|
<input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}"> <input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}">
|] |]
, fvErrors = errs , fvErrors = errs
@ -541,7 +526,7 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id' , fvId = id'
, fvInput = [WHAMLET| , fvInput = [whamlet|
<input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}"> <input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}">
|] |]
, fvErrors = errs , fvErrors = errs

17
yesod-form/Yesod/Form/Functions.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
@ -57,14 +56,6 @@ import Yesod.Message (RenderMessage (..))
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
#if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet
#define HTML shamlet
#else
#define HTML $shamlet
#define WHAMLET $whamlet
#endif
-- | Get a unique identifier. -- | Get a unique identifier.
newFormIdent :: MForm sub master Text newFormIdent :: MForm sub master Text
newFormIdent = do newFormIdent = do
@ -190,7 +181,7 @@ postHelper form env = do
let nonce = let nonce =
case reqNonce req of case reqNonce req of
Nothing -> mempty Nothing -> mempty
Just n -> [HTML|<input type=hidden name=#{nonceKey} value=#{n}>|] Just n -> [shamlet|<input type=hidden name=#{nonceKey} value=#{n}>|]
m <- getYesod m <- getYesod
langs <- languages langs <- languages
((res, xml), enctype) <- runFormGeneric (form nonce) m langs env ((res, xml), enctype) <- runFormGeneric (form nonce) m langs env
@ -248,7 +239,7 @@ getKey = "_hasdata"
getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
getHelper form env = do getHelper form env = do
let fragment = [HTML|<input type=hidden name=#{getKey}>|] let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
langs <- languages langs <- languages
m <- getYesod m <- getYesod
runFormGeneric (form fragment) m langs env runFormGeneric (form fragment) m langs env
@ -263,7 +254,7 @@ renderTable aform fragment = do
(res, views') <- aFormToForm aform (res, views') <- aFormToForm aform
let views = views' [] let views = views' []
-- FIXME non-valid HTML -- FIXME non-valid HTML
let widget = [WHAMLET| let widget = [whamlet|
\#{fragment} \#{fragment}
$forall view <- views $forall view <- views
<tr :fvRequired view:.required :not $ fvRequired view:.optional> <tr :fvRequired view:.required :not $ fvRequired view:.optional>
@ -280,7 +271,7 @@ $forall view <- views
renderDivs aform fragment = do renderDivs aform fragment = do
(res, views') <- aFormToForm aform (res, views') <- aFormToForm aform
let views = views' [] let views = views' []
let widget = [WHAMLET| let widget = [whamlet|
\#{fragment} \#{fragment}
$forall view <- views $forall view <- views
<div :fvRequired view:.required :not $ fvRequired view:.optional> <div :fvRequired view:.required :not $ fvRequired view:.optional>

21
yesod-form/Yesod/Form/Jquery.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove {-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove
-- | Some fields spiced up with jQuery UI. -- | Some fields spiced up with jQuery UI.
@ -27,18 +26,6 @@ import Data.Text (Text, pack, unpack)
import Data.Monoid (mconcat) import Data.Monoid (mconcat)
import Yesod.Core (RenderMessage, SomeMessage (..)) import Yesod.Core (RenderMessage, SomeMessage (..))
#if __GLASGOW_HASKELL__ >= 700
#define HTML shamlet
#define HAMLET hamlet
#define CASSIUS cassius
#define JULIUS julius
#else
#define HTML $shamlet
#define HAMLET $hamlet
#define CASSIUS $cassius
#define JULIUS $julius
#endif
-- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme. -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme.
googleHostedJqueryUiCss :: Text -> Text googleHostedJqueryUiCss :: Text -> Text
googleHostedJqueryUiCss theme = mconcat googleHostedJqueryUiCss theme = mconcat
@ -77,13 +64,13 @@ jqueryDayField jds = Field
. readMay . readMay
. unpack . unpack
, fieldView = \theId name theClass val isReq -> do , fieldView = \theId name theClass val isReq -> do
addHtml [HTML|\ addHtml [shamlet|\
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}"> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="date" :isReq:required="" value="#{showVal val}">
|] |]
addScript' urlJqueryJs addScript' urlJqueryJs
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss addStylesheet' urlJqueryUiCss
addJulius [JULIUS| addJulius [julius|
$(function(){ $(function(){
var i = $("##{theId}"); var i = $("##{theId}");
if (i.attr("type") != "date") { if (i.attr("type") != "date") {
@ -116,13 +103,13 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
jqueryAutocompleteField src = Field jqueryAutocompleteField src = Field
{ fieldParse = blank $ Right { fieldParse = blank $ Right
, fieldView = \theId name theClass val isReq -> do , fieldView = \theId name theClass val isReq -> do
addHtml [HTML|\ addHtml [shamlet|\
<input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete> <input id="#{theId}" name="#{name}" :not (null theClass):class="#{T.intercalate " " theClass}" type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|] |]
addScript' urlJqueryJs addScript' urlJqueryJs
addScript' urlJqueryUiJs addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss addStylesheet' urlJqueryUiCss
addJulius [JULIUS| addJulius [julius|
$(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})}); $(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
|] |]
} }

17
yesod-form/Yesod/Form/MassInput.hs
View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
@ -26,14 +25,6 @@ import Data.Traversable (sequenceA)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
#if __GLASGOW_HASKELL__ >= 700
#define WHAMLET whamlet
#define HTML html
#else
#define HTML $html
#define WHAMLET $whamlet
#endif
down :: Int -> MForm sub master () down :: Int -> MForm sub master ()
down 0 = return () down 0 = return ()
down i | i < 0 = error "called down with a negative number" down i | i < 0 = error "called down with a negative number"
@ -82,7 +73,7 @@ inputList label fixXml single mdef = formToAForm $ do
{ fvLabel = label { fvLabel = label
, fvTooltip = Nothing , fvTooltip = Nothing
, fvId = theId , fvId = theId
, fvInput = [WHAMLET| , fvInput = [whamlet|
^{fixXml views} ^{fixXml views}
<p> <p>
$forall xml <- xmls $forall xml <- xmls
@ -103,7 +94,7 @@ withDelete af = do
deleteName <- newFormIdent deleteName <- newFormIdent
(menv, _, _) <- ask (menv, _, _) <- ask
res <- case menv >>= Map.lookup deleteName . fst of res <- case menv >>= Map.lookup deleteName . fst of
Just ("yes":_) -> return $ Left [WHAMLET|<input type=hidden name=#{deleteName} value=yes>|] Just ("yes":_) -> return $ Left [whamlet|<input type=hidden name=#{deleteName} value=yes>|]
_ -> do _ -> do
(_, xml2) <- aFormToForm $ areq boolField FieldSettings (_, xml2) <- aFormToForm $ areq boolField FieldSettings
{ fsLabel = MsgDelete { fsLabel = MsgDelete
@ -129,7 +120,7 @@ fixme eithers =
massDivs, massTable massDivs, massTable
:: [[FieldView sub master]] :: [[FieldView sub master]]
-> GWidget sub master () -> GWidget sub master ()
massDivs viewss = [WHAMLET| massDivs viewss = [whamlet|
$forall views <- viewss $forall views <- viewss
<fieldset> <fieldset>
$forall view <- views $forall view <- views
@ -142,7 +133,7 @@ $forall views <- viewss
<div .errors>#{err} <div .errors>#{err}
|] |]
massTable viewss = [WHAMLET| massTable viewss = [whamlet|
$forall views <- viewss $forall views <- viewss
<fieldset> <fieldset>
<table> <table>

22
yesod-form/Yesod/Form/Nic.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove {-# LANGUAGE NoMonomorphismRestriction #-} -- FIXME remove
-- | Provide the user with a rich text editor. -- | Provide the user with a rich text editor.
@ -32,32 +31,17 @@ nicHtmlField :: YesodNic master => Field sub master Html
nicHtmlField = Field nicHtmlField = Field
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe { fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
, fieldView = \theId name theClass val _isReq -> do , fieldView = \theId name theClass val _isReq -> do
addHtml addHtml [shamlet|
#if __GLASGOW_HASKELL__ >= 700
[shamlet|
#else
[$shamlet|
#endif
<textarea id="#{theId}" :not (null theClass):class="#{T.intercalate " " theClass}" name="#{name}" .html>#{showVal val} <textarea id="#{theId}" :not (null theClass):class="#{T.intercalate " " theClass}" name="#{name}" .html>#{showVal val}
|] |]
addScript' urlNicEdit addScript' urlNicEdit
master <- lift getYesod master <- lift getYesod
addJulius $ addJulius $
case jsLoader master of case jsLoader master of
BottomOfHeadBlocking -> BottomOfHeadBlocking -> [julius|
#if __GLASGOW_HASKELL__ >= 700
[julius|
#else
[$julius|
#endif
bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")}); bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")});
|] |]
_ -> _ -> [julius|
#if __GLASGOW_HASKELL__ >= 700
[julius|
#else
[$julius|
#endif
(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")})(); (function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")})();
|] |]
} }

26
yesod-form/Yesod/Helpers/Crud.hs
View File

@ -4,7 +4,6 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Yesod.Helpers.Crud module Yesod.Helpers.Crud
( Item (..) ( Item (..)
, Crud (..) , Crud (..)
@ -41,11 +40,7 @@ mkYesodSub "Crud master item"
, ClassP ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")] , ClassP ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")]
, ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"] , ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"]
] ]
#if __GLASGOW_HASKELL__ >= 700
[parseRoutes| [parseRoutes|
#else
[$parseRoutes|
#endif
/ CrudListR GET / CrudListR GET
/add CrudAddR GET POST /add CrudAddR GET POST
/edit/#Text CrudEditR GET POST /edit/#Text CrudEditR GET POST
@ -59,12 +54,7 @@ getCrudListR = do
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
defaultLayout $ do defaultLayout $ do
setTitle "Items" setTitle "Items"
addWidget addWidget [hamlet|
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
<h1>Items <h1>Items
<ul> <ul>
$forall item <- items $forall item <- items
@ -124,12 +114,7 @@ getCrudDeleteR s = do
toMaster <- getRouteToMaster toMaster <- getRouteToMaster
defaultLayout $ do defaultLayout $ do
setTitle "Confirm delete" setTitle "Confirm delete"
addWidget addWidget [hamlet|
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
<form method="post" action="@{toMaster (CrudDeleteR s)}"> <form method="post" action="@{toMaster (CrudDeleteR s)}">
<h1>Really delete? <h1>Really delete?
<p>Do you really want to delete #{itemTitle item}? <p>Do you really want to delete #{itemTitle item}?
@ -168,12 +153,7 @@ crudHelper title me isPost = do
_ -> return () _ -> return ()
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml title setTitle $ toHtml title
addWidget addWidget [hamlet|
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
<p> <p>
<a href="@{toMaster CrudListR}">Return to list <a href="@{toMaster CrudListR}">Return to list
<h1>#{title} <h1>#{title}