diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Li Meng Jun + +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 Chris Done 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,46 @@ +Fay SimpleJSON +============== + +SimpleJSON library for Fay. + +```haskell +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} + +module Test (main) where + +import Data.Text (Text, fromString) +import Prelude +import SimpleJSON + +data Test = Test { xKey :: Text, xValue :: Text } +instance JSONSetter Test +instance JSONGetter Test + +decoder :: Decoder Test +decoder = withDecoder "Test" ["xKey" .> "key", "xValue" .> "value"] + +encoder :: Encoder TestJSON +encoder = withEncoder ["key" .< "xKey", "value" .< "xValue"] + +main :: Fay () +main = do + let test = decode "{\"key\": \"test_key\", \"value\": \"test_value\"}" decoder + print test + print $ encode test encoder +``` + +Usage +----- + + +Install: +```bash +cabal install fay-simplejson +``` + +Compile your file: + +```bash +fay --package fay-simplejson MyFile.hs +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/fay-simplejson.cabal b/fay-simplejson.cabal new file mode 100644 --- /dev/null +++ b/fay-simplejson.cabal @@ -0,0 +1,28 @@ +name: fay-simplejson +version: 0.1.1.0 +synopsis: SimpleJSON library for Fay. +description: SimpleJSON library for Fay. +homepage: https://github.com/Lupino/fay-simplejson +bug-reports: https://github.com/Lupino/fay-simplejson/issues +license: BSD3 +license-file: LICENSE +author: Li Meng Jun +maintainer: lmjubuntu@gmail.com +copyright: Li Meng Jun +category: Web, Fay +build-type: Simple +cabal-version: >=1.8 +extra-source-files: + README.md +data-files: src/SimpleJSON.hs + +source-repository head + type: git + location: https://github.com/Lupino/fay-simplejson.git + + +library + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: SimpleJSON + build-depends: fay-base >= 0.18 diff --git a/src/SimpleJSON.hs b/src/SimpleJSON.hs new file mode 100644 --- /dev/null +++ b/src/SimpleJSON.hs @@ -0,0 +1,102 @@ +{-# OPTIONS -fno-warn-redundant-constraints #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RebindableSyntax #-} + +module SimpleJSON + ( + Value, + Decoder, + Encoder, + toDecoder, + toEncoder, + fromJSON, + toJSON, + withDecoder, + withEncoder, + decode, + encode, + decodeRaw, + encodeRaw, + JSONSetter, + JSONGetter, + KeyRef, + KeyRefMap, + (.>), + (.<), + get, + set + ) where + +import Data.Text (Text, fromString) +import FFI (ffi) +import Prelude + +data Value + +class JSONGetter v +instance JSONGetter Value + +class JSONSetter v +instance JSONSetter Value + +newtype Decoder a = Decoder (Value -> a) +newtype Encoder a = Encoder (a -> Value) + +type KeyRef = (Text,Text) +type KeyRefMap = [KeyRef] + +(.>) :: Text -> Text -> KeyRef +a .> b = (a, b) + +(.<) :: Text -> Text -> KeyRef +a .< b = (b, a) + +toDecoder :: (Value -> a) -> Decoder a +toDecoder = Decoder + +toEncoder :: (a -> Value) -> Encoder a +toEncoder = Encoder + +fromJSON :: Value -> Decoder a -> a +fromJSON v (Decoder f) = f v + +toJSON :: a -> Encoder a -> Value +toJSON v (Encoder f) = f v + +set :: JSONSetter a => a -> Text -> b -> a +set = ffi "(function(obj, key, val) { obj[key] = val; return obj; })(%1, %2, %3)" + +get :: JSONGetter a => a -> Text -> b +get = ffi "%1[%2]" + +decodeRaw :: Text -> Value +decodeRaw = ffi "JSON.parse(%1)" + +encodeRaw :: Value -> Text +encodeRaw = ffi "JSON.stringify(%1)" + +decode :: JSONSetter a => Text -> Decoder a -> a +decode txt = fromJSON (decodeRaw txt) + +encode :: JSONGetter a => a -> Encoder a -> Text +encode obj up = encodeRaw $ toJSON obj up + +newValue :: Value +newValue = ffi "{}" + +newObject :: JSONSetter a => Text -> a +newObject = ffi "{instance: %1}" + +withDecoder :: JSONSetter a => Text -> KeyRefMap -> Decoder a +withDecoder ins params = toDecoder (go (newObject ins) params) + where go :: JSONSetter a => a -> KeyRefMap -> Value -> a + go obj ((ref, key):xs) v = go (set obj ref $ get v key) xs v + go obj [] _ = obj + +withEncoder :: JSONGetter a => KeyRefMap -> Encoder a +withEncoder params = toEncoder (go newValue params) + where go :: JSONGetter a => Value -> KeyRefMap -> a -> Value + go v ((ref,key):xs) obj = go (set v key $ get obj ref) xs obj + go v [] _ = v