mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

update for yesod-form-1.4.0.2

Browse source
This commit is contained in:
Joey Hess 2014-10-13 17:09:12 -04:00
parent a1186238dc
commit 5cd59f896d
1 changed files with 68 additions and 114 deletions
Download patch file Download diff file Expand all files Collapse all files

182
standalone/no-th/haskell-patches/yesod-form_spliced-TH.patch
View file

@ -1,20 +1,5 @@
From 6aabd510081681f81f4259190be32fbb2819b46c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 12 Sep 2014 21:30:27 -0400
Subject: [PATCH] splice TH
---
Yesod/Form/Bootstrap3.hs | 183 +++++++++---
Yesod/Form/Fields.hs | 753 ++++++++++++++++++++++++++++++++++++++---------
Yesod/Form/Functions.hs | 257 +++++++++++++---
Yesod/Form/Jquery.hs | 134 +++++++--
Yesod/Form/MassInput.hs | 226 +++++++++++---
Yesod/Form/Nic.hs | 67 ++++-
yesod-form.cabal | 1 -
7 files changed, 1319 insertions(+), 302 deletions(-)
diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs diff --git a/Yesod/Form/Bootstrap3.hs b/Yesod/Form/Bootstrap3.hs
index 84e85fc..943c416 100644 index 84e85fc..1954fb4 100644
--- a/Yesod/Form/Bootstrap3.hs --- a/Yesod/Form/Bootstrap3.hs
+++ b/Yesod/Form/Bootstrap3.hs +++ b/Yesod/Form/Bootstrap3.hs
@@ -26,6 +26,9 @@ import Data.String (IsString(..)) @@ -26,6 +26,9 @@ import Data.String (IsString(..))
@ -27,7 +12,7 @@ index 84e85fc..943c416 100644
import Yesod.Form.Types import Yesod.Form.Types
import Yesod.Form.Functions import Yesod.Form.Functions
@@ -152,44 +152,144 @@ renderBootstrap3 formLayout aform fragment = do @@ -152,44 +155,144 @@ renderBootstrap3 formLayout aform fragment = do
let views = views' [] let views = views' []
has (Just _) = True has (Just _) = True
has Nothing = False has Nothing = False
@ -205,7 +190,7 @@ index 84e85fc..943c416 100644
-- | How the 'bootstrapSubmit' button should be rendered. -- | How the 'bootstrapSubmit' button should be rendered.
@@ -244,7 +344,22 @@ mbootstrapSubmit @@ -244,7 +347,22 @@ mbootstrapSubmit
=> BootstrapSubmit msg -> MForm m (FormResult (), FieldView site) => BootstrapSubmit msg -> MForm m (FormResult (), FieldView site)
mbootstrapSubmit (BootstrapSubmit msg classes attrs) = mbootstrapSubmit (BootstrapSubmit msg classes attrs) =
let res = FormSuccess () let res = FormSuccess ()
@ -230,7 +215,7 @@ index 84e85fc..943c416 100644
, fvTooltip = Nothing , fvTooltip = Nothing
, fvId = bootstrapSubmitId , fvId = bootstrapSubmitId
diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs diff --git a/Yesod/Form/Fields.hs b/Yesod/Form/Fields.hs
index c6091a9..3d7b267 100644 index 8173e78..8ee847d 100644
--- a/Yesod/Form/Fields.hs --- a/Yesod/Form/Fields.hs
+++ b/Yesod/Form/Fields.hs +++ b/Yesod/Form/Fields.hs
@@ -1,4 +1,3 @@ @@ -1,4 +1,3 @@
@ -280,7 +265,7 @@ index c6091a9..3d7b267 100644
import qualified Blaze.ByteString.Builder.Html.Utf8 as B import qualified Blaze.ByteString.Builder.Html.Utf8 as B
import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder (writeByteString, toLazyByteString)
import Blaze.ByteString.Builder.Internal.Write (fromWriteList) import Blaze.ByteString.Builder.Internal.Write (fromWriteList)
@@ -91,15 +92,12 @@ import qualified Data.Text as T (drop, dropWhile) @@ -87,15 +88,12 @@ import qualified Data.Text as T (drop, dropWhile)
import qualified Data.Text.Read import qualified Data.Text.Read
import qualified Data.Map as Map import qualified Data.Map as Map
@ -296,7 +281,7 @@ index c6091a9..3d7b267 100644
defaultFormMessage :: FormMessage -> Text defaultFormMessage :: FormMessage -> Text
defaultFormMessage = englishFormMessage defaultFormMessage = englishFormMessage
@@ -111,10 +109,25 @@ intField = Field @@ -107,10 +105,25 @@ intField = Field
Right (a, "") -> Right a Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s _ -> Left $ MsgInvalidInteger s
@ -326,7 +311,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where where
@@ -128,10 +141,25 @@ doubleField = Field @@ -124,10 +137,25 @@ doubleField = Field
Right (a, "") -> Right a Right (a, "") -> Right a
_ -> Left $ MsgInvalidNumber s _ -> Left $ MsgInvalidNumber s
@ -356,7 +341,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where showVal = either id (pack . show) where showVal = either id (pack . show)
@@ -139,10 +167,24 @@ $newline never @@ -135,10 +163,24 @@ $newline never
dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day dayField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Day
dayField = Field dayField = Field
{ fieldParse = parseHelper $ parseDate . unpack { fieldParse = parseHelper $ parseDate . unpack
@ -385,7 +370,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where showVal = either id (pack . show) where showVal = either id (pack . show)
@@ -150,10 +192,23 @@ $newline never @@ -146,10 +188,23 @@ $newline never
timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay timeField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m TimeOfDay
timeField = Field timeField = Field
{ fieldParse = parseHelper parseTime { fieldParse = parseHelper parseTime
@ -413,7 +398,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where where
@@ -166,10 +221,23 @@ $newline never @@ -162,10 +217,23 @@ $newline never
htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html htmlField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Html
htmlField = Field htmlField = Field
{ fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance { fieldParse = parseHelper $ Right . preEscapedText . sanitizeBalance
@ -441,13 +426,12 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where showVal = either id (pack . renderHtml) where showVal = either id (pack . renderHtml)
@@ -197,10 +265,18 @@ instance ToHtml Textarea where @@ -194,9 +262,17 @@ textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m
textareaField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Textarea
textareaField = Field textareaField = Field
{ fieldParse = parseHelper $ Right . Textarea { fieldParse = parseHelper $ Right . Textarea
- , fieldView = \theId name attrs val _isReq -> toWidget [hamlet| , fieldView = \theId name attrs val isReq -> toWidget [hamlet|
-$newline never -$newline never
-<textarea id="#{theId}" name="#{name}" *{attrs}>#{either id unTextarea val} -<textarea id="#{theId}" name="#{name}" :isReq:required="" *{attrs}>#{either id unTextarea val}
-|] -|]
+ , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKe + , fieldView = \theId name attrs val _isReq -> toWidget $ \ _render_aJKe
+ -> do { id + -> do { id
@ -460,11 +444,10 @@ index c6091a9..3d7b267 100644
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">"); + id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (either id unTextarea val)); + id (toHtml (either id unTextarea val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") } + id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
+
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -208,10 +284,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage) @@ -204,10 +280,19 @@ hiddenField :: (Monad m, PathPiece p, RenderMessage (HandlerSite m) FormMessage)
=> Field m p => Field m p
hiddenField = Field hiddenField = Field
{ fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece { fieldParse = parseHelper $ maybe (Left MsgValueRequired) Right . fromPathPiece
@ -488,7 +471,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -219,20 +304,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex @@ -215,20 +300,53 @@ textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Tex
textField = Field textField = Field
{ fieldParse = parseHelper $ Right { fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq -> , fieldView = \theId name attrs val isReq ->
@ -550,7 +533,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -304,10 +422,24 @@ emailField = Field @@ -300,10 +418,24 @@ emailField = Field
case Email.canonicalizeEmail $ encodeUtf8 s of case Email.canonicalizeEmail $ encodeUtf8 s of
Just e -> Right $ decodeUtf8With lenientDecode e Just e -> Right $ decodeUtf8With lenientDecode e
Nothing -> Left $ MsgInvalidEmail s Nothing -> Left $ MsgInvalidEmail s
@ -579,7 +562,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -322,10 +454,25 @@ multiEmailField = Field @@ -318,10 +450,25 @@ multiEmailField = Field
in case partitionEithers addrs of in case partitionEithers addrs of
([], good) -> Right good ([], good) -> Right good
(bad, _) -> Left $ MsgInvalidEmail $ cat bad (bad, _) -> Left $ MsgInvalidEmail $ cat bad
@ -609,7 +592,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where where
@@ -341,20 +488,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus @@ -337,20 +484,75 @@ searchField :: Monad m => RenderMessage (HandlerSite m) FormMessage => AutoFocus
searchField autoFocus = Field searchField autoFocus = Field
{ fieldParse = parseHelper Right { fieldParse = parseHelper Right
, fieldView = \theId name attrs val isReq -> do , fieldView = \theId name attrs val isReq -> do
@ -697,7 +680,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -365,7 +567,28 @@ urlField = Field @@ -361,7 +563,28 @@ urlField = Field
Nothing -> Left $ MsgInvalidUrl s Nothing -> Left $ MsgInvalidUrl s
Just _ -> Right s Just _ -> Right s
, fieldView = \theId name attrs val isReq -> , fieldView = \theId name attrs val isReq ->
@ -727,7 +710,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -378,18 +601,54 @@ selectField :: (Eq a, RenderMessage site FormMessage) @@ -374,18 +597,54 @@ selectField :: (Eq a, RenderMessage site FormMessage)
=> HandlerT site IO (OptionList a) => HandlerT site IO (OptionList a)
-> Field (HandlerT site IO) a -> Field (HandlerT site IO) a
selectField = selectFieldHelper selectField = selectFieldHelper
@ -794,7 +777,7 @@ index c6091a9..3d7b267 100644
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
=> [(msg, a)] => [(msg, a)]
@@ -412,11 +671,45 @@ multiSelectField ioptlist = @@ -408,11 +667,45 @@ multiSelectField ioptlist =
view theId name attrs val isReq = do view theId name attrs val isReq = do
opts <- fmap olOptions $ handlerToWidget ioptlist opts <- fmap olOptions $ handlerToWidget ioptlist
let selOpts = map (id &&& (optselected val)) opts let selOpts = map (id &&& (optselected val)) opts
@ -845,7 +828,7 @@ index c6091a9..3d7b267 100644
where where
optselected (Left _) _ = False optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@@ -439,54 +732,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist) @@ -435,54 +728,196 @@ checkboxesField ioptlist = (multiSelectField ioptlist)
opts <- fmap olOptions $ handlerToWidget ioptlist opts <- fmap olOptions $ handlerToWidget ioptlist
let optselected (Left _) _ = False let optselected (Left _) _ = False
optselected (Right vals) opt = (optionInternalValue opt) `elem` vals optselected (Right vals) opt = (optionInternalValue opt) `elem` vals
@ -993,6 +976,9 @@ index c6091a9..3d7b267 100644
- <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}
- -
-
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
-<label for=#{theId}-yes>_{MsgBoolYes}
+ , fieldView = \theId name attrs val isReq -> do { condH + , fieldView = \theId name attrs val isReq -> do { condH
+ [(not isReq, + [(not isReq,
+ do { (asWidgetT . toWidget) + do { (asWidgetT . toWidget)
@ -1070,16 +1056,13 @@ index c6091a9..3d7b267 100644
+ (asWidgetT . toWidget) + (asWidgetT . toWidget)
+ ((Text.Blaze.Internal.preEscapedText . pack) "</label>") } + ((Text.Blaze.Internal.preEscapedText . pack) "</label>") }
-<input id=#{theId}-yes *{attrs} type=radio name=#{name} value=yes :showVal id val:checked>
-<label for=#{theId}-yes>_{MsgBoolYes}
-
-<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked> -<input id=#{theId}-no *{attrs} type=radio name=#{name} value=no :showVal not val:checked>
-<label for=#{theId}-no>_{MsgBoolNo} -<label for=#{theId}-no>_{MsgBoolNo}
-|] -|]
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
where where
@@ -512,10 +947,24 @@ $newline never @@ -508,10 +943,24 @@ $newline never
checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool
checkBoxField = Field checkBoxField = Field
{ fieldParse = \e _ -> return $ checkBoxParser e { fieldParse = \e _ -> return $ checkBoxParser e
@ -1108,7 +1091,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = UrlEncoded , fieldEnctype = UrlEncoded
} }
@@ -665,9 +1114,21 @@ fileField = Field @@ -642,9 +1091,21 @@ fileField = Field
case files of case files of
[] -> Right Nothing [] -> Right Nothing
file:_ -> Right $ Just file file:_ -> Right $ Just file
@ -1133,7 +1116,7 @@ index c6091a9..3d7b267 100644
, fieldEnctype = Multipart , fieldEnctype = Multipart
} }
@@ -694,10 +1155,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do @@ -671,10 +1132,19 @@ fileAFormReq fs = AForm $ \(site, langs) menvs ints -> do
{ fvLabel = toHtml $ renderMessage site langs $ fsLabel fs { fvLabel = toHtml $ renderMessage site langs $ fsLabel fs
, fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs , fvTooltip = fmap (toHtml . renderMessage site langs) $ fsTooltip fs
, fvId = id' , fvId = id'
@ -1157,7 +1140,7 @@ index c6091a9..3d7b267 100644
, fvErrors = errs , fvErrors = errs
, fvRequired = True , fvRequired = True
} }
@@ -726,10 +1196,19 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do @@ -703,10 +1173,19 @@ 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'
@ -1182,10 +1165,10 @@ index c6091a9..3d7b267 100644
, fvRequired = False , fvRequired = False
} }
diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs diff --git a/Yesod/Form/Functions.hs b/Yesod/Form/Functions.hs
index 5fd03e6..b14d900 100644 index 9e6abaf..0c2a0ce 100644
--- a/Yesod/Form/Functions.hs --- a/Yesod/Form/Functions.hs
+++ b/Yesod/Form/Functions.hs +++ b/Yesod/Form/Functions.hs
@@ -59,12 +59,16 @@ import Text.Blaze (Markup, toMarkup) @@ -60,12 +60,16 @@ import Text.Blaze (Markup, toMarkup)
#define toHtml toMarkup #define toHtml toMarkup
import Yesod.Core import Yesod.Core
import Network.Wai (requestMethod) import Network.Wai (requestMethod)
@ -1203,7 +1186,7 @@ index 5fd03e6..b14d900 100644
-- | Get a unique identifier. -- | Get a unique identifier.
newFormIdent :: Monad m => MForm m Text newFormIdent :: Monad m => MForm m Text
@@ -216,7 +220,14 @@ postHelper form env = do @@ -217,7 +221,14 @@ postHelper form env = do
let token = let token =
case reqToken req of case reqToken req of
Nothing -> mempty Nothing -> mempty
@ -1219,7 +1202,7 @@ index 5fd03e6..b14d900 100644
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
@@ -296,7 +307,12 @@ getHelper :: MonadHandler m @@ -297,7 +308,12 @@ getHelper :: MonadHandler m
-> Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
-> m (a, Enctype) -> m (a, Enctype)
getHelper form env = do getHelper form env = do
@ -1233,7 +1216,7 @@ index 5fd03e6..b14d900 100644
langs <- languages langs <- languages
m <- getYesod m <- getYesod
runFormGeneric (form fragment) m langs env runFormGeneric (form fragment) m langs env
@@ -331,10 +347,15 @@ identifyForm @@ -332,10 +348,15 @@ identifyForm
identifyForm identVal form = \fragment -> do identifyForm identVal form = \fragment -> do
-- Create hidden <input>. -- Create hidden <input>.
let fragment' = let fragment' =
@ -1253,7 +1236,7 @@ index 5fd03e6..b14d900 100644
-- Check if we got its value back. -- Check if we got its value back.
mp <- askParams mp <- askParams
@@ -364,22 +385,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a @@ -365,22 +386,70 @@ renderTable, renderDivs, renderDivsNoLabels :: Monad m => FormRender m a
renderTable aform fragment = do renderTable aform fragment = do
(res, views') <- aFormToForm aform (res, views') <- aFormToForm aform
let views = views' [] let views = views' []
@ -1340,7 +1323,7 @@ index 5fd03e6..b14d900 100644
return (res, widget) return (res, widget)
where where
addIsFirst [] = [] addIsFirst [] = []
@@ -395,19 +464,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a @@ -396,19 +465,66 @@ renderDivsMaybeLabels :: Monad m => Bool -> FormRender m a
renderDivsMaybeLabels withLabels aform fragment = do renderDivsMaybeLabels withLabels aform fragment = do
(res, views') <- aFormToForm aform (res, views') <- aFormToForm aform
let views = views' [] let views = views' []
@ -1420,7 +1403,7 @@ index 5fd03e6..b14d900 100644
return (res, widget) return (res, widget)
-- | Render a form using Bootstrap v2-friendly shamlet syntax. -- | Render a form using Bootstrap v2-friendly shamlet syntax.
@@ -435,19 +551,62 @@ renderBootstrap2 aform fragment = do @@ -436,19 +552,62 @@ renderBootstrap2 aform fragment = do
let views = views' [] let views = views' []
has (Just _) = True has (Just _) = True
has Nothing = False has Nothing = False
@ -1921,11 +1904,14 @@ index a2b434d..75eb484 100644
- <td .errors>#{err} - <td .errors>#{err}
-|] -|]
diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs diff --git a/Yesod/Form/Nic.hs b/Yesod/Form/Nic.hs
index 7e4af07..b59745a 100644 index 2862678..7a0f25a 100644
--- a/Yesod/Form/Nic.hs --- a/Yesod/Form/Nic.hs
+++ b/Yesod/Form/Nic.hs +++ b/Yesod/Form/Nic.hs
@@ -9,11 +9,22 @@ module Yesod.Form.Nic @@ -6,14 +6,24 @@
, nicHtmlField -- | Provide the user with a rich text editor.
module Yesod.Form.Nic
( YesodNic (..)
- , nicHtmlField
) where ) where
+import qualified Text.Blaze as Text.Blaze.Internal +import qualified Text.Blaze as Text.Blaze.Internal
@ -1949,69 +1935,37 @@ index 7e4af07..b59745a 100644
import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Blaze.Html.Renderer.String (renderHtml)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
@@ -27,20 +38,52 @@ nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html @@ -22,33 +32,3 @@ class Yesod a => YesodNic a where
nicHtmlField = Field -- | NIC Editor Javascript file.
{ fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e urlNicEdit :: a -> Either (Route a) Text
, fieldView = \theId name attrs val isReq -> do urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
-
-nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html
-nicHtmlField = Field
- { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
- , fieldView = \theId name attrs val _isReq -> do
- toWidget [shamlet| - toWidget [shamlet|
-$newline never -$newline never
- <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val} - <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
-|] -|]
+ toWidget $ do { id - addScript' urlNicEdit
+ ((Text.Blaze.Internal.preEscapedText . pack) - master <- getYesod
+ "<textarea class=\"html\" id=\""); - toWidget $
+ id (toHtml theId); - case jsLoader master of
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\" name=\"");
+ id (toHtml name);
+ id ((Text.Blaze.Internal.preEscapedText . pack) "\"");
+ Text.Hamlet.condH
+ [(isReq,
+ id ((Text.Blaze.Internal.preEscapedText . pack) " required"))]
+ Nothing;
+ id ((Text.Hamlet.attrsToHtml . Text.Hamlet.toAttributes) attrs);
+ id ((Text.Blaze.Internal.preEscapedText . pack) ">");
+ id (toHtml (showVal val));
+ id ((Text.Blaze.Internal.preEscapedText . pack) "</textarea>") }
+
addScript' urlNicEdit
master <- getYesod
toWidget $
case jsLoader master of
- BottomOfHeadBlocking -> [julius| - BottomOfHeadBlocking -> [julius|
-bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")}); -bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")});
-|] -|]
- _ -> [julius| - _ -> [julius|
-(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})(); -(function(){new nicEditor({fullPanel:true}).panelInstance("#{rawJS theId}")})();
-|] -|]
+ BottomOfHeadBlocking -> Text.Julius.asJavascriptUrl - , fieldEnctype = UrlEncoded
+ (\ _render_a2rMh - }
+ -> Data.Monoid.mconcat - where
+ [Text.Julius.Javascript - showVal = either id (pack . renderHtml)
+ ((Data.Text.Lazy.Builder.fromText -
+ . Text.Shakespeare.pack') -addScript' :: (MonadWidget m, HandlerSite m ~ site)
+ "\nbkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance(\""), - => (site -> Either (Route site) Text)
+ Text.Julius.toJavascript (rawJS theId), - -> m ()
+ Text.Julius.Javascript -addScript' f = do
+ ((Data.Text.Lazy.Builder.fromText - y <- getYesod
+ . Text.Shakespeare.pack') - addScriptEither $ f y
+ "\")});")])
+
+ _ -> Text.Julius.asJavascriptUrl
+ (\ _render_a2rMm
+ -> Data.Monoid.mconcat
+ [Text.Julius.Javascript
+ ((Data.Text.Lazy.Builder.fromText
+ . Text.Shakespeare.pack')
+ "\n(function(){new nicEditor({fullPanel:true}).panelInstance(\""),
+ Text.Julius.toJavascript (rawJS theId),
+ Text.Julius.Javascript
+ ((Data.Text.Lazy.Builder.fromText
+ . Text.Shakespeare.pack')
+ "\")})();")])
+
, fieldEnctype = UrlEncoded
}
where
--
2.1.0