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

Remove some QQ hacks #288

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-12 08:48:01 +02:00
parent 320b71d3ac
commit b5f2e4863d
10 changed files with 50 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -82,20 +82,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 +101,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 +117,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 +127,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 +137,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 +153,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 +181,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 +190,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 +199,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 +208,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 +258,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,12 +268,12 @@ 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}
@ -302,7 +288,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 +298,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 +335,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 +350,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 +498,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 +527,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

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

@ -57,14 +57,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 +182,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 +240,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
@ -262,8 +254,8 @@ renderTable, renderDivs :: FormRender sub master a
renderTable aform fragment = do 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 shamlet
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 +272,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>
@ -293,7 +285,7 @@ $forall view <- views
|] |]
return (res, widget) return (res, widget)
-- | Render a form using Bootstrap-friendly HTML syntax. -- | Render a form using Bootstrap-friendly shamlet syntax.
-- --
-- Sample Hamlet: -- Sample Hamlet:
-- --

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

@ -27,18 +27,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 +65,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 +104,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})});
|] |]
} }

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

@ -26,14 +26,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 +74,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 +95,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 +121,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 +134,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>

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

@ -32,32 +32,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}")})();
|] |]
} }

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

@ -40,12 +40,7 @@ mkYesodSub "Crud master item"
[ ClassP ''Item [VarT $ mkName "item"] [ ClassP ''Item [VarT $ mkName "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"]
] ] [parseRoutes|
#if __GLASGOW_HASKELL__ >= 700
[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}

21
yesod-newsfeed/Yesod/AtomFeed.hs
View File

@ -37,12 +37,7 @@ atomFeed :: Feed (Route master) -> GHandler sub master RepAtom
atomFeed = liftM RepAtom . hamletToContent . template atomFeed = liftM RepAtom . hamletToContent . template
template :: Feed url -> HtmlUrl url template :: Feed url -> HtmlUrl url
template arg = template arg = [xhamlet|
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
\<?xml version="1.0" encoding="utf-8"?> \<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom" <feed xmlns="http://www.w3.org/2005/Atom"
<title>#{feedTitle arg} <title>#{feedTitle arg}
@ -55,12 +50,7 @@ template arg =
|] |]
entryTemplate :: FeedEntry url -> HtmlUrl url entryTemplate :: FeedEntry url -> HtmlUrl url
entryTemplate arg = entryTemplate arg = [xhamlet|
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
<entry <entry
<id>@{feedEntryLink arg} <id>@{feedEntryLink arg}
<link href=@{feedEntryLink arg} <link href=@{feedEntryLink arg}
@ -76,11 +66,6 @@ entryTemplate arg =
atomLink :: Route m atomLink :: Route m
-> Text -- ^ title -> Text -- ^ title
-> GWidget s m () -> GWidget s m ()
atomLink r title = addHamletHead atomLink r title = addHamletHead [hamlet|
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title} <link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}
|] |]

21
yesod-newsfeed/Yesod/RssFeed.hs
View File

@ -34,12 +34,7 @@ rssFeed :: Feed (Route master) -> GHandler sub master RepRss
rssFeed = liftM RepRss . hamletToContent . template rssFeed = liftM RepRss . hamletToContent . template
template :: Feed url -> HtmlUrl url template :: Feed url -> HtmlUrl url
template arg = template arg = [xhamlet|
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
\<?xml version="1.0" encoding="utf-8"?> \<?xml version="1.0" encoding="utf-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom" <rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"
<channel <channel
@ -55,12 +50,7 @@ template arg =
|] |]
entryTemplate :: FeedEntry url -> HtmlUrl url entryTemplate :: FeedEntry url -> HtmlUrl url
entryTemplate arg = entryTemplate arg = [xhamlet|
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
<item <item
<title> #{feedEntryTitle arg} <title> #{feedEntryTitle arg}
<link> @{feedEntryLink arg} <link> @{feedEntryLink arg}
@ -73,11 +63,6 @@ entryTemplate arg =
rssLink :: Route m rssLink :: Route m
-> Text -- ^ title -> Text -- ^ title
-> GWidget s m () -> GWidget s m ()
rssLink r title = addHamletHead rssLink r title = addHamletHead [hamlet|
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title} <link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}
|] |]

7
yesod-sitemap/Yesod/Sitemap.hs
View File

@ -57,12 +57,7 @@ data SitemapUrl url = SitemapUrl
} }
template :: [SitemapUrl url] -> HtmlUrl url template :: [SitemapUrl url] -> HtmlUrl url
template urls = template urls = [xhamlet|
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9"> <urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9">
$forall url <- urls $forall url <- urls
<url> <url>

7
yesod/Scaffolding/Scaffolder.hs
View File

@ -26,13 +26,6 @@ prompt f = do
hFlush stdout hFlush stdout
prompt f prompt f
qq :: String
#if __GLASGOW_HASKELL__ >= 700
qq = ""
#else
qq = "$"
#endif
data Backend = Sqlite | Postgresql | Mysql | MongoDB | Tiny data Backend = Sqlite | Postgresql | Mysql | MongoDB | Tiny
deriving (Eq, Read, Show, Enum, Bounded) deriving (Eq, Read, Show, Enum, Bounded)