diff --git a/examples/Example1.hs b/examples/Example1.hs --- a/examples/Example1.hs +++ b/examples/Example1.hs @@ -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 diff --git a/hjson-query.cabal b/hjson-query.cabal --- a/hjson-query.cabal +++ b/hjson-query.cabal @@ -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 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 diff --git a/src/Text/HJson/Query.hs b/src/Text/HJson/Query.hs --- a/src/Text/HJson/Query.hs +++ b/src/Text/HJson/Query.hs @@ -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: --- | 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 -