{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}

module Data.Medea.JSONType
  ( JSONType (..),
    typeOf,
  )
where

import Data.Aeson (Value (..))
import Data.Hashable (Hashable)
import GHC.Generics (Generic)

-- | The basic types of JSON value (as per
-- [ECMA-404](http://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf)).
data JSONType
  = JSONNull
  | JSONBoolean
  | JSONNumber
  | JSONString
  | JSONArray
  | JSONObject
  deriving stock (JSONType -> JSONType -> Bool
(JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool) -> Eq JSONType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONType -> JSONType -> Bool
$c/= :: JSONType -> JSONType -> Bool
== :: JSONType -> JSONType -> Bool
$c== :: JSONType -> JSONType -> Bool
Eq, Eq JSONType
Eq JSONType
-> (JSONType -> JSONType -> Ordering)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> Bool)
-> (JSONType -> JSONType -> JSONType)
-> (JSONType -> JSONType -> JSONType)
-> Ord JSONType
JSONType -> JSONType -> Bool
JSONType -> JSONType -> Ordering
JSONType -> JSONType -> JSONType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JSONType -> JSONType -> JSONType
$cmin :: JSONType -> JSONType -> JSONType
max :: JSONType -> JSONType -> JSONType
$cmax :: JSONType -> JSONType -> JSONType
>= :: JSONType -> JSONType -> Bool
$c>= :: JSONType -> JSONType -> Bool
> :: JSONType -> JSONType -> Bool
$c> :: JSONType -> JSONType -> Bool
<= :: JSONType -> JSONType -> Bool
$c<= :: JSONType -> JSONType -> Bool
< :: JSONType -> JSONType -> Bool
$c< :: JSONType -> JSONType -> Bool
compare :: JSONType -> JSONType -> Ordering
$ccompare :: JSONType -> JSONType -> Ordering
$cp1Ord :: Eq JSONType
Ord, Int -> JSONType -> ShowS
[JSONType] -> ShowS
JSONType -> String
(Int -> JSONType -> ShowS)
-> (JSONType -> String) -> ([JSONType] -> ShowS) -> Show JSONType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONType] -> ShowS
$cshowList :: [JSONType] -> ShowS
show :: JSONType -> String
$cshow :: JSONType -> String
showsPrec :: Int -> JSONType -> ShowS
$cshowsPrec :: Int -> JSONType -> ShowS
Show, (forall x. JSONType -> Rep JSONType x)
-> (forall x. Rep JSONType x -> JSONType) -> Generic JSONType
forall x. Rep JSONType x -> JSONType
forall x. JSONType -> Rep JSONType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSONType x -> JSONType
$cfrom :: forall x. JSONType -> Rep JSONType x
Generic)
  deriving anyclass (Int -> JSONType -> Int
JSONType -> Int
(Int -> JSONType -> Int) -> (JSONType -> Int) -> Hashable JSONType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: JSONType -> Int
$chash :: JSONType -> Int
hashWithSalt :: Int -> JSONType -> Int
$chashWithSalt :: Int -> JSONType -> Int
Hashable)

-- | Helper for determining the type of an Aeson 'Value'.
typeOf :: Value -> JSONType
typeOf :: Value -> JSONType
typeOf = \case
  Object Object
_ -> JSONType
JSONObject
  Array Array
_ -> JSONType
JSONArray
  String Text
_ -> JSONType
JSONString
  Number Scientific
_ -> JSONType
JSONNumber
  Bool Bool
_ -> JSONType
JSONBoolean
  Value
Null -> JSONType
JSONNull