hjson-query 0.4 → 1.0

raw patch · 3 files changed

+131/−86 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/Example1.hs +42/−20
• hjson-query.cabal +6/−6
• src/Text/HJson/Query.hs +83/−60

@@ -1,14 +1,8 @@-import Text.HJson hiding (toString)+import Text.HJson import Text.HJson.Query import Text.HJson.Pretty as PP ---- parse JSON-jParse :: String -> Json-jParse jstr = case (fromString  jstr) of-    Left l  -> error l-    Right json -> json+import Data.List -j0 = jParse "{}" j1 = jParse "{\"Europa\": {\"Ukraine\": [\"Kiyv\", \"Gitomir\", \"Lviv\"]}}" j2 = jParse "{\"Asia\": {\"Japan\": [\"Tokyo\"]}}" j3 = jParse "{\"Europa\": {\"UnitedKingdom\": [\"London\", \"Glasgow\"]}}"@@ -16,41 +10,69 @@ j5 = jParse "{\"Africa\": {}}" j6 = jParse"{\"America\": {\"USA\": [], \"Canada\": [\"Toronto\"]}}" j7 = jParse "{\"Australia\": [\"Melburn\", \"Adelaida\"]}"-merg = jMergesRec [j0, j1, j2, j3, j4, j5, j6, j7]-ex0 = putStrLn $ toString "   " merg----------------------------------------------------------------------------+merg = mergesRec [j1, j2, j3, j4, j5, j6, j7]+ex0 = putJson merg -pprint js = mapM_ putStrLn $ map (toString "   ") js --pretty print +---------------------------------------------------------------------------  query1 = getFromKeys ["Europa", "America", "Africa"]  json1 = query1 merg -ex1 = pprint json1+ex1 = putJsons json1+ ----------------------------------------------------------------------------record1 =  fromString "[\"Sidoroff\",\"Jhon\",1975,null]"-ex11 = getFromIndexes [3,1,0] `fmap` record1+record1 = "[\"Sidoroff\",\"Jhon\",1975,null]"+ex11 = debugQuery (getFromIndexes [3,1,0])  record1  ---------------------------------------------------------------------------  query2 = query1 >>> getFromObj  json2 = query2 merg-ex2 = pprint json2+ex2 = putJsons json2+ ---------------------------------------------------------------------------  -- Qwery:  All citys Europa, America, Australia and Africa q31 = getFromKeys ["Europa", "America", "Africa", "Australia"]    >>> (getFromArr `orElse`  getFromObj)   >>> (isStr `orElse` getFromArr)-ex31 = pprint $ q31 merg+ex31 = putJsons $ q31 merg  q32 = getFromKeys ["Europa", "America", "Africa", "Australia"]    >>> (getFromObj `when` isObj)   >>> getFromArr-ex32 = pprint $ q32 merg+ex32 = putJsons $ q32 merg  q33 = getFromKeys ["Europa", "America", "Africa", "Australia"]    >>>    deep getFromArr-ex33 = pprint $ q33 merg+ex33 = putJsons $ q33 merg  -----------------------------------------------------------------------------ex4 = debug (deep isPrimitive) "[1,[false, true, [null]]]"++ex4 = debugQuery (deep isPrimitive) "[1,[false, true, [null]]]"++--- Debug print and helpers ------------------------------------------------++--+debugQuery ::  JFilter -> String -> IO ()+debugQuery  query  jstr = case (fromString jstr) of+    Left errmsg -> error errmsg+    Right json  -> putStrLn $ pprints $ query json++--+putJson :: Json -> IO ()+putJson = putStrLn . pprint++--+putJsons :: Jsons -> IO ()+putJsons = putStrLn . pprints++-- parse JSON+jParse :: String -> Json+jParse jstr = case (fromString  jstr) of+    Left l  -> error l+    Right json -> json++pprint = PP.toString "    "++pprints js = concat $ intersperse "\n" $ map pprint js --pretty print 

