{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Jordan.Types.JSONValue
    ( JSONValue (..)
    ) where

import Data.Functor (($>))
import Data.Functor.Contravariant (Contravariant(..))
import qualified Data.Map.Strict as Map
import Data.Scientific (Scientific)
import Data.Text (Text)
import GHC.Generics (Generic(..))
import Jordan.FromJSON.Class (FromJSON(..), JSONParser(..))
import Jordan.ToJSON.Class (JSONSerializer(..), Selectable(..), ToJSON(..), selected)

-- | A type for any JSON value.
-- This is a basic Haskell sum type representation.
--
-- This is intended to for use when working with JSON where you do not know much about its structure.
data JSONValue
  = JNull
  | JBool Bool
  | JText Text
  | JNumber Scientific
  | JArray [JSONValue]
  | JObject (Map.Map Text JSONValue)
  deriving (Int -> JSONValue -> ShowS
[JSONValue] -> ShowS
JSONValue -> String
(Int -> JSONValue -> ShowS)
-> (JSONValue -> String)
-> ([JSONValue] -> ShowS)
-> Show JSONValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JSONValue] -> ShowS
$cshowList :: [JSONValue] -> ShowS
show :: JSONValue -> String
$cshow :: JSONValue -> String
showsPrec :: Int -> JSONValue -> ShowS
$cshowsPrec :: Int -> JSONValue -> ShowS
Show, JSONValue -> JSONValue -> Bool
(JSONValue -> JSONValue -> Bool)
-> (JSONValue -> JSONValue -> Bool) -> Eq JSONValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JSONValue -> JSONValue -> Bool
$c/= :: JSONValue -> JSONValue -> Bool
== :: JSONValue -> JSONValue -> Bool
$c== :: JSONValue -> JSONValue -> Bool
Eq, Eq JSONValue
Eq JSONValue
-> (JSONValue -> JSONValue -> Ordering)
-> (JSONValue -> JSONValue -> Bool)
-> (JSONValue -> JSONValue -> Bool)
-> (JSONValue -> JSONValue -> Bool)
-> (JSONValue -> JSONValue -> Bool)
-> (JSONValue -> JSONValue -> JSONValue)
-> (JSONValue -> JSONValue -> JSONValue)
-> Ord JSONValue
JSONValue -> JSONValue -> Bool
JSONValue -> JSONValue -> Ordering
JSONValue -> JSONValue -> JSONValue
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 :: JSONValue -> JSONValue -> JSONValue
$cmin :: JSONValue -> JSONValue -> JSONValue
max :: JSONValue -> JSONValue -> JSONValue
$cmax :: JSONValue -> JSONValue -> JSONValue
>= :: JSONValue -> JSONValue -> Bool
$c>= :: JSONValue -> JSONValue -> Bool
> :: JSONValue -> JSONValue -> Bool
$c> :: JSONValue -> JSONValue -> Bool
<= :: JSONValue -> JSONValue -> Bool
$c<= :: JSONValue -> JSONValue -> Bool
< :: JSONValue -> JSONValue -> Bool
$c< :: JSONValue -> JSONValue -> Bool
compare :: JSONValue -> JSONValue -> Ordering
$ccompare :: JSONValue -> JSONValue -> Ordering
$cp1Ord :: Eq JSONValue
Ord, (forall x. JSONValue -> Rep JSONValue x)
-> (forall x. Rep JSONValue x -> JSONValue) -> Generic JSONValue
forall x. Rep JSONValue x -> JSONValue
forall x. JSONValue -> Rep JSONValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JSONValue x -> JSONValue
$cfrom :: forall x. JSONValue -> Rep JSONValue x
Generic)

instance FromJSON JSONValue where
  fromJSON :: f JSONValue
fromJSON
    = (f ()
forall (f :: * -> *). JSONParser f => f ()
parseNull f () -> JSONValue -> f JSONValue
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONValue
JNull)
    f JSONValue -> f JSONValue -> f JSONValue
forall a. Semigroup a => a -> a -> a
<> (Text -> JSONValue
JText (Text -> JSONValue) -> f Text -> f JSONValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Text
forall (f :: * -> *). JSONParser f => f Text
parseText)
    f JSONValue -> f JSONValue -> f JSONValue
forall a. Semigroup a => a -> a -> a
<> (Bool -> JSONValue
JBool (Bool -> JSONValue) -> f Bool -> f JSONValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Bool
forall (f :: * -> *). JSONParser f => f Bool
parseBool)
    f JSONValue -> f JSONValue -> f JSONValue
