----------------------------------------------------------------------
--
-- Module      :  Uniform.Json
--
------------------------------------------------- --------------------
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | the operations on JSON data types
module Uniform.Json
  ( module Uniform.Json,
    -- module Uniform.Error, -- or at least 
    ErrIO,
    Value (..),
    ToJSON (..),
    FromJSON (..),
    fromJSON,
    decode,
    omitNothingFields,
    eitherDecode,
    -- , encode
    object,
    (.=),
    genericParseJSON,
    defaultOptions,
    genericToJSON,
    fieldLabelModifier,
    HML.fromList,
    HML.toList,
    Result (..),
    encode,
    encodePretty,
    parseEither, parseMaybe
  )
where

import Control.Lens
  ( at,
    (&),
    (?~),
    (^?),
  )
import Data.Aeson
import Data.Aeson.Types 
import Data.Aeson as Aeson
-- import Data.Aeson.Lens (key, AsValue)
-- import Data.Aeson.Text 
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Lens
import qualified Data.HashMap.Lazy as HML
import qualified Data.Aeson.KeyMap as KM -- added for ghc 9.2
import UniformBase
-- import Uniform.Error hiding (at)
-- import Uniform.Strings hiding (at)

encodeT :: ToJSON a => a -> Text
encodeT :: forall a. ToJSON a => a -> Text
encodeT = ByteString -> Text
bb2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
bl2b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode

fromJSONmaybe :: FromJSON a => Value -> Maybe a
fromJSONmaybe :: forall a. FromJSON a => Value -> Maybe a
fromJSONmaybe Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) of
  Success a
a -> forall a. a -> Maybe a
Just a
a
  Result a
_ -> forall a. Maybe a
Nothing

instance Zeros Value where zero :: Value
zero = Value
Null

fromJSONm :: (FromJSON a, Show a) => Value -> ErrIO a
-- DO NOT USE ! fromJSONm :: (FromJSON a, MonadError m) => Value -> m a
fromJSONm :: forall a. (FromJSON a, Show a) => Value -> ErrIO a
fromJSONm Value
v = forall (m :: * -> *) a. (Monad m, MonadFail m) => Result a -> m a
result1 (forall a. FromJSON a => Value -> Result a
fromJSON Value
v)
-- fromJSONm :: (FromJSON a, MonadError m) => Value -> m a

-- | the following gives error msg
fromJSONerrio :: (FromJSON a, Show a) => Value -> ErrIO a
fromJSONerrio :: forall a. (FromJSON a, Show a) => Value -> ErrIO a
fromJSONerrio Value
v = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *) a. (Monad m, MonadFail m) => Result a -> m a
result1 (forall a. FromJSON a => Value -> Result a
fromJSON Value
v)

fromJSONfailError :: (FromJSON a, Show a) => Value -> ErrIO a
-- | converts fromJson to a record structure
-- throws error if fails
fromJSONfailError :: forall a. (FromJSON a, Show a) => Value -> ErrIO a
fromJSONfailError Value
v = case (forall a. FromJSON a => Value -> Result a
fromJSON Value
v) of
            Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
            Result a
x -> forall a. [Text] -> ErrIO a
throwErrorWords [Text
"fromJson", forall {a}. Show a => a -> Text
showT Result a
x]

result1 :: (Monad m, MonadFail m) => Result a -> m a
result1 :: forall (m :: * -> *) a. (Monad m, MonadFail m) => Result a -> m a
result1 (Aeson.Error String
msg) = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
result1 (Aeson.Success a
a) = forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- a difernt solution
-- | get a maybe value from a json value 
gak :: Data.Aeson.Lens.AsValue s => s -> Key -> Maybe Value
gak :: forall s. AsValue s => s -> Key -> Maybe Value
gak s
b Key
k = forall s a. s -> Getting (First a) s a -> Maybe a
(^?) s
b (forall t. AsValue t => Key -> Traversal' t Value
key Key
k)

-- | get and set at a key
class AtKey vk v where
  getAtKey :: vk -> Key -> Maybe v

  getAt2Key :: vk -> Key -> Key -> Maybe v
  -- ^ two keys: one after the other

  putAtKey :: Key -> v -> vk -> vk

instance AtKey Value Text where
  getAtKey :: Value -> Key -> Maybe Text
getAtKey Value
meta2 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  getAt2Key :: Value -> Key -> Key -> Maybe Text
getAt2Key Value
meta2 Key
k1 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Text
_String
  putAtKey :: Key -> Text -> Value -> Value
