yesod-form-json (empty) → 0.0.1

raw patch · 4 files changed

+154/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, containers, text, unordered-containers, yesod-core, yesod-form

Files

LICENSE +20/−0
Setup.lhs +4/−0
Yesod/Form/JSON.hs +96/−0
yesod-form-json.cabal +34/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2014 Anton Cheshkov++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.lhs view

@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain

+ Yesod/Form/JSON.hs view

@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts #-}+++module Yesod.Form.JSON ++(+-- * The example of use+-- $use++-- * Functions++    runJSONForm+,   jsonField+) ++where++import Prelude+import Data.Aeson (eitherDecode, encode)+import Yesod.Form.Types+import Data.Text (Text, pack)+import Control.Applicative (Applicative (..))+import Yesod.Core+import Control.Monad (liftM)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe, catMaybes)+import Control.Arrow ((***))+import Yesod.Form.Input (FormInput(..))+import qualified Data.HashMap.Strict as HM (toList)+import Yesod.Form.Functions (parseHelper)+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.ByteString.Lazy as B (fromStrict, toStrict)+++-- |Run JSON form+runJSONForm ::  MonadHandler m => FormInput m a -> m a+runJSONForm (FormInput f) = do+    obj <- requireJsonBody+    let env  = toEnv obj+    m <- getYesod+    l <- languages+    emx <- f m l env Map.empty+    case emx of+        Left errs -> invalidArgs $ errs []+        Right x -> return x+++-- |Obtain JSON field from json request+jsonField :: (Monad m, FromJSON a) => RenderMessage (HandlerSite m) FormMessage => Field m a+jsonField = Field (parseHelper helper) undefined undefined+  where+    helper json = case (eitherDecode . B.fromStrict . encodeUtf8) json of+                Left err -> Left $ MsgInvalidEntry $ pack err+                Right v  -> Right v++toEnv :: Value -> Env+toEnv (Object obj) = +    let l = map json2Text $ HM.toList obj+    in Map.fromList $ catMaybes l+    +  where  +  +    json2Text (name, obj@(Object _)) = Just $ (name, [(decodeUtf8 . B.toStrict . encode) obj])  +    json2Text (name, arr@(Array _))  = Just $ (name, [(decodeUtf8 . B.toStrict . encode) arr])  +    json2Text (name, String str)     = Just $ (name, [str])+    json2Text (name, Number n)       = Just $ (name, [pack $ show n])+    json2Text (name, Bool b)         = Just $ (name, [pack $ show b])+    +toEnv _ = Map.empty++-- toMap :: [(Text, a)] -> Map.Map Text [a]+-- toMap = Map.unionsWith (++) . map (\(x, y) -> Map.singleton x [y])+++-- $use+--  +-- > data Offer = Offer {+-- >      name :: Text+-- >    , description Text+-- >    , supplier :: SupplierId+-- >    , category :: CategoryId+-- >    , tags :: [TagId] +-- >    , images :: [Image]+-- >    , variants :: [Variant]+-- >    , active :: Bool+-- > }+--+-- > offer <- runJSONForm $ Offer <$> ireq textField "name"+-- >                              <*> ireq textField "description"+-- >                              <*> ireq jsonField "supplier" +-- >                              <*> ireq jsonField "category")+-- >                              <*> ireq jsonField "tags")+-- >                              <*> ireq jsonField "images"+-- >                              <*> (fmap nub $ ireq jsonField "variants")+-- >                              <*> ireq boolField "active"     +

+ yesod-form-json.cabal view

@@ -0,0 +1,34 @@+Name: yesod-form-json+Category: Web, Yesod+license:  MIT+License-File: LICENSE+Version: 0.0.1+Cabal-version: >= 1.8+Build-type: Simple+Copyright: Anton Cheshkov+Author: Anton Cheshkov <acheshkov@gmail.com>+maintainer: Anton Cheshkov <acheshkov@gmail.com>+Synopsis: Extension for Yesod web framework to handle JSON requests as applicative forms+Description: Extension for Yesod web framework to handle JSON requests as applicative forms++++Library+  Build-depends:+      base >= 4 && < 5,+      yesod-form,+      bytestring,+      text,+      unordered-containers,+      containers,+      yesod-core >= 1.2.7,+      aeson++    +  Extensions:       FlexibleContexts+  Exposed-Modules:  Yesod.Form.JSON+  Ghc-options:      -Wall++source-repository head+  type:     git+  location: https://github.com/acheshkov/yesod-form-json.git