$newline
This commit is contained in:
parent
a5361e44f2
commit
3ecbf43f5d
@ -149,7 +149,10 @@ setCreds doRedirects creds = do
|
|||||||
Nothing ->
|
Nothing ->
|
||||||
when doRedirects $ do
|
when doRedirects $ do
|
||||||
case authRoute y of
|
case authRoute y of
|
||||||
Nothing -> do rh <- defaultLayout $ toWidget [shamlet| <h1>Invalid login |]
|
Nothing -> do rh <- defaultLayout $ toWidget [shamlet|
|
||||||
|
$newline never
|
||||||
|
<h1>Invalid login
|
||||||
|
|]
|
||||||
sendResponse rh
|
sendResponse rh
|
||||||
Just ar -> do setMessageI Msg.InvalidLogin
|
Just ar -> do setMessageI Msg.InvalidLogin
|
||||||
redirect ar
|
redirect ar
|
||||||
@ -168,6 +171,7 @@ getCheckR = do
|
|||||||
where
|
where
|
||||||
html' creds =
|
html' creds =
|
||||||
[shamlet|
|
[shamlet|
|
||||||
|
$newline never
|
||||||
<h1>Authentication Status
|
<h1>Authentication Status
|
||||||
$maybe _ <- creds
|
$maybe _ <- creds
|
||||||
<p>Logged in.
|
<p>Logged in.
|
||||||
|
|||||||
@ -62,6 +62,7 @@ helper maudience = AuthPlugin
|
|||||||
, apLogin = \toMaster -> do
|
, apLogin = \toMaster -> do
|
||||||
addScriptRemote browserIdJs
|
addScriptRemote browserIdJs
|
||||||
toWidget [hamlet|
|
toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<p>
|
<p>
|
||||||
<a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});">
|
<a href="javascript:navigator.id.getVerifiedEmail(function(a){if(a)document.location='@{toMaster complete}/'+a});">
|
||||||
<img src="https://browserid.org/i/sign_in_green.png">
|
<img src="https://browserid.org/i/sign_in_green.png">
|
||||||
|
|||||||
@ -24,6 +24,7 @@ authDummy =
|
|||||||
url = PluginR "dummy" []
|
url = PluginR "dummy" []
|
||||||
login authToMaster =
|
login authToMaster =
|
||||||
toWidget [hamlet|
|
toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<form method="post" action="@{authToMaster url}">
|
<form method="post" action="@{authToMaster url}">
|
||||||
Your new identifier is: #
|
Your new identifier is: #
|
||||||
<input type="text" name="ident">
|
<input type="text" name="ident">
|
||||||
|
|||||||
@ -79,6 +79,7 @@ authEmail :: YesodAuthEmail m => AuthPlugin m
|
|||||||
authEmail =
|
authEmail =
|
||||||
AuthPlugin "email" dispatch $ \tm ->
|
AuthPlugin "email" dispatch $ \tm ->
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<form method="post" action="@{tm loginR}">
|
<form method="post" action="@{tm loginR}">
|
||||||
<table>
|
<table>
|
||||||
<tr>
|
<tr>
|
||||||
@ -112,6 +113,7 @@ getRegisterR = do
|
|||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI Msg.RegisterLong
|
setTitleI Msg.RegisterLong
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<p>_{Msg.EnterEmail}
|
<p>_{Msg.EnterEmail}
|
||||||
<form method="post" action="@{toMaster registerR}">
|
<form method="post" action="@{toMaster registerR}">
|
||||||
<label for="email">_{Msg.Email}
|
<label for="email">_{Msg.Email}
|
||||||
@ -141,7 +143,10 @@ postRegisterR = do
|
|||||||
sendVerifyEmail email verKey verUrl
|
sendVerifyEmail email verKey verUrl
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI Msg.ConfirmationEmailSentTitle
|
setTitleI Msg.ConfirmationEmailSentTitle
|
||||||
[whamlet| <p>_{Msg.ConfirmationEmailSent email} |]
|
[whamlet|
|
||||||
|
$newline never
|
||||||
|
<p>_{Msg.ConfirmationEmailSent email}
|
||||||
|
|]
|
||||||
|
|
||||||
getVerifyR :: YesodAuthEmail m
|
getVerifyR :: YesodAuthEmail m
|
||||||
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml
|
=> AuthEmailId m -> Text -> GHandler Auth m RepHtml
|
||||||
@ -161,7 +166,10 @@ getVerifyR lid key = do
|
|||||||
_ -> return ()
|
_ -> return ()
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI Msg.InvalidKey
|
setTitleI Msg.InvalidKey
|
||||||
[whamlet| <p>_{Msg.InvalidKey} |]
|
[whamlet|
|
||||||
|
$newline never
|
||||||
|
<p>_{Msg.InvalidKey}
|
||||||
|
|]
|
||||||
|
|
||||||
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
|
postLoginR :: YesodAuthEmail master => GHandler Auth master ()
|
||||||
postLoginR = do
|
postLoginR = do
|
||||||
@ -200,6 +208,7 @@ getPasswordR = do
|
|||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitleI Msg.SetPassTitle
|
setTitleI Msg.SetPassTitle
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<h3>_{Msg.SetPass}
|
<h3>_{Msg.SetPass}
|
||||||
<form method="post" action="@{toMaster setpassR}">
|
<form method="post" action="@{toMaster setpassR}">
|
||||||
<table>
|
<table>
|
||||||
|
|||||||
@ -46,7 +46,10 @@ authGoogleEmail =
|
|||||||
where
|
where
|
||||||
complete = PluginR pid ["complete"]
|
complete = PluginR pid ["complete"]
|
||||||
login tm =
|
login tm =
|
||||||
[whamlet|<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}|]
|
[whamlet|
|
||||||
|
$newline never
|
||||||
|
<a href=@{tm forwardUrl}>_{Msg.LoginGoogle}
|
||||||
|
|]
|
||||||
dispatch "GET" ["forward"] = do
|
dispatch "GET" ["forward"] = do
|
||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
|
|||||||
@ -76,7 +76,7 @@ import Yesod.Handler
|
|||||||
import Yesod.Form
|
import Yesod.Form
|
||||||
import Yesod.Auth
|
import Yesod.Auth
|
||||||
import Yesod.Widget (toWidget)
|
import Yesod.Widget (toWidget)
|
||||||
import Text.Hamlet (hamlet, shamlet)
|
import Text.Hamlet (hamlet)
|
||||||
|
|
||||||
import Control.Applicative ((<$>), (<*>))
|
import Control.Applicative ((<$>), (<*>))
|
||||||
import Control.Monad (replicateM,liftM)
|
import Control.Monad (replicateM,liftM)
|
||||||
@ -176,7 +176,7 @@ postLoginR uniq = do
|
|||||||
(validateUser <$> (uniq =<< mu) <*> mp)
|
(validateUser <$> (uniq =<< mu) <*> mp)
|
||||||
if isValid
|
if isValid
|
||||||
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
|
then setCreds True $ Creds "hashdb" (fromMaybe "" mu) []
|
||||||
else do setMessage [shamlet| Invalid username/password |]
|
else do setMessage "Invalid username/password"
|
||||||
toMaster <- getRouteToMaster
|
toMaster <- getRouteToMaster
|
||||||
redirect $ toMaster LoginR
|
redirect $ toMaster LoginR
|
||||||
|
|
||||||
@ -207,7 +207,7 @@ getAuthIdHashDB authR uniq creds = do
|
|||||||
-- user exists
|
-- user exists
|
||||||
Just (Entity uid _) -> return $ Just uid
|
Just (Entity uid _) -> return $ Just uid
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
setMessage [shamlet| User not found |]
|
setMessage "User not found"
|
||||||
redirect $ authR LoginR
|
redirect $ authR LoginR
|
||||||
|
|
||||||
-- | Prompt for username and password, validate that against a database
|
-- | Prompt for username and password, validate that against a database
|
||||||
@ -221,6 +221,7 @@ authHashDB :: ( YesodAuth m, YesodPersist m
|
|||||||
, PersistUnique b (GHandler Auth m))
|
, PersistUnique b (GHandler Auth m))
|
||||||
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
|
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
|
||||||
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
|
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<div id="header">
|
<div id="header">
|
||||||
<h1>Login
|
<h1>Login
|
||||||
|
|
||||||
|
|||||||
@ -46,6 +46,7 @@ authOpenIdExtended extensionFields =
|
|||||||
padding-left: 18px;
|
padding-left: 18px;
|
||||||
|]
|
|]
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<form method="get" action="@{tm forwardUrl}">
|
<form method="get" action="@{tm forwardUrl}">
|
||||||
<input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id">
|
<input type="hidden" name="openid_identifier" value="https://www.google.com/accounts/o8/id">
|
||||||
<button .openid-google>_{Msg.LoginGoogle}
|
<button .openid-google>_{Msg.LoginGoogle}
|
||||||
|
|||||||
@ -25,6 +25,7 @@ authRpxnow app apiKey =
|
|||||||
login tm = do
|
login tm = do
|
||||||
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
|
let url = {- FIXME urlEncode $ -} tm $ PluginR "rpxnow" []
|
||||||
toWidget [hamlet|
|
toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
|
<iframe src="http://#{app}.rpxnow.com/openid/embed?token_url=@{url}" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px">
|
||||||
|]
|
|]
|
||||||
dispatch _ [] = do
|
dispatch _ [] = do
|
||||||
|
|||||||
@ -24,7 +24,7 @@ library
|
|||||||
, text >= 0.7 && < 0.12
|
, text >= 0.7 && < 0.12
|
||||||
, mime-mail >= 0.3 && < 0.5
|
, mime-mail >= 0.3 && < 0.5
|
||||||
, yesod-persistent >= 1.1 && < 1.2
|
, yesod-persistent >= 1.1 && < 1.2
|
||||||
, hamlet >= 1.0 && < 1.1
|
, hamlet >= 1.1 && < 1.2
|
||||||
, shakespeare-css >= 1.0 && < 1.1
|
, shakespeare-css >= 1.0 && < 1.1
|
||||||
, yesod-json >= 1.1 && < 1.2
|
, yesod-json >= 1.1 && < 1.2
|
||||||
, containers
|
, containers
|
||||||
|
|||||||
@ -842,6 +842,7 @@ redirectToPost :: RedirectUrl master url => url -> GHandler sub master a
|
|||||||
redirectToPost url = do
|
redirectToPost url = do
|
||||||
urlText <- toTextUrl url
|
urlText <- toTextUrl url
|
||||||
hamletToRepHtml [hamlet|
|
hamletToRepHtml [hamlet|
|
||||||
|
$newline never
|
||||||
$doctype 5
|
$doctype 5
|
||||||
|
|
||||||
<html>
|
<html>
|
||||||
|
|||||||
@ -27,7 +27,8 @@ module Yesod.Internal
|
|||||||
, tokenKey
|
, tokenKey
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Text.Hamlet (HtmlUrl, hamlet, Html)
|
import Text.Hamlet (HtmlUrl, Html)
|
||||||
|
import Text.Blaze.Html (toHtml)
|
||||||
import Text.Julius (JavascriptUrl)
|
import Text.Julius (JavascriptUrl)
|
||||||
import Data.Monoid (Monoid (..), Last)
|
import Data.Monoid (Monoid (..), Last)
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
@ -69,10 +70,8 @@ langKey = "_LANG"
|
|||||||
data Location url = Local url | Remote Text
|
data Location url = Local url | Remote Text
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
locationToHtmlUrl :: Location url -> HtmlUrl url
|
locationToHtmlUrl :: Location url -> HtmlUrl url
|
||||||
locationToHtmlUrl (Local url) = [hamlet|\@{url}
|
locationToHtmlUrl (Local url) render = toHtml $ render url []
|
||||||
|]
|
locationToHtmlUrl (Remote s) _ = toHtml s
|
||||||
locationToHtmlUrl (Remote s) = [hamlet|\#{s}
|
|
||||||
|]
|
|
||||||
|
|
||||||
newtype UniqueList x = UniqueList ([x] -> [x])
|
newtype UniqueList x = UniqueList ([x] -> [x])
|
||||||
instance Monoid (UniqueList x) where
|
instance Monoid (UniqueList x) where
|
||||||
|
|||||||
@ -162,6 +162,7 @@ class RenderRoute a => Yesod a where
|
|||||||
p <- widgetToPageContent w
|
p <- widgetToPageContent w
|
||||||
mmsg <- getMessage
|
mmsg <- getMessage
|
||||||
hamletToRepHtml [hamlet|
|
hamletToRepHtml [hamlet|
|
||||||
|
$newline never
|
||||||
$doctype 5
|
$doctype 5
|
||||||
|
|
||||||
<html>
|
<html>
|
||||||
@ -470,18 +471,21 @@ defaultErrorHandler NotFound = do
|
|||||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||||
applyLayout' "Not Found"
|
applyLayout' "Not Found"
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
<h1>Not Found
|
<h1>Not Found
|
||||||
<p>#{path'}
|
<p>#{path'}
|
||||||
|]
|
|]
|
||||||
defaultErrorHandler (PermissionDenied msg) =
|
defaultErrorHandler (PermissionDenied msg) =
|
||||||
applyLayout' "Permission Denied"
|
applyLayout' "Permission Denied"
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
<h1>Permission denied
|
<h1>Permission denied
|
||||||
<p>#{msg}
|
<p>#{msg}
|
||||||
|]
|
|]
|
||||||
defaultErrorHandler (InvalidArgs ia) =
|
defaultErrorHandler (InvalidArgs ia) =
|
||||||
applyLayout' "Invalid Arguments"
|
applyLayout' "Invalid Arguments"
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
<h1>Invalid Arguments
|
<h1>Invalid Arguments
|
||||||
<ul>
|
<ul>
|
||||||
$forall msg <- ia
|
$forall msg <- ia
|
||||||
@ -490,12 +494,14 @@ defaultErrorHandler (InvalidArgs ia) =
|
|||||||
defaultErrorHandler (InternalError e) =
|
defaultErrorHandler (InternalError e) =
|
||||||
applyLayout' "Internal Server Error"
|
applyLayout' "Internal Server Error"
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
<h1>Internal Server Error
|
<h1>Internal Server Error
|
||||||
<p>#{e}
|
<p>#{e}
|
||||||
|]
|
|]
|
||||||
defaultErrorHandler (BadMethod m) =
|
defaultErrorHandler (BadMethod m) =
|
||||||
applyLayout' "Bad Method"
|
applyLayout' "Bad Method"
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
<h1>Method Not Supported
|
<h1>Method Not Supported
|
||||||
<p>Method "#{S8.unpack m}" not supported
|
<p>Method "#{S8.unpack m}" not supported
|
||||||
|]
|
|]
|
||||||
@ -555,6 +561,7 @@ widgetToPageContent w = do
|
|||||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||||
regularScriptLoad = [hamlet|
|
regularScriptLoad = [hamlet|
|
||||||
|
$newline never
|
||||||
$forall s <- scripts
|
$forall s <- scripts
|
||||||
^{mkScriptTag s}
|
^{mkScriptTag s}
|
||||||
$maybe j <- jscript
|
$maybe j <- jscript
|
||||||
@ -565,6 +572,7 @@ $maybe j <- jscript
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
headAll = [hamlet|
|
headAll = [hamlet|
|
||||||
|
$newline never
|
||||||
\^{head'}
|
\^{head'}
|
||||||
$forall s <- stylesheets
|
$forall s <- stylesheets
|
||||||
^{mkLinkTag s}
|
^{mkLinkTag s}
|
||||||
@ -587,6 +595,7 @@ $case jsLoader master
|
|||||||
^{regularScriptLoad}
|
^{regularScriptLoad}
|
||||||
|]
|
|]
|
||||||
let bodyScript = [hamlet|
|
let bodyScript = [hamlet|
|
||||||
|
$newline never
|
||||||
^{body}
|
^{body}
|
||||||
^{regularScriptLoad}
|
^{regularScriptLoad}
|
||||||
|]
|
|]
|
||||||
@ -633,6 +642,7 @@ jsonArray = unsafeLazyByteString . encode . Array . Vector.fromList . map String
|
|||||||
loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
|
loadJsYepnope :: Yesod master => Either Text (Route master) -> [Text] -> Maybe (HtmlUrl (Route master)) -> (HtmlUrl (Route master))
|
||||||
loadJsYepnope eyn scripts mcomplete =
|
loadJsYepnope eyn scripts mcomplete =
|
||||||
[hamlet|
|
[hamlet|
|
||||||
|
$newline never
|
||||||
$maybe yn <- left eyn
|
$maybe yn <- left eyn
|
||||||
<script src=#{yn}>
|
<script src=#{yn}>
|
||||||
$maybe yn <- right eyn
|
$maybe yn <- right eyn
|
||||||
|
|||||||
@ -31,4 +31,4 @@ runner f = toWaiApp Y >>= runSession f
|
|||||||
case_linkToHome :: IO ()
|
case_linkToHome :: IO ()
|
||||||
case_linkToHome = runner $ do
|
case_linkToHome = runner $ do
|
||||||
res <- request defaultRequest
|
res <- request defaultRequest
|
||||||
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a></body></html>" res
|
assertBody "<!DOCTYPE html>\n<html><head><title></title></head><body><a href=\"/\"></a>\n</body></html>" res
|
||||||
|
|||||||
@ -55,12 +55,13 @@ getTowidgetR = defaultLayout $ do
|
|||||||
toWidget [lucius|foo{bar:baz}|]
|
toWidget [lucius|foo{bar:baz}|]
|
||||||
toWidgetHead [lucius|foo{bar:baz}|]
|
toWidgetHead [lucius|foo{bar:baz}|]
|
||||||
|
|
||||||
toWidget [hamlet|<foo>|] :: Widget
|
toWidget [hamlet|<foo>|]
|
||||||
toWidgetHead [hamlet|<foo>|]
|
toWidgetHead [hamlet|<foo>|]
|
||||||
toWidgetBody [hamlet|<foo>|]
|
toWidgetBody [hamlet|<foo>|]
|
||||||
|
|
||||||
getWhamletR :: Handler RepHtml
|
getWhamletR :: Handler RepHtml
|
||||||
getWhamletR = defaultLayout [whamlet|
|
getWhamletR = defaultLayout [whamlet|
|
||||||
|
$newline never
|
||||||
<h1>Test
|
<h1>Test
|
||||||
<h2>@{WhamletR}
|
<h2>@{WhamletR}
|
||||||
<h3>_{Goodbye}
|
<h3>_{Goodbye}
|
||||||
@ -68,10 +69,14 @@ getWhamletR = defaultLayout [whamlet|
|
|||||||
^{embed}
|
^{embed}
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
embed = [whamlet|<h4>Embed|]
|
embed = [whamlet|
|
||||||
|
$newline never
|
||||||
|
<h4>Embed
|
||||||
|
|]
|
||||||
|
|
||||||
getAutoR :: Handler RepHtml
|
getAutoR :: Handler RepHtml
|
||||||
getAutoR = defaultLayout [whamlet|
|
getAutoR = defaultLayout [whamlet|
|
||||||
|
$newline never
|
||||||
^{someHtml}
|
^{someHtml}
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
|
|||||||
@ -55,14 +55,14 @@ library
|
|||||||
, text >= 0.7 && < 0.12
|
, text >= 0.7 && < 0.12
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, path-pieces >= 0.1 && < 0.2
|
, path-pieces >= 0.1 && < 0.2
|
||||||
, hamlet >= 1.0 && < 1.1
|
, hamlet >= 1.1 && < 1.2
|
||||||
, shakespeare >= 1.0 && < 1.1
|
, shakespeare >= 1.0 && < 1.1
|
||||||
, shakespeare-js >= 1.0 && < 1.1
|
, shakespeare-js >= 1.0 && < 1.1
|
||||||
, shakespeare-css >= 1.0 && < 1.1
|
, shakespeare-css >= 1.0 && < 1.1
|
||||||
, shakespeare-i18n >= 1.0 && < 1.1
|
, shakespeare-i18n >= 1.0 && < 1.1
|
||||||
, blaze-builder >= 0.2.1.4 && < 0.4
|
, blaze-builder >= 0.2.1.4 && < 0.4
|
||||||
, transformers >= 0.2.2 && < 0.4
|
, transformers >= 0.2.2 && < 0.4
|
||||||
, clientsession >= 0.7.3.1 && < 0.8
|
, clientsession >= 0.8 && < 0.9
|
||||||
, random >= 1.0.0.2 && < 1.1
|
, random >= 1.0.0.2 && < 1.1
|
||||||
, cereal >= 0.3 && < 0.4
|
, cereal >= 0.3 && < 0.4
|
||||||
, old-locale >= 1.0.0.2 && < 1.1
|
, old-locale >= 1.0.0.2 && < 1.1
|
||||||
|
|||||||
@ -111,6 +111,7 @@ intField = Field
|
|||||||
_ -> Left $ MsgInvalidInteger s
|
_ -> Left $ MsgInvalidInteger s
|
||||||
|
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="number" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -126,6 +127,7 @@ doubleField = Field
|
|||||||
_ -> Left $ MsgInvalidNumber s
|
_ -> Left $ MsgInvalidNumber s
|
||||||
|
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -135,6 +137,7 @@ dayField :: RenderMessage master FormMessage => Field sub master Day
|
|||||||
dayField = Field
|
dayField = Field
|
||||||
{ fieldParse = blank $ parseDate . unpack
|
{ fieldParse = blank $ parseDate . unpack
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -144,6 +147,7 @@ timeField :: RenderMessage master FormMessage => Field sub master TimeOfDay
|
|||||||
timeField = Field
|
timeField = Field
|
||||||
{ fieldParse = blank $ parseTime . unpack
|
{ fieldParse = blank $ parseTime . unpack
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" *{attrs} :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -158,6 +162,7 @@ htmlField :: RenderMessage master FormMessage => Field sub master Html
|
|||||||
htmlField = Field
|
htmlField = Field
|
||||||
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance
|
{ fieldParse = blank $ Right . preEscapedText . sanitizeBalance
|
||||||
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
$# FIXME: There was a class="html" attribute, for what purpose?
|
$# FIXME: There was a class="html" attribute, for what purpose?
|
||||||
<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
|
<textarea id="#{theId}" name="#{name}" *{attrs}>#{showVal val}
|
||||||
|]
|
|]
|
||||||
@ -186,6 +191,7 @@ textareaField :: RenderMessage master FormMessage => Field sub master Textarea
|
|||||||
textareaField = Field
|
textareaField = Field
|
||||||
{ fieldParse = blank $ Right . Textarea
|
{ fieldParse = blank $ Right . Textarea
|
||||||
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
|
<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val}
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -195,6 +201,7 @@ hiddenField :: (PathPiece p, RenderMessage master FormMessage)
|
|||||||
hiddenField = Field
|
hiddenField = Field
|
||||||
{ fieldParse = blank $ maybe (Left MsgValueRequired) Right . fromPathPiece
|
{ fieldParse = blank $ maybe (Left MsgValueRequired) Right . fromPathPiece
|
||||||
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
|
<input type="hidden" id="#{theId}" name="#{name}" *{attrs} value="#{either id toPathPiece val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -204,6 +211,7 @@ textField = Field
|
|||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name attrs val isReq ->
|
, fieldView = \theId name attrs val isReq ->
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -212,6 +220,7 @@ passwordField :: RenderMessage master FormMessage => Field sub master Text
|
|||||||
passwordField = Field
|
passwordField = Field
|
||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -261,6 +270,7 @@ emailField = Field
|
|||||||
then Right s
|
then Right s
|
||||||
else Left $ MsgInvalidEmail s
|
else Left $ MsgInvalidEmail s
|
||||||
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="email" :isReq:required="" value="#{either id id val}">
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -271,11 +281,15 @@ searchField autoFocus = Field
|
|||||||
{ fieldParse = blank Right
|
{ fieldParse = blank Right
|
||||||
, fieldView = \theId name attrs val isReq -> do
|
, fieldView = \theId name attrs val isReq -> do
|
||||||
[whamlet|\
|
[whamlet|\
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="search" :isReq:required="" :autoFocus:autofocus="" value="#{either id id val}">
|
<input id="#{theId}" name="#{name}" *{attrs} 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();}|]
|
[whamlet|
|
||||||
|
$newline never
|
||||||
|
<script>if (!('autofocus' in document.createElement('input'))) {document.getElementById('#{theId}').focus();}
|
||||||
|
|]
|
||||||
toWidget [cassius|
|
toWidget [cassius|
|
||||||
#{theId}
|
#{theId}
|
||||||
-webkit-appearance: textfield
|
-webkit-appearance: textfield
|
||||||
@ -290,6 +304,7 @@ urlField = Field
|
|||||||
Just _ -> Right s
|
Just _ -> Right s
|
||||||
, fieldView = \theId name attrs val isReq ->
|
, fieldView = \theId name attrs val isReq ->
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
|
<input ##{theId} name=#{name} *{attrs} type=url :isReq:required value=#{either id id val}>
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -299,9 +314,18 @@ 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|
|
||||||
(\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
|
$newline never
|
||||||
(\_theId _name attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected *{attrs}>#{text}|]) -- inside
|
<select ##{theId} name=#{name}>^{inside}
|
||||||
|
|]) -- outside
|
||||||
|
(\_theId _name isSel -> [whamlet|
|
||||||
|
$newline never
|
||||||
|
<option value=none :isSel:selected>_{MsgSelectNone}
|
||||||
|
|]) -- onOpt
|
||||||
|
(\_theId _name attrs value isSel text -> [whamlet|
|
||||||
|
$newline never
|
||||||
|
<option value=#{value} :isSel:selected *{attrs}>#{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
|
||||||
@ -323,6 +347,7 @@ multiSelectField ioptlist =
|
|||||||
opts <- fmap olOptions $ lift ioptlist
|
opts <- fmap olOptions $ lift ioptlist
|
||||||
let selOpts = map (id &&& (optselected val)) opts
|
let selOpts = map (id &&& (optselected val)) opts
|
||||||
[whamlet|
|
[whamlet|
|
||||||
|
$newline never
|
||||||
<select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
|
<select ##{theId} name=#{name} :isReq:required multiple *{attrs}>
|
||||||
$forall (opt, optsel) <- selOpts
|
$forall (opt, optsel) <- selOpts
|
||||||
<option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
|
<option value=#{optionExternalValue opt} :optsel:selected>#{optionDisplay opt}
|
||||||
@ -336,13 +361,18 @@ 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|
|
||||||
|
$newline never
|
||||||
|
<div ##{theId}>^{inside}
|
||||||
|
|])
|
||||||
(\theId name isSel -> [whamlet|
|
(\theId name isSel -> [whamlet|
|
||||||
|
$newline never
|
||||||
<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 attrs value isSel text -> [whamlet|
|
(\theId name attrs value isSel text -> [whamlet|
|
||||||
|
$newline never
|
||||||
<div>
|
<div>
|
||||||
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
|
<input id=#{theId}-#{value} type=radio name=#{name} value=#{value} :isSel:checked *{attrs}>
|
||||||
<label for=#{theId}-#{value}>#{text}
|
<label for=#{theId}-#{value}>#{text}
|
||||||
@ -352,6 +382,7 @@ boolField :: RenderMessage master FormMessage => Field sub master Bool
|
|||||||
boolField = Field
|
boolField = Field
|
||||||
{ fieldParse = return . boolParser
|
{ fieldParse = return . boolParser
|
||||||
, fieldView = \theId name attrs val isReq -> [whamlet|
|
, fieldView = \theId name attrs val isReq -> [whamlet|
|
||||||
|
$newline never
|
||||||
$if not isReq
|
$if not isReq
|
||||||
<input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
|
<input id=#{theId}-none *{attrs} type=radio name=#{name} value=none checked>
|
||||||
<label for=#{theId}-none>_{MsgSelectNone}
|
<label for=#{theId}-none>_{MsgSelectNone}
|
||||||
@ -385,6 +416,7 @@ checkBoxField :: RenderMessage m FormMessage => Field s m Bool
|
|||||||
checkBoxField = Field
|
checkBoxField = Field
|
||||||
{ fieldParse = return . checkBoxParser
|
{ fieldParse = return . checkBoxParser
|
||||||
, fieldView = \theId name attrs val _ -> [whamlet|
|
, fieldView = \theId name attrs val _ -> [whamlet|
|
||||||
|
$newline never
|
||||||
<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
|
<input id=#{theId} *{attrs} type=checkbox name=#{name} value=yes :showVal id val:checked>
|
||||||
|]
|
|]
|
||||||
}
|
}
|
||||||
@ -499,6 +531,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
|
|||||||
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
||||||
, fvId = id'
|
, fvId = id'
|
||||||
, fvInput = [whamlet|
|
, fvInput = [whamlet|
|
||||||
|
$newline never
|
||||||
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
||||||
|]
|
|]
|
||||||
, fvErrors = errs
|
, fvErrors = errs
|
||||||
@ -527,6 +560,7 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
|
|||||||
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
, fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs
|
||||||
, fvId = id'
|
, fvId = id'
|
||||||
, fvInput = [whamlet|
|
, fvInput = [whamlet|
|
||||||
|
$newline never
|
||||||
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
<input type=file name=#{name} ##{id'} *{fsAttrs fs}>
|
||||||
|]
|
|]
|
||||||
, fvErrors = errs
|
, fvErrors = errs
|
||||||
|
|||||||
@ -187,7 +187,10 @@ postHelper form env = do
|
|||||||
let token =
|
let token =
|
||||||
case reqToken req of
|
case reqToken req of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
Just n -> [shamlet|<input type=hidden name=#{tokenKey} value=#{n}>|]
|
Just n -> [shamlet|
|
||||||
|
$newline never
|
||||||
|
<input type=hidden name=#{tokenKey} value=#{n}>
|
||||||
|
|]
|
||||||
m <- getYesod
|
m <- getYesod
|
||||||
langs <- languages
|
langs <- languages
|
||||||
((res, xml), enctype) <- runFormGeneric (form token) m langs env
|
((res, xml), enctype) <- runFormGeneric (form token) m langs env
|
||||||
@ -245,7 +248,10 @@ 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 = [shamlet|<input type=hidden name=#{getKey}>|]
|
let fragment = [shamlet|
|
||||||
|
$newline never
|
||||||
|
<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
|
||||||
@ -261,6 +267,7 @@ renderTable aform fragment = do
|
|||||||
let views = views' []
|
let views = views' []
|
||||||
-- FIXME non-valid HTML
|
-- FIXME non-valid HTML
|
||||||
let widget = [whamlet|
|
let widget = [whamlet|
|
||||||
|
$newline never
|
||||||
\#{fragment}
|
\#{fragment}
|
||||||
$forall view <- views
|
$forall view <- views
|
||||||
<tr :fvRequired view:.required :not $ fvRequired view:.optional>
|
<tr :fvRequired view:.required :not $ fvRequired view:.optional>
|
||||||
@ -278,6 +285,7 @@ renderDivs aform fragment = do
|
|||||||
(res, views') <- aFormToForm aform
|
(res, views') <- aFormToForm aform
|
||||||
let views = views' []
|
let views = views' []
|
||||||
let widget = [whamlet|
|
let widget = [whamlet|
|
||||||
|
$newline never
|
||||||
\#{fragment}
|
\#{fragment}
|
||||||
$forall view <- views
|
$forall view <- views
|
||||||
<div :fvRequired view:.required :not $ fvRequired view:.optional>
|
<div :fvRequired view:.required :not $ fvRequired view:.optional>
|
||||||
@ -312,6 +320,7 @@ renderBootstrap aform fragment = do
|
|||||||
has (Just _) = True
|
has (Just _) = True
|
||||||
has Nothing = False
|
has Nothing = False
|
||||||
let widget = [whamlet|
|
let widget = [whamlet|
|
||||||
|
$newline never
|
||||||
\#{fragment}
|
\#{fragment}
|
||||||
$forall view <- views
|
$forall view <- views
|
||||||
<div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
|
<div .control-group .clearfix :fvRequired view:.required :not $ fvRequired view:.optional :has $ fvErrors view:.error>
|
||||||
|
|||||||
@ -64,6 +64,7 @@ jqueryDayField jds = Field
|
|||||||
. unpack
|
. unpack
|
||||||
, fieldView = \theId name attrs val isReq -> do
|
, fieldView = \theId name attrs val isReq -> do
|
||||||
toWidget [shamlet|
|
toWidget [shamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
<input id="#{theId}" name="#{name}" *{attrs} type="date" :isReq:required="" value="#{showVal val}">
|
||||||
|]
|
|]
|
||||||
addScript' urlJqueryJs
|
addScript' urlJqueryJs
|
||||||
@ -103,6 +104,7 @@ jqueryAutocompleteField src = Field
|
|||||||
{ fieldParse = blank $ Right
|
{ fieldParse = blank $ Right
|
||||||
, fieldView = \theId name attrs val isReq -> do
|
, fieldView = \theId name attrs val isReq -> do
|
||||||
toWidget [shamlet|
|
toWidget [shamlet|
|
||||||
|
$newline never
|
||||||
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|
<input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val}" .autocomplete>
|
||||||
|]
|
|]
|
||||||
addScript' urlJqueryJs
|
addScript' urlJqueryJs
|
||||||
|
|||||||
@ -80,6 +80,7 @@ inputList label fixXml single mdef = formToAForm $ do
|
|||||||
, fvTooltip = Nothing
|
, fvTooltip = Nothing
|
||||||
, fvId = theId
|
, fvId = theId
|
||||||
, fvInput = [whamlet|
|
, fvInput = [whamlet|
|
||||||
|
$newline never
|
||||||
^{fixXml views}
|
^{fixXml views}
|
||||||
<p>
|
<p>
|
||||||
$forall xml <- xmls
|
$forall xml <- xmls
|
||||||
@ -100,7 +101,10 @@ 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|
|
||||||
|
$newline never
|
||||||
|
<input type=hidden name=#{deleteName} value=yes>
|
||||||
|
|]
|
||||||
_ -> do
|
_ -> do
|
||||||
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
|
(_, xml2) <- aFormToForm $ areq boolField FieldSettings
|
||||||
{ fsLabel = SomeMessage MsgDelete
|
{ fsLabel = SomeMessage MsgDelete
|
||||||
@ -127,6 +131,7 @@ massDivs, massTable
|
|||||||
:: [[FieldView sub master]]
|
:: [[FieldView sub master]]
|
||||||
-> GWidget sub master ()
|
-> GWidget sub master ()
|
||||||
massDivs viewss = [whamlet|
|
massDivs viewss = [whamlet|
|
||||||
|
$newline never
|
||||||
$forall views <- viewss
|
$forall views <- viewss
|
||||||
<fieldset>
|
<fieldset>
|
||||||
$forall view <- views
|
$forall view <- views
|
||||||
@ -140,6 +145,7 @@ $forall views <- viewss
|
|||||||
|]
|
|]
|
||||||
|
|
||||||
massTable viewss = [whamlet|
|
massTable viewss = [whamlet|
|
||||||
|
$newline never
|
||||||
$forall views <- viewss
|
$forall views <- viewss
|
||||||
<fieldset>
|
<fieldset>
|
||||||
<table>
|
<table>
|
||||||
|
|||||||
@ -38,6 +38,7 @@ nicHtmlField = Field
|
|||||||
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
|
{ fieldParse = return . Right . fmap (preEscapedText . sanitizeBalance) . listToMaybe
|
||||||
, fieldView = \theId name attrs val _isReq -> do
|
, fieldView = \theId name attrs val _isReq -> do
|
||||||
toWidget [shamlet|
|
toWidget [shamlet|
|
||||||
|
$newline never
|
||||||
<textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
|
<textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
|
||||||
|]
|
|]
|
||||||
addScript' urlNicEdit
|
addScript' urlNicEdit
|
||||||
|
|||||||
@ -17,7 +17,7 @@ library
|
|||||||
, yesod-core >= 1.1 && < 1.2
|
, yesod-core >= 1.1 && < 1.2
|
||||||
, yesod-persistent >= 1.1 && < 1.2
|
, yesod-persistent >= 1.1 && < 1.2
|
||||||
, time >= 1.1.4
|
, time >= 1.1.4
|
||||||
, hamlet >= 1.0 && < 1.1
|
, hamlet >= 1.1 && < 1.2
|
||||||
, shakespeare-css >= 1.0 && < 1.1
|
, shakespeare-css >= 1.0 && < 1.1
|
||||||
, shakespeare-js >= 1.0 && < 1.1
|
, shakespeare-js >= 1.0 && < 1.1
|
||||||
, persistent >= 1.0 && < 1.1
|
, persistent >= 1.0 && < 1.1
|
||||||
|
|||||||
@ -74,5 +74,6 @@ atomLink :: Route m
|
|||||||
-> Text -- ^ title
|
-> Text -- ^ title
|
||||||
-> GWidget s m ()
|
-> GWidget s m ()
|
||||||
atomLink r title = toWidgetHead [hamlet|
|
atomLink r title = toWidgetHead [hamlet|
|
||||||
|
$newline never
|
||||||
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
|
<link href=@{r} type=#{S8.unpack typeAtom} rel="alternate" title=#{title}>
|
||||||
|]
|
|]
|
||||||
|
|||||||
@ -71,5 +71,6 @@ rssLink :: Route m
|
|||||||
-> Text -- ^ title
|
-> Text -- ^ title
|
||||||
-> GWidget s m ()
|
-> GWidget s m ()
|
||||||
rssLink r title = toWidgetHead [hamlet|
|
rssLink r title = toWidgetHead [hamlet|
|
||||||
|
$newline never
|
||||||
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
|
<link href=@{r} type=#{S8.unpack typeRss} rel="alternate" title=#{title}>
|
||||||
|]
|
|]
|
||||||
|
|||||||
@ -16,10 +16,10 @@ library
|
|||||||
build-depends: base >= 4 && < 5
|
build-depends: base >= 4 && < 5
|
||||||
, yesod-core >= 1.1 && < 1.2
|
, yesod-core >= 1.1 && < 1.2
|
||||||
, time >= 1.1.4
|
, time >= 1.1.4
|
||||||
, hamlet >= 1.0 && < 1.1
|
, hamlet >= 1.1 && < 1.2
|
||||||
, bytestring >= 0.9.1.4
|
, bytestring >= 0.9.1.4
|
||||||
, text >= 0.9 && < 0.12
|
, text >= 0.9 && < 0.12
|
||||||
, xml-conduit >= 0.8 && < 0.9
|
, xml-conduit >= 1.0 && < 1.1
|
||||||
, blaze-html >= 0.5 && < 0.6
|
, blaze-html >= 0.5 && < 0.6
|
||||||
, blaze-markup >= 0.5.1 && < 0.6
|
, blaze-markup >= 0.5.1 && < 0.6
|
||||||
, containers
|
, containers
|
||||||
|
|||||||
@ -16,7 +16,7 @@ library
|
|||||||
build-depends: base >= 4 && < 5
|
build-depends: base >= 4 && < 5
|
||||||
, yesod-core >= 1.1 && < 1.2
|
, yesod-core >= 1.1 && < 1.2
|
||||||
, time >= 1.1.4
|
, time >= 1.1.4
|
||||||
, xml-conduit >= 0.8 && < 0.9
|
, xml-conduit >= 1.0 && < 1.1
|
||||||
, text
|
, text
|
||||||
, containers
|
, containers
|
||||||
exposed-modules: Yesod.Sitemap
|
exposed-modules: Yesod.Sitemap
|
||||||
|
|||||||
@ -28,7 +28,7 @@ library
|
|||||||
, bytestring >= 0.9
|
, bytestring >= 0.9
|
||||||
, case-insensitive >= 0.2
|
, case-insensitive >= 0.2
|
||||||
, text
|
, text
|
||||||
, xml-conduit >= 0.8 && < 0.9
|
, xml-conduit >= 1.0 && < 1.1
|
||||||
, xml-types >= 0.3 && < 0.4
|
, xml-types >= 0.3 && < 0.4
|
||||||
, containers
|
, containers
|
||||||
, html-conduit >= 0.1 && < 0.2
|
, html-conduit >= 0.1 && < 0.2
|
||||||
|
|||||||
@ -74,7 +74,7 @@ library
|
|||||||
, wai >= 1.3 && < 1.4
|
, wai >= 1.3 && < 1.4
|
||||||
, wai-extra >= 1.3 && < 1.4
|
, wai-extra >= 1.3 && < 1.4
|
||||||
, wai-logger >= 0.1.2
|
, wai-logger >= 0.1.2
|
||||||
, hamlet >= 1.0 && < 1.1
|
, hamlet >= 1.1 && < 1.2
|
||||||
, shakespeare-js >= 1.0 && < 1.1
|
, shakespeare-js >= 1.0 && < 1.1
|
||||||
, shakespeare-css >= 1.0 && < 1.1
|
, shakespeare-css >= 1.0 && < 1.1
|
||||||
, warp >= 1.3 && < 1.4
|
, warp >= 1.3 && < 1.4
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user