{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module HaskellWorks.Data.Json.Query where

import Control.Arrow
import Data.Text                        (Text)
import HaskellWorks.Data.Json.LightJson
import HaskellWorks.Data.MQuery
import HaskellWorks.Data.MQuery.Entry
import Prelude                          hiding (drop)

import qualified Data.Attoparsec.ByteString.Char8 as ABC
import qualified Data.DList                       as DL
import qualified Data.Text                        as T

item :: LightJsonAt c => LightJson c -> MQuery (LightJson c)
item :: forall c. LightJsonAt c => LightJson c -> MQuery (LightJson c)
item LightJson c
jpv = case LightJson c
jpv of
  LightJsonArray [c]
es -> forall a. DList a -> MQuery a
MQuery forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList (forall a. LightJsonAt a => a -> LightJson a
lightJsonAt forall a b. (a -> b) -> [a] -> [b]
`map` [c]
es)
  LightJson c
_                 -> forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

entry :: LightJsonAt c => LightJson c -> MQuery (Entry Text (LightJson c))
entry :: forall c.
LightJsonAt c =>
LightJson c -> MQuery (Entry Text (LightJson c))
entry LightJson c
jpv = case LightJson c
jpv of
  LightJsonObject [(Text, c)]
fs -> forall a. DList a -> MQuery a
MQuery forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList ((forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. k -> v -> Entry k v
Entry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. LightJsonAt a => a -> LightJson a
lightJsonAt) forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, c)]
fs)
  LightJson c
_                  -> forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

asString :: LightJson c -> MQuery Text
asString :: forall c. LightJson c -> MQuery Text
asString LightJson c
jpv = case LightJson c
jpv of
  LightJsonString Text
s -> forall a. DList a -> MQuery a
MQuery forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DL.singleton Text
s
  LightJson c
_                 -> forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

asDouble :: LightJson c -> MQuery Double
asDouble :: forall c. LightJson c -> MQuery Double
asDouble LightJson c
jpv = case LightJson c
jpv of
  LightJsonNumber ByteString
sn  -> case forall a. Parser a -> ByteString -> Result a
ABC.parse forall a. Fractional a => Parser a
ABC.rational ByteString
sn of
    ABC.Fail    {}    -> forall a. DList a -> MQuery a
MQuery forall a. DList a
DL.empty
    ABC.Partial ByteString -> IResult ByteString Double
f     -> case ByteString -> IResult ByteString Double
f ByteString
" " of
      ABC.Fail    {}  -> forall a. DList a -> MQuery a
MQuery forall a. DList a
DL.empty
      ABC.Partial ByteString -> IResult ByteString Double
_   -> forall a. DList a -> MQuery a
MQuery forall a. DList a
DL.empty
      ABC.Done    ByteString
_ Double
r -> forall a. DList a -> MQuery a
MQuery (forall a. a -> DList a
DL.singleton Double
r)
    ABC.Done    ByteString
_ Double
r   -> forall a. DList a -> MQuery a
MQuery (forall a. a -> DList a
DL.singleton Double
r)
  LightJson c
_                   -> forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

asInteger :: LightJson c -> MQuery Integer
asInteger :: forall c. LightJson c -> MQuery Integer
asInteger LightJson c
jpv = do
  Double
d <- forall c. LightJson c -> MQuery Double
asDouble LightJson c
jpv
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (RealFrac a, Integral b) => a -> b
floor Double
d)

castAsInteger :: LightJson c -> MQuery Integer
castAsInteger :: forall c. LightJson c -> MQuery Integer
castAsInteger LightJson c
jpv = case LightJson c
jpv of
  LightJsonString Text
n -> forall a. DList a -> MQuery a
MQuery forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DL.singleton (forall a. Read a => String -> a
read (Text -> String
T.unpack Text
n)) -- TODO Optimise
  LightJsonNumber ByteString
_ -> forall c. LightJson c -> MQuery Integer
asInteger LightJson c
jpv
  LightJson c
_                 -> forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

named :: Text -> Entry Text (LightJson c) -> MQuery (LightJson c)
named :: forall c. Text -> Entry Text (LightJson c) -> MQuery (LightJson c)
named Text
fieldName (Entry Text
fieldName' LightJson c
jpv) | Text
fieldName forall a. Eq a => a -> a -> Bool
== Text
fieldName'  = forall a. DList a -> MQuery a
MQuery forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DL.singleton LightJson c
jpv
named Text
_         Entry Text (LightJson c)
_                      = forall a. DList a -> MQuery a
MQuery   forall a. DList a
DL.empty

jsonKeys :: LightJson c -> [Text]
jsonKeys :: forall c. LightJson c -> [Text]
jsonKeys LightJson c
jpv = case LightJson c
jpv of
  LightJsonObject [(Text, c)]
fs -> forall a b. (a, b) -> a
fst forall a b. (a -> b) -> [a] -> [b]
`map` [(Text, c)]
fs
  LightJson c
_                  -> []

hasKey :: Text -> LightJson c -> Bool
hasKey :: forall c. Text -> LightJson c -> Bool
hasKey Text
fieldName LightJson c
jpv = Text
fieldName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall c. LightJson c -> [Text]
jsonKeys LightJson c
jpv

jsonSize :: LightJson c -> MQuery Integer
jsonSize :: forall c. LightJson c -> MQuery Integer
jsonSize LightJson c
jpv = case LightJson c
jpv of
  LightJsonArray  [c]
es -> forall a. DList a -> MQuery a
MQuery (forall a. a -> DList a
DL.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [c]
es)))
  LightJsonObject [(Text, c)]
es -> forall a. DList a -> MQuery a
MQuery (forall a. a -> DList a
DL.singleton (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, c)]
es)))
  LightJson c
_                  -> forall a. DList a -> MQuery a
MQuery (forall a. a -> DList a
DL.singleton Integer
0)