yesod-form 0.3.1 → 0.3.2
raw patch · 3 files changed
+83/−5 lines, 3 files
Files
- Yesod/Form/Fields.hs +77/−2
- Yesod/Form/Functions.hs +5/−2
- yesod-form.cabal +1/−1
Yesod/Form/Fields.hs view
@@ -4,8 +4,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} module Yesod.Form.Fields- ( FormMessage (..)+ ( -- * i18n+ FormMessage (..) , defaultFormMessage+ -- * Fields , textField , passwordField , textareaField@@ -26,11 +28,14 @@ , Textarea (..) , radioField , boolField+ -- * File 'AForm's+ , fileAFormReq+ , fileAFormOpt ) where import Yesod.Form.Types import Yesod.Widget-import Yesod.Message (RenderMessage, SomeMessage (..))+import Yesod.Message (RenderMessage (renderMessage), SomeMessage (..)) import Text.Hamlet import Text.Blaze (ToHtml (..), preEscapedText, unsafeByteString) import Text.Cassius@@ -54,7 +59,13 @@ import Data.Text (Text, unpack, pack) import qualified Data.Text.Read import Data.Monoid (mappend)+import Control.Monad.IO.Class (liftIO) +import Control.Applicative ((<$>))+import qualified Data.Map as Map+import Yesod.Handler (newIdent)+import Yesod.Request (FileInfo)+ #if __GLASGOW_HASKELL__ >= 700 #define WHAMLET whamlet #define HAMLET hamlet@@ -292,6 +303,7 @@ <input id="#{theId}" name="#{name}" 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> |] addCassius [CASSIUS|@@ -419,3 +431,66 @@ Nothing -> Left $ SomeMessage $ MsgInvalidEntry x Just y -> Right $ Just $ snd y _ -> Left $ SomeMessage $ MsgInvalidNumber x++fileAFormReq :: (RenderMessage master msg, RenderMessage master FormMessage) => FieldSettings msg -> AForm sub master FileInfo+fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do+ let (name, ints') =+ case fsName fs of+ Just x -> (x, ints)+ Nothing ->+ let i' = incrInts ints+ in (pack $ 'f' : show i', i')+ id' <- maybe (pack <$> newIdent) return $ fsId fs+ let (res, errs) =+ case menvs of+ Nothing -> (FormMissing, Nothing)+ Just (_, fenv) ->+ case Map.lookup name fenv of+ Nothing ->+ let t = renderMessage master langs MsgValueRequired+ in (FormFailure [t], Just $ toHtml t)+ Just fi -> (FormSuccess fi, Nothing)+ let fv = FieldView+ { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs+ , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs+ , fvId = id'+ , fvInput = [whamlet|+<input type=file name=#{name} ##{id'}>+|]+ , fvErrors = errs+ , fvRequired = True+ }+ return (res, (fv :), ints', Multipart)++fileAFormOpt :: (RenderMessage master msg, RenderMessage master FormMessage) => FieldSettings msg -> AForm sub master (Maybe FileInfo)+fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do+ liftIO $ print menvs+ let (name, ints') =+ case fsName fs of+ Just x -> (x, ints)+ Nothing ->+ let i' = incrInts ints+ in (pack $ 'f' : show i', i')+ id' <- maybe (pack <$> newIdent) return $ fsId fs+ let (res, errs) =+ case menvs of+ Nothing -> (FormMissing, Nothing)+ Just (_, fenv) ->+ case Map.lookup name fenv of+ Nothing -> (FormSuccess Nothing, Nothing)+ Just fi -> (FormSuccess $ Just fi, Nothing)+ let fv = FieldView+ { fvLabel = toHtml $ renderMessage master langs $ fsLabel fs+ , fvTooltip = fmap (toHtml . renderMessage master langs) $ fsTooltip fs+ , fvId = id'+ , fvInput = [whamlet|+<input type=file name=#{name} ##{id'}>+|]+ , fvErrors = errs+ , fvRequired = False+ }+ return (res, (fv :), ints', Multipart)++incrInts :: Ints -> Ints+incrInts (IntSingle i) = IntSingle $ i + 1+incrInts (IntCons i is) = (i + 1) `IntCons` is
Yesod/Form/Functions.hs view
@@ -43,7 +43,7 @@ import Yesod.Handler (GHandler, GGHandler, getRequest, runRequestBody, newIdent, getYesod) import Yesod.Core (RenderMessage, liftIOHandler, SomeMessage (..)) import Yesod.Widget (GWidget, whamlet)-import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages)+import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages, FileInfo (..)) import Network.Wai (requestMethod) import Text.Hamlet (shamlet) import Data.Monoid (mempty)@@ -51,6 +51,7 @@ import Yesod.Message (RenderMessage (..)) import Control.Monad.IO.Class (MonadIO) import qualified Data.Map as Map+import qualified Data.ByteString.Lazy as L #if __GLASGOW_HASKELL__ >= 700 #define WHAMLET whamlet@@ -215,7 +216,9 @@ else do (p, f) <- runRequestBody let p' = Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) p- return $ Just (p', Map.fromList f)+ return $ Just (p', Map.fromList $ filter (notEmpty . snd) f)+ where+ notEmpty = not . L.null . fileContent runFormPostNoNonce :: (Html -> Form sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPostNoNonce form = do
yesod-form.cabal view
@@ -1,5 +1,5 @@ name: yesod-form-version: 0.3.1+version: 0.3.2 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>