Query.hs

{-# LANGUAGE ParallelListComp #-}

-- | See also: <http://www.haskell.org/haskellwiki/HXT#The_concept_of_filters>
module Data.JSON2.Query
  ( -- * Data Types
    JFilter
  -- * Filtering primitive types
  , isStr, isStrBy
  , isNum, isNumBy
  , isBool, isTrue, isFalse
  , isNull, isAtomic
  -- * Filtering JSON objects
  , isObj
  , getFromObj, getFromKey
  , getFromKeys, getFromKeyBy
  -- * Filtering JSON arrays
  , isArr
  , getFromArr, getFromIndex
  , getFromIndexes, getFromIndexBy
  -- * Filtering JSON arrays and objects
  , getChildern
  -- * Filter Combinators
  , (>>>), (<+>)
  , orElse, when, guards
  , deep, deepObj, deepArr
  )
where
import qualified Data.Map as M (empty, singleton, unionWith,
                                filterWithKey, elems, union, lookup)
import qualified Data.Maybe as Mb (catMaybes)
import qualified Data.List as L (nub)
import Data.JSON2.Types

type JFilter = Json -> Jsons

infixl 1 >>>
infixr 2 <+>

-- Fitering

-- | Filter `Json` objects.
isObj :: JFilter
isObj (JObject o) = [JObject o]
isObj _              = []

-- | Filter `Json` arrays.
isArr :: JFilter
isArr (JArray a)  = [JArray a]
isArr _              = []

-- | Filter `Json` strings.
isStr :: JFilter
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]
isBool _           = []

-- | Filter `Json` True.
isTrue :: JFilter
isTrue (JBool True)   = [JBool True]
isTrue _           = []

-- | Filter `Json` False.
isFalse :: JFilter
isFalse (JBool False)   = [JBool False]
isFalse _           = []

-- | Filter `Json` null.
isNull :: JFilter
isNull JNull = [JNull]
isNull _ = []

-- | Filter primitive types.
isAtomic :: JFilter
isAtomic (JString s)  = [JString s]
isAtomic (JNumber n)  = [JNumber n]
isAtomic (JBool p)    = [JBool p]
isAtomic JNull        = [JNull]
isAtomic _            = []

-- | 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.
getFromKeys :: [String] -> JFilter
getFromKeys ks (JObject m) = Mb.catMaybes $ map (\k -> (M.lookup k m)) (L.nub ks) 
getFromKeys _ _            = []

-- | Get elements from object with key by.
getFromKeyBy :: (String -> Bool) -> JFilter
getFromKeyBy f (JObject m) = M.elems $ M.filterWithKey (\k _ -> f k) m
getFromKeyBy _ _           = []

-- | 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) = [a !! i | i <length a]
getFromIndex _ _          = []

{-# DEPRECATED getFromIndexes "use: getFromIndexBy" #-}
-- | Get elements from array with index by.
--
-- DEPRECATED use: getFromIndexBy
getFromIndexes :: [Int] -> JFilter
getFromIndexes is ja = concat [getFromIndex i ja | i <- is]

-- | Get elements from array with indexes.
getFromIndexBy :: (Int -> Bool) -> JFilter
getFromIndexBy f (JArray xs) =  [y| (y,k) <- [(x,i) | x <- xs | i <- [0..]], f k]
getFromIndexBy _ _           = []

-- | Get all elements from object and array.
getChildern :: JFilter
getChildern (JObject o) = M.elems o
getChildern (JArray a)  = a
getChildern _              = []

--  Filter combinators

-- | @(f >>> g)@  - Apply filter f, later filter g .
(>>>) :: JFilter -> JFilter -> JFilter 
(f >>> g) t =  concat [g t' | t' <- f t]

-- | Concat results two filters.
(<+>) :: JFilter -> JFilter -> JFilter
(f <+> g) t =  f t ++ g t

-- | @(f `orElse` g)@ - Apply f, if @f@ returned @empty@ apply @g@.
orElse :: JFilter -> JFilter -> JFilter
orElse f g t
  | null res1 = g t
  | otherwise = res1
    where res1 = f t

-- | @(f `when` g)@ - When @g@ returned @not empty@, apply @f@.
when :: JFilter -> JFilter -> JFilter
when f g t
  | null (g t) = [t]
  | otherwise  = f t
 
-- | @(f `guards` g )@ - If @f@ returned @empty@ then @empty@ else apply @g@.
guards	:: JFilter -> JFilter -> JFilter
guards f g t
  | null (f t) = []
  | otherwise  = g t


-- | Tree traversal filter for object and array.
deep	:: JFilter -> JFilter
deep f  = f `orElse` (getChildern >>> deep f)

-- | Tree traversal filter for array.
deepObj	:: JFilter -> JFilter
deepObj f  = f `orElse` (getFromObj >>> deepObj f)
deepArr :: JFilter -> JFilter
deepArr f  = f `orElse` (getFromArr >>> deepArr f)