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 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 ((<$>))
defaultFormMessage :: FormMessage -> Text
@ -115,7 +101,7 @@ intField = Field
_ -> Left $ MsgInvalidInteger s
, 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}">
|]
}
@ -131,7 +117,7 @@ doubleField = Field
_ -> Left $ MsgInvalidNumber s
, 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}">
|]
}
@ -141,7 +127,7 @@ dayField :: RenderMessage master FormMessage => Field sub master Day
dayField = Field
{ fieldParse = blank $ parseDate . unpack
, 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}">
|]
}
@ -151,7 +137,7 @@ timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
timeField = Field
{ fieldParse = blank $ parseTime . unpack
, 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}">
|]
}
@ -167,7 +153,7 @@ htmlField = Field
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance
, fieldView = \theId name theClass val _isReq -> addHamlet
-- 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}
|]
}
@ -195,7 +181,7 @@ textareaField :: RenderMessage master FormMessage => Field sub master Textarea
textareaField = Field
{ fieldParse = blank $ Right . Textarea
, 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}
|]
}
@ -204,7 +190,7 @@ hiddenField :: RenderMessage master FormMessage => Field sub master Text
hiddenField = Field
{ fieldParse = blank $ Right
, 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}">
|]
}
@ -213,7 +199,7 @@ textField :: RenderMessage master FormMessage => Field sub master Text
textField = Field
{ fieldParse = blank $ Right
, 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}">
|]
}
@ -222,7 +208,7 @@ passwordField :: RenderMessage master FormMessage => Field sub master Text
passwordField = Field
{ fieldParse = blank $ Right
, 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}">
|]
}
@ -272,7 +258,7 @@ emailField = Field
then Right s
else Left $ MsgInvalidEmail s
, 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}">
|]
}
@ -282,12 +268,12 @@ searchField :: RenderMessage master FormMessage => AutoFocus -> Field sub master
searchField autoFocus = Field
{ fieldParse = blank Right
, 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}">
|]
when autoFocus $ do
-- 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|
#{theId}
@ -302,7 +288,7 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s
, 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}>
|]
}
@ -312,9 +298,9 @@ selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
selectField = selectFieldHelper
(\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
(\_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 inside -> [whamlet|<select ##{theId} name=#{name}>^{inside}|]) -- outside
(\_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
multiSelectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master [a]
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 = selectFieldHelper
(\theId _name inside -> [WHAMLET|<div ##{theId}>^{inside}|])
(\theId name isSel -> [WHAMLET|
(\theId _name inside -> [whamlet|<div ##{theId}>^{inside}|])
(\theId name isSel -> [whamlet|
<div>
<input id=#{theId}-none type=radio name=#{name} value=none :isSel:checked>
<label for=#{theId}-none>_{MsgSelectNone}
|])
(\theId name theClass value isSel text -> [WHAMLET|
(\theId name theClass value isSel text -> [whamlet|
<div>
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked :not (null theClass):class="#{T.intercalate " " theClass}">
<label for=#{theId}-#{value}>#{text}
@ -364,7 +350,7 @@ radioField = selectFieldHelper
boolField :: RenderMessage master FormMessage => Field sub master Bool
boolField = Field
{ fieldParse = return . boolParser
, fieldView = \theId name theClass val isReq -> [WHAMLET|
, fieldView = \theId name theClass val isReq -> [whamlet|
$if not isReq
<input id=#{theId}-none :not (null theClass):class="#{T.intercalate " " theClass}" type=radio name=#{name} value=none checked>
<label for=#{theId}-none>_{MsgSelectNone}
@ -512,7 +498,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id'
, fvInput = [WHAMLET|
, fvInput = [whamlet|
<input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}">
|]
, fvErrors = errs
@ -541,7 +527,7 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage master langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
, fvId = id'
, fvInput = [WHAMLET|
, fvInput = [whamlet|
<input type=file name=#{name} ##{id'} :not (null theClass):class="#{T.intercalate " " theClass}">
|]
, 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.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.
newFormIdent :: MForm sub master Text
newFormIdent = do
@ -190,7 +182,7 @@ postHelper form env = do
let nonce =
case reqNonce req of
Nothing -> mempty
Just n -> [HTML|<input type=hidden name=#{nonceKey} value=#{n}>|]
Just n -> [shamlet|<input type=hidden name=#{nonceKey} value=#{n}>|]
m <- getYesod
langs <- languages
((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 form env = do
let fragment = [HTML|<input type=hidden name=#{getKey}>|]
let fragment = [shamlet|<input type=hidden name=#{getKey}>|]
langs <- languages
m <- getYesod
runFormGeneric (form fragment) m langs env
@ -262,8 +254,8 @@ renderTable, renderDivs :: FormRender sub master a
renderTable aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
-- FIXME non-valid HTML
let widget = [WHAMLET|
-- FIXME non-valid shamlet
let widget = [whamlet|
\#{fragment}
$forall view <- views
<tr :fvRequired view:.required :not $ fvRequired view:.optional>
@ -280,7 +272,7 @@ $forall view <- views
renderDivs aform fragment = do
(res, views') <- aFormToForm aform
let views = views' []
let widget = [WHAMLET|
let widget = [whamlet|
\#{fragment}
$forall view <- views
<div :fvRequired view:.required :not $ fvRequired view:.optional>
@ -293,7 +285,7 @@ $forall view <- views
|]
return (res, widget)
-- | Render a form using Bootstrap-friendly HTML syntax.
-- | Render a form using Bootstrap-friendly shamlet syntax.
--
-- 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 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.
googleHostedJqueryUiCss :: Text -> Text
googleHostedJqueryUiCss theme = mconcat
@ -77,13 +65,13 @@ jqueryDayField jds = Field
. readMay
. unpack
, 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}">
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
addJulius [julius|
$(function(){
var i = $("##{theId}");
if (i.attr("type") != "date") {
@ -116,13 +104,13 @@ jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master
jqueryAutocompleteField src = Field
{ fieldParse = blank $ Right
, 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>
|]
addScript' urlJqueryJs
addScript' urlJqueryUiJs
addStylesheet' urlJqueryUiCss
addJulius [JULIUS|
addJulius [julius|
$(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 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 0 = return ()
down i | i < 0 = error "called down with a negative number"
@ -82,7 +74,7 @@ inputList label fixXml single mdef = formToAForm $ do
{ fvLabel = label
, fvTooltip = Nothing
, fvId = theId
, fvInput = [WHAMLET|
, fvInput = [whamlet|
^{fixXml views}
<p>
$forall xml <- xmls
@ -103,7 +95,7 @@ withDelete af = do
deleteName <- newFormIdent
(menv, _, _) <- ask
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
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
{ fsLabel = MsgDelete
@ -129,7 +121,7 @@ fixme eithers =
massDivs, massTable
:: [[FieldView sub master]]
-> GWidget sub master ()
massDivs viewss = [WHAMLET|
massDivs viewss = [whamlet|
$forall views <- viewss
<fieldset>
$forall view <- views
@ -142,7 +134,7 @@ $forall views <- viewss
<div .errors>#{err}
|]
massTable viewss = [WHAMLET|
massTable viewss = [whamlet|
$forall views <- viewss
<fieldset>
<table>

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

@ -32,32 +32,17 @@ nicHtmlField :: YesodNic master => Field sub master Html
nicHtmlField = Field
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
, fieldView = \theId name theClass val _isReq -> do
addHtml
#if __GLASGOW_HASKELL__ >= 700
[shamlet|
#else
[$shamlet|
#endif
addHtml [shamlet|
<textarea id="#{theId}" :not (null theClass):class="#{T.intercalate " " theClass}" name="#{name}" .html>#{showVal val}
|]
addScript' urlNicEdit
master <- lift getYesod
addJulius $
case jsLoader master of
BottomOfHeadBlocking ->
#if __GLASGOW_HASKELL__ >= 700
[julius|
#else
[$julius|
#endif
BottomOfHeadBlocking -> [julius|
bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{theId}")});
|]
_ ->
#if __GLASGOW_HASKELL__ >= 700
[julius|
#else
[$julius|
#endif
_ -> [julius|
(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 ''SinglePiece [ConT ''Key `AppT` VarT (mkName "item")]
, ClassP ''ToForm [VarT $ mkName "item", VarT $ mkName "master"]
]
#if __GLASGOW_HASKELL__ >= 700
[parseRoutes|
#else
[$parseRoutes|
#endif
] [parseRoutes|
/ CrudListR GET
/add CrudAddR GET POST
/edit/#Text CrudEditR GET POST
@ -59,12 +54,7 @@ getCrudListR = do
toMaster <- getRouteToMaster
defaultLayout $ do
setTitle "Items"
addWidget
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
addWidget [hamlet|
<h1>Items
<ul>
$forall item <- items
@ -124,12 +114,7 @@ getCrudDeleteR s = do
toMaster <- getRouteToMaster
defaultLayout $ do
setTitle "Confirm delete"
addWidget
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
addWidget [hamlet|
<form method="post" action="@{toMaster (CrudDeleteR s)}">
<h1>Really delete?
<p>Do you really want to delete #{itemTitle item}?
@ -168,12 +153,7 @@ crudHelper title me isPost = do
_ -> return ()
defaultLayout $ do
setTitle $ toHtml title
addWidget
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
addWidget [hamlet|
<p>
<a href="@{toMaster CrudListR}">Return to list
<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
template :: Feed url -> HtmlUrl url
template arg =
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
template arg = [xhamlet|
\<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom"
<title>#{feedTitle arg}
@ -55,12 +50,7 @@ template arg =
|]
entryTemplate :: FeedEntry url -> HtmlUrl url
entryTemplate arg =
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
entryTemplate arg = [xhamlet|
<entry
<id>@{feedEntryLink arg}
<link href=@{feedEntryLink arg}
@ -76,11 +66,6 @@ entryTemplate arg =
atomLink :: Route m
-> Text -- ^ title
-> GWidget s m ()
atomLink r title = addHamletHead
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
atomLink r title = addHamletHead [hamlet|
<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
template :: Feed url -> HtmlUrl url
template arg =
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
template arg = [xhamlet|
\<?xml version="1.0" encoding="utf-8"?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom"
<channel
@ -55,12 +50,7 @@ template arg =
|]
entryTemplate :: FeedEntry url -> HtmlUrl url
entryTemplate arg =
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
entryTemplate arg = [xhamlet|
<item
<title> #{feedEntryTitle arg}
<link> @{feedEntryLink arg}
@ -73,11 +63,6 @@ entryTemplate arg =
rssLink :: Route m
-> Text -- ^ title
-> GWidget s m ()
rssLink r title = addHamletHead
#if __GLASGOW_HASKELL__ >= 700
[hamlet|
#else
[$hamlet|
#endif
rssLink r title = addHamletHead [hamlet|
<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 urls =
#if __GLASGOW_HASKELL__ >= 700
[xhamlet|
#else
[$xhamlet|
#endif
template urls = [xhamlet|
<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9">
$forall url <- urls
<url>

7
yesod/Scaffolding/Scaffolder.hs
View File

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