{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# 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 :: LightJson c -> MQuery (LightJson c)
item LightJson c
jpv = case LightJson c
jpv of
  LightJsonArray [c]
es -> DList (LightJson c) -> MQuery (LightJson c)
forall a. DList a -> MQuery a
MQuery (DList (LightJson c) -> MQuery (LightJson c))
-> DList (LightJson c) -> MQuery (LightJson c)
forall a b. (a -> b) -> a -> b
$ [LightJson c] -> DList (LightJson c)
forall a. [a] -> DList a
DL.fromList (c -> LightJson c
forall a. LightJsonAt a => a -> LightJson a
lightJsonAt (c -> LightJson c) -> [c] -> [LightJson c]
forall a b. (a -> b) -> [a] -> [b]
`map` [c]
es)
  LightJson c
_                 -> DList (LightJson c) -> MQuery (LightJson c)
forall a. DList a -> MQuery a
MQuery   DList (LightJson c)
forall a. DList a
DL.empty

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

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

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

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

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

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

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

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

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