MQuery.hs

{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}

module HaskellWorks.Data.MQuery where

import           Control.Monad
import qualified Data.DList                           as DL
import           GHC.Base
import           HaskellWorks.Data.Json.PartialValue
import           HaskellWorks.Data.Mini

newtype MQuery a = MQuery (DL.DList a)

deriving instance Functor     MQuery
deriving instance Applicative MQuery
deriving instance Monad       MQuery
deriving instance Alternative MQuery
deriving instance MonadPlus   MQuery

instance Show (MQuery JsonPartialValue) where
  showsPrec _ (MQuery das) = shows (Mini (Mini `fmap` das))

instance Show (MQuery (String, JsonPartialValue)) where
  showsPrec _ (MQuery das) = shows (Mini (Mini `fmap` das))

expandArray :: JsonPartialValue -> MQuery JsonPartialValue
expandArray jpv = case jpv of
  JsonPartialArray es -> MQuery $ DL.fromList es
  _                   -> MQuery   DL.empty

expandObject :: JsonPartialValue -> MQuery (String, JsonPartialValue)
expandObject jpv = case jpv of
  JsonPartialObject fs  -> MQuery $ DL.fromList fs
  _                     -> MQuery   DL.empty

selectField :: String -> (String, JsonPartialValue) -> MQuery JsonPartialValue
selectField fieldName (fieldName', jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv
selectField _         _                                           = MQuery   DL.empty

jsonKeys :: JsonPartialValue -> [String]
jsonKeys jpv = case jpv of
  JsonPartialObject fs  -> fst `map` fs
  _                     -> []

hasKey :: String -> JsonPartialValue -> Bool
hasKey fieldName jpv = fieldName `elem` jsonKeys jpv

inArray :: MQuery JsonPartialValue -> MQuery JsonPartialValue
inArray jpvs = jpvs >>= expandArray

jsonSize :: JsonPartialValue -> MQuery JsonPartialValue
jsonSize jpv = case jpv of
  JsonPartialArray  es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))
  JsonPartialObject es  -> MQuery (DL.singleton (JsonPartialNumber (fromIntegral (length es))))
  _                     -> MQuery (DL.singleton (JsonPartialNumber 0))