putAtKey Key
k2 Text
txt Value
meta2 = Value
meta2 forall a b. a -> (a -> b) -> b
& forall t. AsValue t => Prism' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
k2 forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
String Text
txt

-- instance AtKey Value [Text] where
--   getAtKey meta2 k2 = lookup  k2 meta2
-- --   getAt2Key meta2 k1 k2 = meta2 ^? key k1 . key k2 . _String
-- --   putAtKey k2 txt meta2 = meta2 & _Object . at k2 ?~ String txt

instance AtKey Value Integer where
  getAtKey :: Value -> Key -> Maybe Integer
getAtKey Value
meta2 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsNumber t, Integral a) => Prism' t a
_Integral
  getAt2Key :: Value -> Key -> Key -> Maybe Integer
getAt2Key Value
meta2 Key
k1 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsNumber t, Integral a) => Prism' t a
_Integral
  putAtKey :: Key -> Integer -> Value -> Value
putAtKey Key
k2 Integer
txt Value
meta2 = Value
meta2 forall a b. a -> (a -> b) -> b
& forall t. AsValue t => Prism' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
k2 forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
toJSON Integer
txt

instance AtKey Value Bool where
  getAtKey :: Value -> Key -> Maybe Bool
getAtKey Value
meta2 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Bool
_Bool
  getAt2Key :: Value -> Key -> Key -> Maybe Bool
getAt2Key Value
meta2 Key
k1 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Prism' t Bool
_Bool
  putAtKey :: Key -> Bool -> Value -> Value
putAtKey Key
k2 Bool
txt Value
meta2 = Value
meta2 forall a b. a -> (a -> b) -> b
& forall t. AsValue t => Prism' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
k2 forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool -> Value
Bool Bool
txt

instance AtKey Value Value where
  getAtKey :: Value -> Key -> Maybe Value
getAtKey Value
meta2 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k2  
  getAt2Key :: Value -> Key -> Key -> Maybe Value
getAt2Key Value
meta2 Key
k1 Key
k2 = Value
meta2 forall s a. s -> Getting (First a) s a -> Maybe a
^? forall t. AsValue t => Key -> Traversal' t Value
key Key
k1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsValue t => Key -> Traversal' t Value
key Key
k2  
--   putAtKey k2 txt meta2 = meta2 & _Object . at k2 ?~ Bool txt

class AtKey2 vk v where
--   getAtKey :: vk -> Key -> Maybe v
--   getAt2Key :: vk -> Key -> Text -> Maybe v

  -- ^ two keys: one after the other

  putAtKey2 :: Key -> v -> vk -> vk

instance (ToJSON a) => AtKey2 Value a where
  -- getAtKey meta2 k2 = meta2 ^? key k2 . _Integral
  -- getAt2Key meta2 k1 k2 = meta2 ^? key k1 . key k2 . _Integral
  putAtKey2 :: Key -> a -> Value -> Value
putAtKey2 Key
k2 a
txt Value
meta2 = Value
meta2 forall a b. a -> (a -> b) -> b
& forall t. AsValue t => Prism' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
k2 forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. ToJSON a => a -> Value
toJSON a
txt

mergeLeftPref ::[Value] -> Value
-- ^ The (left-biased) union of two maps.
-- all values must be objects, which can be prooduced with toJSON
-- It prefers the first map when duplicate keys are encountered,
-- http://hackage.haskell.org/package/hashmap-1.3.3/docs/Data-HashMap.html
-- mergeLeftPref = Object . HML.unions .  map unObject
-- for ghc 9.2.1
mergeLeftPref :: [Value] -> Value
mergeLeftPref = KeyMap Value -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
.[KeyMap Value] -> KeyMap Value
unions' forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map Value -> KeyMap Value
unObject

unions' :: [KM.KeyMap Value]  -> KM.KeyMap Value
unions' :: [KeyMap Value] -> KeyMap Value
unions' = forall v. HashMap Key v -> KeyMap v
KM.fromHashMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
HML.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall v. KeyMap v -> HashMap Key v
KM.toHashMap
-- end

mergeRightPref :: [Value] -> Value
mergeRightPref :: [Value] -> Value
mergeRightPref = [Value] -> Value
mergeLeftPref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

instance NiceStrings Value where
  shownice :: Value -> Text
shownice = ByteString -> Text
bb2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
bl2b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty

unObject :: Value -> Object
unObject :: Value -> KeyMap Value
unObject (Object KeyMap Value
x) = KeyMap Value
x
unObject Value
z = forall a. [Text] -> a
errorT [Text
"unObject in Json.hs: No Object available", Text
"given", forall {a}. Show a => a -> Text
showT Value
z]