@@ -1,5 +1,5 @@ Name:                hjson-query-Version:             0.4+Version:             1.0 Synopsis:            library for querying from JSON Category:            Text Description:         library(HXT-like) for querying from JSON@@ -9,8 +9,8 @@ Maintainer:          YuriyIskra  <iskra.yw@gmail.com> Stability:           Experimental Copyright:           Copyright (c) 2010 Yuriy Iskra-Build-type: Simple-Cabal-version: >= 1.6+Build-type:          Simple+Cabal-version:       >= 1.6  extra-source-files:   examples/Example1.hs@@ -24,6 +24,6 @@                    hs-source-dirs:      src -Source-repository head-    Type: git-    Location: git://github.com/iskra/hjson-query.git+--Source-repository head+--    Type: git+--    Location: git://github.com/iskra/hjson-query.git

@@ -1,5 +1,44 @@-module Text.HJson.Query where-import qualified Data.Map as M (empty, unionWith, elems, union, lookup)+module Text.HJson.Query+(+-- * Types+      Jsons+     ,JFilter+-- * Building+    ,emptyObj+    ,(-->)+    ,(<>)+    ,(<.>)+    ,merges+    ,mergesRec+-- * Filtering+    ,isObj+    ,isArr+    ,isStr+    ,isStrBy+    ,isNum+    ,isNumBy+    ,isBool+    ,isNull+    ,isPrimitive+    ,getFromKeys+    ,getFromObj+    ,getFromArr+    ,getFromIndex+    ,getFromIndexes+    ,getChildern+    ,getFromKey+-- * Filter Combinators+    ,(>>>)+    ,(<+>)+    ,orElse+    ,when+    ,guards+    ,deepObj+    ,deepArr+    ,deep+)+where+import qualified Data.Map as M (empty, singleton, unionWith, elems, union, lookup) import qualified Data.Maybe as Mb (catMaybes) import qualified Data.List as L (nub) import qualified Text.HJson.Pretty as PP (toString)@@ -10,44 +49,38 @@  infixl 1 >>> infixr 2 <+>+infixr 3 --> ---------------------------------------------------------------------------+-- Building  -- | create empty JSON object-jEmpty :: Json-jEmpty = JObject (M.empty)+emptyObj :: Json+emptyObj = JObject (M.empty) +-- | create JSON object+(-->) :: String -> Json -> Json+key --> val = JObject (M.singleton key val)+ -- | merge two JSON Objects-jMerge :: Json -> Json -> Json-jMerge (JObject x ) (JObject y)  = JObject $ M.union x y-jMerge _ _ = jEmpty+(<>) :: Json -> Json -> Json+(JObject x ) <> (JObject y)  = JObject $ M.union x y+(<>) _  _ = emptyObj   -- | recursive merge two JSON Objects-jMergeRec :: Json -> Json -> Json-jMergeRec (JObject x) (JObject y) = JObject $ M.unionWith (\m n -> jMergeRec m n) x y-jMmergeRec _ _    = jEmpty+(<.>) :: Json -> Json -> Json+(JObject x) <.> (JObject y) = JObject $ M.unionWith (\m n ->  m <.> n) x y+(<.>) _  _  = emptyObj  -- | merge list JSON Objects-jMerges :: [Json] -> Json-jMerges [] = jEmpty-jMerges js = foldl1 jMerge js+merges :: [Json] -> Json+merges [] = emptyObj+merges js = foldl1 (<>) js  -- | recursive merge lists JSON Objects -- -- Example: ----- > import Text.HJson  hiding (toString)--- > import Text.HJson.Query--- > import Text.HJson.Pretty--- > --- > --  Parse JSON--- > jParse :: String -> Json--- > jParse jstr = case (fromString  jstr) of--- >     Left l  -> error l--- >     Right json -> json--- > --- > j0 = jParse "{}" -- > j1 = jParse "{\"Europa\": {\"Ukraine\": [\"Kiyv\", \"Gitomir\", \"Lviv\"]}}" -- > j2 = jParse "{\"Asia\": {\"Japan\": [\"Tokyo\"]}}" -- > j3 = jParse "{\"Europa\": {\"UnitedKingdom\": [\"London\", \"Glasgow\"]}}"@@ -55,8 +88,8 @@ -- > j5 = jParse "{\"Africa\": {}}" -- > j6 = jParse"{\"America\": {\"USA\": [], \"Canada\": [\"Toronto\"]}}" -- > j7 = jParse "{\"Australia\": [\"Melburn\", \"Adelaida\"]}"--- > merg = jMergesRec [j0, j1, j2, j3, j4, j5, j6, j7]--- > ex0 = putStrLn $ toString "   " merg+-- > merg = mergsRec [j1, j2, j3, j4, j5, j6, j7]+-- > ex0 = putJson merg -- -- Result: --@@ -77,12 +110,10 @@ -- >      "UnitedKingdom": ["London", "Glasgow"] -- >   } -- >}--jMergesRec :: [Json] -> Json-jMergesRec [] = jEmpty-jMergesRec js = foldl1 jMergeRec js+mergesRec :: [Json] -> Json+mergesRec js = foldl (<.>) emptyObj js ---------------------------------------------------------------------------+-- Fitering  -- | filter JSON objects  isObj :: JFilter@@ -90,7 +121,6 @@ isObj _              = []  -- | filter JSON arrays--- Example  isArr :: JFilter isArr (JArray a)  = [JArray a] isArr _              = []@@ -100,11 +130,22 @@ isStr (JString s)  = [JString s] isStr _            = [] +-- | predicative filter JSON strings+isStrBy :: (String -> Bool) -> JFilter+isStrBy p (JString s)  = if p s then [JString s] else []+isStrBy _ _           = []+ -- | filter JSON numbers isNum :: JFilter isNum (JNumber n) = [JNumber n] isNum _           = [] ++-- | predicative filter JSON numbers+isNumBy :: Fractional a => (a -> Bool) -> JFilter+isNumBy p (JNumber n) = if p (fromRational n) then [JNumber n] else []+isNumBy _ _          = []+ -- | filter JSON Bool isBool :: JFilter isBool (JBool p)   = [JBool p]@@ -123,6 +164,7 @@ isPrimitive JNull        = [JNull] isPrimitive _            = [] + -- | get elements from object with key getFromKey :: String -> JFilter getFromKey k (JObject m) = Mb.catMaybes  [(M.lookup k m)]@@ -132,11 +174,9 @@ --  --  Example: -- --- > pprint js = mapM_ putStrLn $ map (toString "   ") js --pretty print --- -- > query1 = getFromKeys ["Europa", "America", "Africa"]  -- > json1 = query1 merg --- > ex1 = pprint json1+-- > ex1 = putJsons json1 --  -- Result: --@@ -152,7 +192,6 @@ -- > { -- >  -- > }- getFromKeys :: [String] -> JFilter getFromKeys ks (JObject m) = Mb.catMaybes $ map (\k -> (M.lookup k m)) (L.nub ks)  getFromKeys _ _            = []@@ -182,13 +221,11 @@ getChildern (JArray a)  = a getChildern _              = [] --- | filter combinators--- ---  Example:--- +-- | Example:+-- -- > query2 = query1 >>> getFromObj  -- > json2 = query2 merg--- > ex2 = pprint json2+-- > ex2 = putJsons json2 --  --  Result: -- @@ -197,15 +234,14 @@ -- > ["London", "Glasgow"] -- > ["Toronto"] -- > []---  (>>>)	    :: JFilter -> JFilter -> JFilter  (f >>> g) t =  concat [g t' | t' <- f t] --- | filter combinators+-- | concat result two filters (<+>)	    :: JFilter -> JFilter -> JFilter (f <+> g) t =  f t ++ g t --- | filter combinators+-- |  orElse	:: JFilter -> JFilter -> JFilter orElse f g t   | null res1 = g t@@ -213,13 +249,13 @@   where   res1 = f t --- | filter combinators+-- |  when	:: JFilter -> JFilter -> JFilter when f g t   | null (g t) = [t]   | otherwise  = f t --- | filter combinators+-- |  guards	:: JFilter -> JFilter -> JFilter guards g f t   | null (g t) = []@@ -254,18 +290,5 @@ -- > --  --  See also: <www.haskell.org/haskellwiki/HXT> --- | deep	:: JFilter -> JFilter deep f  = f `orElse` (getChildern >>> deep f)----- Debug -------------------------------------------------------------------- | pretty print query from JSON string------ > debug (deep isPrimitive) "[1, [false, true, [null]]]" == "[1, false, true, null]"----debug ::  JFilter -> String ->  String-debug  query  jstr = case (fromString jstr) of-    Left errmsg -> error errmsg-    Right json  -> PP.toString "-  "$ JArray $ query json-