forall a. Semigroup a => a -> a -> a
<> (Scientific -> JSONValue
JNumber (Scientific -> JSONValue) -> f Scientific -> f JSONValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Scientific
forall (f :: * -> *). JSONParser f => f Scientific
parseNumber)
    f JSONValue -> f JSONValue -> f JSONValue
forall a. Semigroup a => a -> a -> a
<> Text -> f JSONValue -> f JSONValue
forall (f :: * -> *) a. JSONParser f => Text -> f a -> f a
nameParser Text
"Jordan.JSONValue.Array.Input" ([JSONValue] -> JSONValue
JArray ([JSONValue] -> JSONValue) -> f [JSONValue] -> f JSONValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). JSONParser f => f JSONValue)
-> f [JSONValue]
forall (f :: * -> *) a.
JSONParser f =>
(forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> f [a]
parseArrayWith forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
forall (f :: * -> *). JSONParser f => f JSONValue
fromJSON)
    f JSONValue -> f JSONValue -> f JSONValue
forall a. Semigroup a => a -> a -> a
<> Text -> f JSONValue -> f JSONValue
forall (f :: * -> *) a. JSONParser f => Text -> f a -> f a
nameParser Text
"Jordan.JSONValue.Map.Input" (Map Text JSONValue -> JSONValue
JObject (Map Text JSONValue -> JSONValue)
-> ([(Text, JSONValue)] -> Map Text JSONValue)
-> [(Text, JSONValue)]
-> JSONValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, JSONValue)] -> Map Text JSONValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, JSONValue)] -> JSONValue)
-> f [(Text, JSONValue)] -> f JSONValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *). JSONParser f => f JSONValue)
-> f [(Text, JSONValue)]
forall (f :: * -> *) a.
JSONParser f =>
(forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> f [(Text, a)]
parseDictionary forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
forall (f :: * -> *). JSONParser f => f JSONValue
fromJSON)

type AsEither
  = Either ()
      (Either Bool
        (Either Text
          (Either Scientific
            (Either [JSONValue] (Map.Map Text JSONValue)))))

toNestedEither
  :: JSONValue
  -> AsEither
toNestedEither :: JSONValue -> AsEither
toNestedEither = \case
  JSONValue
JNull -> () -> AsEither
forall a b. a -> Either a b
Left ()
  JBool Bool
