{-# LANGUAGE DerivingVia #-}

module HaskellWorks.Data.Aeson
    ( JsonEndo(..)
    , WithJsonKeyValues(..)
    , ToJsonKeyValues(..)
    , objectWithoutNulls
    , readJson
    , objectEndo
    , (.?=)
    , (.!=)
    ) where

import Data.Aeson (pairs, object, KeyValue((.=)), ToJSON(toJSON, toEncoding), Series, Value(Null))
import Data.Aeson.Encoding (Encoding)
import Data.Aeson.Types (Pair, Parser)
import Data.Monoid (Endo(..))
import HaskellWorks.Data.Aeson.Compat (Key)
import Text.Read (readMaybe)

infixr 7 .?=
infixr 7 .!=

newtype JsonEndo a = JsonEndo
  { JsonEndo a -> [a] -> [a]
unJsonEndo :: [a] -> [a]
  }
  deriving (b -> JsonEndo a -> JsonEndo a
NonEmpty (JsonEndo a) -> JsonEndo a
JsonEndo a -> JsonEndo a -> JsonEndo a
(JsonEndo a -> JsonEndo a -> JsonEndo a)
-> (NonEmpty (JsonEndo a) -> JsonEndo a)
-> (forall b. Integral b => b -> JsonEndo a -> JsonEndo a)
-> Semigroup (JsonEndo a)
forall b. Integral b => b -> JsonEndo a -> JsonEndo a
forall a. NonEmpty (JsonEndo a) -> JsonEndo a
forall a. JsonEndo a -> JsonEndo a -> JsonEndo a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> JsonEndo a -> JsonEndo a
stimes :: b -> JsonEndo a -> JsonEndo a
$cstimes :: forall a b. Integral b => b -> JsonEndo a -> JsonEndo a
sconcat :: NonEmpty (JsonEndo a) -> JsonEndo a
$csconcat :: forall a. NonEmpty (JsonEndo a) -> JsonEndo a
<> :: JsonEndo a -> JsonEndo a -> JsonEndo a
$c<> :: forall a. JsonEndo a -> JsonEndo a -> JsonEndo a
Semigroup, Semigroup (JsonEndo a)
JsonEndo a
Semigroup (JsonEndo a)
-> JsonEndo a
-> (JsonEndo a -> JsonEndo a -> JsonEndo a)
-> ([JsonEndo a] -> JsonEndo a)
-> Monoid (JsonEndo a)
[JsonEndo a] -> JsonEndo a
JsonEndo a -> JsonEndo a -> JsonEndo a
forall a. Semigroup (JsonEndo a)
forall a. JsonEndo a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [JsonEndo a] -> JsonEndo a
forall a. JsonEndo a -> JsonEndo a -> JsonEndo a
mconcat :: [JsonEndo a] -> JsonEndo a
$cmconcat :: forall a. [JsonEndo a] -> JsonEndo a
mappend :: JsonEndo a -> JsonEndo a -> JsonEndo a
$cmappend :: forall a. JsonEndo a -> JsonEndo a -> JsonEndo a
mempty :: JsonEndo a
$cmempty :: forall a. JsonEndo a
$cp1Monoid :: forall a. Semigroup (JsonEndo a)
Monoid) via (Endo [a])

instance KeyValue a => KeyValue (JsonEndo a) where
  Key
k .= :: Key -> v -> JsonEndo a
.= v
v = ([a] -> [a]) -> JsonEndo a
forall a. ([a] -> [a]) -> JsonEndo a
JsonEndo (Key
k Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
va -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

objectWithoutNulls :: [Pair] -> Value
objectWithoutNulls :: [Pair] -> Value
objectWithoutNulls = [Pair] -> Value
object ([Pair] -> Value) -> ([Pair] -> [Pair]) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (Bool -> Bool
not (Bool -> Bool) -> (Pair -> Bool) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Bool
isNull (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
  where
    isNull :: Value -> Bool
isNull Value
Null = Bool
True
    isNull Value
_    = Bool
False

readJson :: Read a => String -> String -> Parser a
readJson :: String -> String -> Parser a
readJson String
t String
s = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
s of
  Just a
a  -> a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  Maybe a
Nothing -> String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Could not parse " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
t

-- | Render optional fields as missing in JSON output.
(.?=) :: (KeyValue p, ToJSON v, Monoid p) => Key -> Maybe v -> p
.?= :: Key -> Maybe v -> p
(.?=) Key
k Maybe v
mv = case Maybe v
mv of
  Just v
v -> Key
k Key -> v -> p
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
v
  Maybe v
Nothing -> p
forall a. Monoid a => a
mempty

-- | Same as '.=', but with lower precedence to work well with lens.
(.!=) :: (KeyValue kv, ToJSON v) => Key -> v -> kv
.!= :: Key -> v -> kv
(.!=) = Key -> v -> kv
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
(.=)

-- | Same as 'object' except used in combination with '.?=' and '.!=' instead of '.='.
--
-- For example:
--
-- @
-- 'toJSON' o = 'objectEndo'
--   [ \"mandatory\" '.!=' o '^.' the @\"mandatory\"
--   , \"optional\"  '.?=' o '^.' the @\"optional\"
--   ]
-- @
objectEndo :: [JsonEndo Pair] -> Value
objectEndo :: [JsonEndo Pair] -> Value
objectEndo [JsonEndo Pair]
es = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ JsonEndo Pair -> [Pair] -> [Pair]
forall a. JsonEndo a -> [a] -> [a]
unJsonEndo ([JsonEndo Pair] -> JsonEndo Pair
forall a. Monoid a => [a] -> a
mconcat [JsonEndo Pair]
es) []

-- | Generate key values from a value of a type.  This can be used
-- in conjunction with 'WithJsonKeyValues' to define a 'ToJSON' instance
-- without having to implement both 'toJSON' and 'toEncoding', thereby
-- reducing boilerplate.
--
-- For example:
--
-- @
-- instance ToJsonEncoding MyType where
--   toJsonEncoding sv =
--     [ "my_field" .!= sv ^. #myField
--     ]
-- @
class ToJsonKeyValues a where
  toJsonKeyValues :: (KeyValue kv, Monoid kv) => a -> [kv]

-- | For use with language extension DerivingVia.  This derivation provides
-- a ToJSON instance that delegates to the ToJsonKeyValues instance.
--
-- For example:
--
-- @
-- newtype MyType = MyType
--   { myField :: Text
--   } deriving J.ToJSON via WithJsonKeyValues MyType
-- @
newtype WithJsonKeyValues a = WithJsonKeyValues
  { WithJsonKeyValues a -> a
unWithJsonKeyValues :: a
  }

instance ToJsonKeyValues a => ToJSON (WithJsonKeyValues a) where
  toJSON :: WithJsonKeyValues a -> Value
toJSON = [JsonEndo Pair] -> Value
objectEndo ([JsonEndo Pair] -> Value)
-> (WithJsonKeyValues a -> [JsonEndo Pair])
-> WithJsonKeyValues a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [JsonEndo Pair]
forall a kv.
(ToJsonKeyValues a, KeyValue kv, Monoid kv) =>
a -> [kv]
toJsonKeyValues (a -> [JsonEndo Pair])
-> (WithJsonKeyValues a -> a)
-> WithJsonKeyValues a
-> [JsonEndo Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithJsonKeyValues a -> a
forall a. WithJsonKeyValues a -> a
unWithJsonKeyValues
  toEncoding :: WithJsonKeyValues a -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (WithJsonKeyValues a -> Series)
-> WithJsonKeyValues a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (WithJsonKeyValues a -> [Series])
-> WithJsonKeyValues a
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Series]
forall a kv.
(ToJsonKeyValues a, KeyValue kv, Monoid kv) =>
a -> [kv]
toJsonKeyValues (a -> [Series])
-> (WithJsonKeyValues a -> a) -> WithJsonKeyValues a -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithJsonKeyValues a -> a
forall a. WithJsonKeyValues a -> a
unWithJsonKeyValues