diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,9 +4,12 @@ SimpleJSON library for Fay. ```haskell +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RebindableSyntax #-} +-- Compile with: fay --package fay-simplejson test.hs --pretty + module Test (main) where import Data.Text (Text, fromString) @@ -14,18 +17,18 @@ 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"] +decoder :: Parser +decoder = withDecoder "Test" [ rawRule "xKey" "key", + rawRule "xValue" "value" ] -encoder :: Encoder TestJSON -encoder = withEncoder ["key" .< "xKey", "value" .< "xValue"] +encoder :: Parser +encoder = withEncoder [ rawRule "key" "xKey", + rawRule "value" "xValue" ] main :: Fay () main = do - let test = decode "{\"key\": \"test_key\", \"value\": \"test_value\"}" decoder + let test = decode "{\"key\": \"test_key\", \"value\": \"test_value\"}" decoder :: Test print test print $ encode test encoder ``` diff --git a/fay-simplejson.cabal b/fay-simplejson.cabal --- a/fay-simplejson.cabal +++ b/fay-simplejson.cabal @@ -1,5 +1,5 @@ name: fay-simplejson -version: 0.1.1.0 +version: 0.1.3.0 synopsis: SimpleJSON library for Fay. description: SimpleJSON library for Fay. homepage: https://github.com/Lupino/fay-simplejson diff --git a/src/SimpleJSON.hs b/src/SimpleJSON.hs --- a/src/SimpleJSON.hs +++ b/src/SimpleJSON.hs @@ -7,96 +7,186 @@ module SimpleJSON ( Value, - Decoder, - Encoder, - toDecoder, - toEncoder, - fromJSON, - toJSON, + Parser, + toParser, + rawParser, + maybeParser, + fromMaybeParser, + listParser, + (<<<), + Rule, + rawRule, + rule, + listRule, + runParser, + runListParser, withDecoder, withEncoder, decode, encode, decodeRaw, encodeRaw, - JSONSetter, - JSONGetter, - KeyRef, - KeyRefMap, - (.>), - (.<), - get, - set ) where -import Data.Text (Text, fromString) -import FFI (ffi) +import Data.Text (Text, fromString) +import Fay.Unsafe (unsafePerformFay) +import FFI (ffi) import Prelude +import Unsafe.Coerce (unsafeCoerce) data Value -class JSONGetter v -instance JSONGetter Value +newtype Parser = Parser (Value -> Fay Value) -class JSONSetter v -instance JSONSetter Value +data Rule = Rule Parser Text Text -newtype Decoder a = Decoder (Value -> a) -newtype Encoder a = Encoder (a -> Value) +rule :: Parser -> Text -> Text -> Rule +rule = Rule -type KeyRef = (Text,Text) -type KeyRefMap = [KeyRef] +rawRule :: Text -> Text -> Rule +rawRule = rule rawParser -(.>) :: Text -> Text -> KeyRef -a .> b = (a, b) +listRule :: Parser -> Text -> Text -> Rule +listRule p = rule (listParser p) -(.<) :: Text -> Text -> KeyRef -a .< b = (b, a) +runRule :: Rule -> Value -> Value -> Fay Value +runRule (Rule p ref key) v0 v1 = set v0 ref =<< runParser p =<< get v1 key -toDecoder :: (Value -> a) -> Decoder a -toDecoder = Decoder +toParser :: (Value -> Fay Value) -> Parser +toParser = Parser -toEncoder :: (a -> Value) -> Encoder a -toEncoder = Encoder +rawParser :: Parser +rawParser = toParser return -fromJSON :: Value -> Decoder a -> a -fromJSON v (Decoder f) = f v +(<<<) :: (Parser -> Parser) ->Parser -> Parser +f <<< p = f p +infixr 1 <<< -toJSON :: a -> Encoder a -> Value -toJSON v (Encoder f) = f v +isNull :: Value -> Bool +isNull = ffi "(function(v) {\ + \ if (!v) {\ + \ return true;\ + \ }\ + \ if (Array.isArray(v)) {\ + \ return v.length === 0;\ + \ } else if (typeof v === 'object') {\ + \ for (var i in v) {\ + \ return false;\ + \ }\ + \ return true;\ + \ }\ + \ return false;\ + \})(%1)" -set :: JSONSetter a => a -> Text -> b -> a +maybeParser :: Parser -> Parser +maybeParser p = toParser toMaybe + where toMaybe :: Value -> Fay Value + toMaybe v | isNull v = nothing + | otherwise = just v + + where nothing :: Fay Value + nothing = newValue' "Nothing" + just :: Value -> Fay Value + just v' = do o <- newValue' "Just" + set o "slot1" =<< runParser p v' + +nullValue :: Value +nullValue = ffi "undefined" + +fromMaybeParser :: Parser -> Parser +fromMaybeParser p = toParser $ \v -> do + ins <- get v "_instance" + if ins == "Just" then + runParser p =<< get v "slot1" + else + return nullValue + + +listParser :: Parser -> Parser +listParser p = toParser $ runListParser p + +runParser :: Parser -> Value -> Fay Value +runParser (Parser f) v = f v + +runListParser :: Parser -> Value -> Fay Value +runListParser p v = do + parsed <- mapM (runParser p) =<< toList v + return $ unsafeCoerce parsed + +toList :: Value -> Fay [Value] +toList = ffi "(function(v){ if (Array.isArray(v)){ return v; } else if (v) { return [v]; } else { return [] } })(%1)" + +set :: Value -> Text -> b -> Fay Value set = ffi "(function(obj, key, val) { obj[key] = val; return obj; })(%1, %2, %3)" -get :: JSONGetter a => a -> Text -> b -get = ffi "%1[%2]" +get :: Value -> Text -> Fay b +get = ffi "(function(v, k) { if (v) {return v[k]; } else { return undefined }})(%1, %2)" -decodeRaw :: Text -> Value +isList :: Value -> Bool +isList = ffi "Array.isArray(%1)" + +decodeRaw :: Text -> Fay Value decodeRaw = ffi "JSON.parse(%1)" -encodeRaw :: Value -> Text +encodeRaw :: Value -> Fay Text encodeRaw = ffi "JSON.stringify(%1)" -decode :: JSONSetter a => Text -> Decoder a -> a -decode txt = fromJSON (decodeRaw txt) +decode :: Text -> Parser -> a +decode txt p = unsafePerformFay $ fixedInstance =<< runP p v + where v = unsafePerformFay $ decodeRaw txt + runP = if isList v then runListParser else runParser -encode :: JSONGetter a => a -> Encoder a -> Text -encode obj up = encodeRaw $ toJSON obj up +fixedInstance :: Value -> Fay a +fixedInstance = ffi "(function(v){\ + \ function fixedObject(v) {\ + \ var o = {};\ + \ for (var k in v) {\ + \ if (k === '_instance') {\ + \ o[k.substr(1)] = v[k];\ + \ continue;\ + \ }\ + \ if (k === 'instance') {\ + \ o['_' + k] = v[k];\ + \ continue;\ + \ }\ + \ o[k] = fixed(v[k]);\ + \ }\ + \ return o;\ + \ }\ + \ function fixedArray(v) {\ + \ return v.map(fixed);\ + \ }\ + \ function fixed(v) {\ + \ if (Array.isArray(v)) {\ + \ return fixedArray(v);\ + \ } else if (typeof v === 'object') {\ + \ return fixedObject(v);\ + \ } else {\ + \ return v\ + \ }\ + \ }\ + \ return fixed(v);\ + \})(%1)" -newValue :: Value +encode :: a -> Parser -> Text +encode obj p = unsafePerformFay (encodeRaw =<< runP p =<< fixedInstance v) + where v = unsafeCoerce obj :: Value + runP = if isList v then runListParser else runParser + +newValue :: Fay Value newValue = ffi "{}" -newObject :: JSONSetter a => Text -> a -newObject = ffi "{instance: %1}" +newValue' :: Text -> Fay Value +newValue' = 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 +doParser :: Fay Value -> [Rule] -> Value -> Fay Value +doParser obj rules ref = go ref rules =<< obj + where go :: Value -> [Rule] -> Value -> Fay Value + go v (x:xs) o = go v xs =<< runRule x o v + go _ [] o = return o -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 +withDecoder :: Text -> [Rule] -> Parser +withDecoder ins rules = toParser (doParser (newValue' ins) rules) + +withEncoder :: [Rule] -> Parser +withEncoder rules = toParser (doParser newValue rules)