b -> Either
  Bool
  (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> AsEither
forall a b. b -> Either a b
Right (Bool
-> Either
     Bool
     (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall a b. a -> Either a b
Left Bool
b)
  JText Text
txt -> Either
  Bool
  (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> AsEither
forall a b. b -> Either a b
Right (Either
  Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
-> Either
     Bool
     (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall a b. b -> Either a b
Right (Text
-> Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
forall a b. a -> Either a b
Left Text
txt))
  JNumber Scientific
sci -> Either
  Bool
  (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> AsEither
forall a b. b -> Either a b
Right (Either
  Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
-> Either
     Bool
     (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall a b. b -> Either a b
Right (Either Scientific (Either [JSONValue] (Map Text JSONValue))
-> Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
forall a b. b -> Either a b
Right (Scientific
-> Either Scientific (Either [JSONValue] (Map Text JSONValue))
forall a b. a -> Either a b
Left Scientific
sci)))
  JArray [JSONValue]
jvs -> Either
  Bool
  (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> AsEither
forall a b. b -> Either a b
Right (Either
  Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
-> Either
     Bool
     (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall a b. b -> Either a b
Right (Either Scientific (Either [JSONValue] (Map Text JSONValue))
-> Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
forall a b. b -> Either a b
Right (Either [JSONValue] (Map Text JSONValue)
-> Either Scientific (Either [JSONValue] (Map Text JSONValue))
forall a b. b -> Either a b
Right ([JSONValue] -> Either [JSONValue] (Map Text JSONValue)
forall a b. a -> Either a b
Left [JSONValue]
jvs))))
  JObject Map Text JSONValue
map -> Either
  Bool
  (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> AsEither
forall a b. b -> Either a b
Right (Either
  Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
-> Either
     Bool
     (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall a b. b -> Either a b
Right (Either Scientific (Either [JSONValue] (Map Text JSONValue))
-> Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
forall a b. b -> Either a b
Right (Either [JSONValue] (Map Text JSONValue)
-> Either Scientific (Either [JSONValue] (Map Text JSONValue))
forall a b. b -> Either a b
Right (Map Text JSONValue -> Either [JSONValue] (Map Text JSONValue)
forall a b. b -> Either a b
Right Map Text JSONValue
map))))

instance ToJSON JSONValue where
  toJSON :: f JSONValue
toJSON = (JSONValue -> AsEither)
-> f ()
-> f (Either
        Bool
        (Either
           Text
           (Either Scientific (Either [JSONValue] (Map Text JSONValue)))))
-> f JSONValue
forall (f :: * -> *) arg lhs rhs.
Selectable f =>
(arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
select JSONValue -> AsEither
toNestedEither f ()
forall (f :: * -> *) any. JSONSerializer f => f any
serializeNull f (Either
     Bool
     (Either
        Text
        (Either Scientific (Either [JSONValue] (Map Text JSONValue)))))
s1
    where
      s1 :: f (Either
     Bool
     (Either
        Text
        (Either Scientific (Either [JSONValue] (Map Text JSONValue)))))
s1 = f Bool
-> f (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
-> f (Either
        Bool
        (Either
           Text
           (Either Scientific (Either [JSONValue] (Map Text JSONValue)))))
forall (f :: * -> *) lhs rhs.
Selectable f =>
f lhs -> f rhs -> f (Either lhs rhs)
selected f Bool
forall (f :: * -> *). JSONSerializer f => f Bool
serializeBool f (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
s2
      s2 :: f (Either
     Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
s2 = f Text
-> f (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
-> f (Either
        Text (Either Scientific (Either [JSONValue] (Map Text JSONValue))))
forall (f :: * -> *) lhs rhs.
Selectable f =>
f lhs -> f rhs -> f (Either lhs rhs)
selected f Text
forall (f :: * -> *). JSONSerializer f => f Text
serializeText f (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
s3
      s3 :: f (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
s3 = f Scientific
-> f (Either [JSONValue] (Map Text JSONValue))
-> f (Either Scientific (Either [JSONValue] (Map Text JSONValue)))
forall (f :: * -> *) lhs rhs.
Selectable f =>
f lhs -> f rhs -> f (Either lhs rhs)
selected f Scientific
forall (f :: * -> *). JSONSerializer f => f Scientific
serializeNumber f (Either [JSONValue] (Map Text JSONValue))
s4
      s4 :: f (Either [JSONValue] (Map Text JSONValue))
s4
        = f [JSONValue]
-> f (Map Text JSONValue)
-> f (Either [JSONValue] (Map Text JSONValue))
forall (f :: * -> *) lhs rhs.
Selectable f =>
f lhs -> f rhs -> f (Either lhs rhs)
selected (Text -> f [JSONValue] -> f [JSONValue]
forall (f :: * -> *) a. JSONSerializer f => Text -> f a -> f a
nameSerializer Text
"Jordan.JSONValue.Array.Output" f [JSONValue]
forall (f :: * -> *) a. (JSONSerializer f, ToJSON a) => f [a]
serializeArray)
        (f (Map Text JSONValue)
 -> f (Either [JSONValue] (Map Text JSONValue)))
-> f (Map Text JSONValue)
-> f (Either [JSONValue] (Map Text JSONValue))
forall a b. (a -> b) -> a -> b
$ Text -> f (Map Text JSONValue) -> f (Map Text JSONValue)
forall (f :: * -> *) a. JSONSerializer f => Text -> f a -> f a
nameSerializer Text
"Jordan.JSONValue.Map.Output"
        (f (Map Text JSONValue) -> f (Map Text JSONValue))
-> f (Map Text JSONValue) -> f (Map Text JSONValue)
forall a b. (a -> b) -> a -> b
$ (Map Text JSONValue -> [(Text, JSONValue)])
-> f [(Text, JSONValue)] -> f (Map Text JSONValue)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Map Text JSONValue -> [(Text, JSONValue)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (f [(Text, JSONValue)] -> f (Map Text JSONValue))
-> f [(Text, JSONValue)] -> f (Map Text JSONValue)
forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *). JSONSerializer f => f JSONValue)
-> f [(Text, JSONValue)]
forall (f :: * -> *) (t :: * -> *) a.
(JSONSerializer f, Foldable t) =>
(forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> f (t (Text, a))
serializeDictionary forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
forall (f :: * -> *). JSONSerializer f => f JSONValue
toJSON