fay-simplejson 0.1.1.0 → 0.1.3.0
raw patch · 3 files changed
+159/−66 lines, 3 files
Files
- README.md +10/−7
- fay-simplejson.cabal +1/−1
- src/SimpleJSON.hs +148/−58
README.md view
@@ -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 ```
fay-simplejson.cabal view
@@ -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
src/SimpleJSON.hs view
@@ -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)