module Text.HJson.Query where import qualified Data.Map as M (empty, 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) import Text.HJson type Jsons = [Json] type JFilter = Json -> Jsons infixl 1 >>> infixr 2 <+> -------------------------------------------------------------------------- -- | create empty JSON object jEmpty :: Json jEmpty = JObject (M.empty) -- | merge two JSON Objects jMerge :: Json -> Json -> Json jMerge (JObject x ) (JObject y) = JObject $ M.union x y jMerge _ _ = jEmpty -- | 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 -- | merge list JSON Objects jMerges :: [Json] -> Json jMerges [] = jEmpty jMerges js = foldl1 jMerge 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\"]}}" -- > j4 = jParse "{\"Europa\": {\"Germany\": [\"Berlin\", \"Bonn\"]}}" -- > 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 -- -- Result: -- -- >{ -- > "Africa": { -- > }, -- > "America": { -- > "Canada": ["Toronto"], -- > "USA": [] -- > }, -- > "Asia": { -- > "Japan": ["Tokyo"] -- > }, -- > "Australia": ["Melburn", "Adelaida"], -- > "Europa": { -- > "Germany": ["Berlin", "Bonn"], -- > "Ukraine": ["Kiyv", "Gitomir", "Lviv"], -- > "UnitedKingdom": ["London", "Glasgow"] -- > } -- >} jMergesRec :: [Json] -> Json jMergesRec [] = jEmpty jMergesRec js = foldl1 jMergeRec js -------------------------------------------------------------------------- -- | filter JSON objects isObj :: JFilter isObj (JObject o) = [JObject o] isObj _ = [] -- | filter JSON arrays -- Example isArr :: JFilter isArr (JArray a) = [JArray a] isArr _ = [] -- | filter JSON strings isStr :: JFilter isStr (JString s) = [JString s] isStr _ = [] -- | filter JSON numbers isNum :: JFilter isNum (JNumber n) = [JNumber n] isNum _ = [] -- | filter JSON Bool isBool :: JFilter isBool (JBool p) = [JBool p] isBool _ = [] -- | filter JSON null isNull :: JFilter isNull JNull = [JNull] isNull _ = [] -- | filter primitive types isPrimitive :: JFilter isPrimitive (JString s) = [JString s] isPrimitive (JNumber n) = [JNumber n] isPrimitive (JBool p) = [JBool p] isPrimitive JNull = [JNull] isPrimitive _ = [] -- | get elements from object with key getFromKey :: String -> JFilter getFromKey k (JObject m) = Mb.catMaybes [(M.lookup k m)] getFromKey _ _ = [] -- | get elements from object with keys -- -- Example: -- -- > pprint js = mapM_ putStrLn $ map (toString " ") js --pretty print -- -- > query1 = getFromKeys ["Europa", "America", "Africa"] -- > json1 = query1 merg -- > ex1 = pprint json1 -- -- Result: -- -- > { -- > "Germany": ["Berlin", "Bonn"], -- > "Ukraine": ["Kiyv", "Gitomir", "Lviv"], -- > "UnitedKingdom": ["London", "Glasgow"] -- > } -- > { -- > "Canada": ["Toronto"], -- > "USA": [] -- > } -- > { -- > -- > } getFromKeys :: [String] -> JFilter getFromKeys ks (JObject m) = Mb.catMaybes $ map (\k -> (M.lookup k m)) (L.nub ks) getFromKeys _ _ = [] -- | get all elements from object getFromObj :: JFilter getFromObj (JObject o) = M.elems o getFromObj _ = [] -- | get all elements from array getFromArr :: JFilter getFromArr (JArray a) = a getFromArr _ = [] -- | get element from array with index getFromIndex :: Int -> JFilter getFromIndex i (JArray a) = if i < length a then [a !! i] else [] getFromIndex _ _ = [] -- | get elements from array with indexes getFromIndexes :: [Int] -> JFilter getFromIndexes is ja = concat [getFromIndex i ja | i <- is] -- | get all elements from object and array getChildern :: JFilter getChildern (JObject o) = M.elems o getChildern (JArray a) = a getChildern _ = [] -- | filter combinators -- -- Example: -- -- > query2 = query1 >>> getFromObj -- > json2 = query2 merg -- > ex2 = pprint json2 -- -- Result: -- -- > ["Berlin", "Bonn"] -- > ["Kiyv", "Gitomir", "Lviv"] -- > ["London", "Glasgow"] -- > ["Toronto"] -- > [] -- (>>>) :: JFilter -> JFilter -> JFilter (f >>> g) t = concat [g t' | t' <- f t] -- | filter combinators (<+>) :: JFilter -> JFilter -> JFilter (f <+> g) t = f t ++ g t -- | filter combinators orElse :: JFilter -> JFilter -> JFilter orElse f g t | null res1 = g t | otherwise = res1 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) = [] | otherwise = f t -- | tree traversal filter for object deepObj :: JFilter -> JFilter deepObj f = f `orElse` (getFromObj >>> deepObj f) -- | tree traversal filter for array deepArr :: JFilter -> JFilter deepArr f = f `orElse` (getFromArr >>> deepArr f) -- | tree traversal filter for objects and arrays -- -- Example: -- -- > -- Qwery: All city Europa, America, Australia and Africa -- > -- q31, q32, q33 is equal -- > -- > q31 = getFromKeys ["Europa", "America", "Africa", "Australia"] -- > >>> (getFromArr `orElse` getFromObj) -- > >>> (isStr `orElse` getFromArr) -- > -- > q32 = getFromKeys ["Europa", "America", "Africa", "Australia"] -- > >>> (getFromObj `when` isObj) -- > >>> getFromArr -- > -- > q33 = getFromKeys ["Europa", "America", "Africa", "Australia"] -- > >>> -- > deep getFromArr -- > -- -- 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