fields-json (empty) → 0.1

raw patch · 5 files changed

+185/−0 lines, 5 filesdep +basedep +containersdep +jsonsetup-changed

Dependencies added: base, containers, json, mtl

Files

LICENSE +30/−0
Setup.hs +3/−0
fields-json.cabal +34/−0
src/Text/JSON/Fields.hs +76/−0
src/Text/JSON/ToJSON.hs +42/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Scrive 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Scrive nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

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

+ fields-json.cabal view

@@ -0,0 +1,34 @@+Name:                fields-json+Version:             0.1+Synopsis: Abusing monadic syntax JSON objects generation.            ++Description: +  Generation of big, complex JSON objects with Text.JSON is painful. And autoderivation is not always posible.+  Check haddock of Fields module for more info.++License:             BSD3+License-file:        LICENSE+Author:              Scrive+Maintainer:          mariusz@scrive.com+Stability:           Development+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.2+++library+  exposed-modules: +     Text.JSON.Fields+     Text.JSON.ToJSON++  hs-source-dirs: src ++  build-depends: base >= 4 && < 5+  build-depends: json >= 0.4.4+  build-depends: containers+  build-depends: mtl+  extensions:    FlexibleInstances,+                 TypeSynonymInstances,+                 UndecidableInstances,+                 OverlappingInstances,+                 IncoherentInstances

+ src/Text/JSON/Fields.hs view

@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.JSON.Fields+-- Copyright   :  (c) Scrive 2011+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  mariusz@scrive.com+-- Stability   :  development+-- Portability :  portable+--+-- Abusing monadic do notation library for generating JSON object. +-- Hard-binded to json package from hackage.+-- Main ideas+--+-- * Overloaded function 'field', that may set values of fields of different types - 'Bool', 'Int', 'String', lists  etc.+--+-- * Internal IO - value of the field can be IO a, is we know how to put a into JSON. That means that there is no need to do prebinding +--+-- * Compositionality - value of field can also be fields. Easy to do embeded  objects+--+-- * Monadic notation - it really looks nicer then composition with '.' or some magic combinator+--+-- >+-- > json $ do+-- >     field "a" "a"+-- >     field "b" [1,2,3]+-- >     field "c" $ do+-- >         field "x" True+-- >         field "y" False+-- >+-- +-- Will generate json object +--  {a : "a", b: [1,2,3], c: {x: true, y : false}} +--++module Text.JSON.Fields (json, JSField(..))where++import Text.JSON+import Text.JSON.ToJSON+import Data.Map as Map+import Control.Monad.State.Strict+++type JSFields = State ([(String, IO JSValue)]) ()+++{- | Function for changing 'JSFields' into real JSON object -}++json :: JSFields -> IO JSValue+json fields = fmap (JSObject . toJSObject) $ sequence $ fmap pack $ execState fields []++{- | The 'JSField' class instances are object that in some sence can be interpreted as value of JSON object fields. +     To derive new instances use existing instances since internal structure 'JSFields' is hidden.+-}++class JSField a where+  field :: String -> a -> JSFields+  +instance (ToJSON a) => JSField a where  +  field n v = modify $ \s -> (n, return $ toJSON v) : s++instance (ToJSON a) => JSField (IO a) where  +  field n v = modify $ \s -> (n, fmap toJSON v) : s++instance JSField (JSFields) where  +  field n v = modify $ \s -> (n, fmap toJSON val) : s+   where+      val = fmap Map.fromList (sequence $ fmap pack $ execState v [])+  +instance JSField [JSFields] where  +  field n fs = modify $ \s -> (n, fmap toJSON $ mapM vals fs) : s+      where+        vals f = fmap Map.fromList  (sequence $ fmap pack $ execState f [])++pack :: (Functor f) => (a, f b) -> f (a, b)+pack (name, comp)=  fmap (\res -> (name,res)) comp

+ src/Text/JSON/ToJSON.hs view

@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Text.JSON.ToJSON+-- Copyright   :  (c) Scrive 2011+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  mariusz@scrive.com+-- Stability   :  development+-- Portability :  portable+--+-- Unifing some structures to JSValue+--+++module Text.JSON.ToJSON (ToJSON(..))where++import Text.JSON+import Data.Map++class ToJSON a where+  toJSON:: a -> JSValue++instance ToJSON JSValue where+  toJSON = id+  +instance ToJSON String where+  toJSON = JSString . toJSString ++instance ToJSON Bool where+  toJSON = JSBool++instance ToJSON Int where+  toJSON = JSRational True . toRational+  +instance ToJSON Integer where+  toJSON = JSRational True . toRational+  +instance (ToJSON a) =>  ToJSON [a] where+  toJSON = JSArray . fmap toJSON +  +instance (ToJSON a) => ToJSON (Map String a) where  +  toJSON = JSObject . toJSObject . toList . (fmap toJSON)