{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module        : Test.QuickCheck.Instances.Sized
-- Copyright     : Gautier DI FOLCO
-- License       : BSD2
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Unstable
-- Portability   : GHC
--
-- aeson instances for 'Sized'
module Data.Aeson.Types.Instances.Sized
  ( FromJSON (..),
    ToJSON (..),
    FromJSONKey (..),
    ToJSONKey (..),
  )
where

import Control.Monad ((>=>))
import Data.Aeson
import Data.Aeson.Types
import Data.Coerce
import Data.Sized

instance
  ( FromJSON a,
    Semigroup a,
    Size s,
    SizedSingleton a,
    SizedFromContainer a,
    FromJSON (SizedSingletonElement a)
  ) =>
  FromJSON (Sized s a)
  where
  parseJSON :: Value -> Parser (Sized s a)
parseJSON Value
x = do
    a
raw <- Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
    case a -> Maybe (Sized s a)
forall s a.
(Size s, SizedFromContainer a) =>
a -> Maybe (Sized s a)
sized a
raw of
      Just Sized s a
y -> Sized s a -> Parser (Sized s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sized s a
y
      Maybe (Sized s a)
Nothing -> String -> Parser (Sized s a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parsing Sized failed, unexpected empty container"

instance
  ( FromJSON a,
    Size s,
    SizedSingleton a,
    SizedFromContainer a,
    FromJSON (SizedSingletonElement a),
    FromJSONKey (SizedSingletonElement a),
    FromJSONKey a,
    Semigroup a
  ) =>
  FromJSONKey (Sized s a)
  where
  fromJSONKey :: FromJSONKeyFunction (Sized s a)
fromJSONKey =
    case FromJSONKey a => FromJSONKeyFunction a
forall a. FromJSONKey a => FromJSONKeyFunction a
fromJSONKey @a of
      FromJSONKeyFunction a
FromJSONKeyCoerce -> (Text -> Parser (Sized s a)) -> FromJSONKeyFunction (Sized s a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (a -> Parser (Sized s a)
run (a -> Parser (Sized s a))
-> (Text -> a) -> Text -> Parser (Sized s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
coerce)
      FromJSONKeyText Text -> a
f -> (Text -> Parser (Sized s a)) -> FromJSONKeyFunction (Sized s a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (a -> Parser (Sized s a)
run (a -> Parser (Sized s a))
-> (Text -> a) -> Text -> Parser (Sized s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
f)
      FromJSONKeyTextParser Text -> Parser a
f -> (Text -> Parser (Sized s a)) -> FromJSONKeyFunction (Sized s a)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser (Text -> Parser a
f (Text -> Parser a)
-> (a -> Parser (Sized s a)) -> Text -> Parser (Sized s a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Parser (Sized s a)
run)
      FromJSONKeyValue Value -> Parser a
f -> (Value -> Parser (Sized s a)) -> FromJSONKeyFunction (Sized s a)
forall a. (Value -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyValue (Value -> Parser a
f (Value -> Parser a)
-> (a -> Parser (Sized s a)) -> Value -> Parser (Sized s a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> Parser (Sized s a)
run)
    where
      run :: a -> Parser (Sized s a)
      run :: a -> Parser (Sized s a)
run a
x =
        case a -> Maybe (Sized s a)
forall s a.
(Size s, SizedFromContainer a) =>
a -> Maybe (Sized s a)
sized a
x of
          Just Sized s a
y -> Sized s a -> Parser (Sized s a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sized s a
y
          Maybe (Sized s a)
Nothing -> String -> Parser (Sized s a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parsing Sized failed, unexpected empty container"

instance (ToJSON a) => ToJSON (Sized s a) where
  toJSON :: Sized s a -> Value
toJSON = a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> (Sized s a -> a) -> Sized s a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sized s a -> a
forall s a. Sized s a -> a
getSized
  toEncoding :: Sized s a -> Encoding
toEncoding = a -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (a -> Encoding) -> (Sized s a -> a) -> Sized s a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sized s a -> a
forall s a. Sized s a -> a
getSized
  toJSONList :: [Sized s a] -> Value
toJSONList = [a] -> Value
forall a. ToJSON a => [a] -> Value
toJSONList ([a] -> Value) -> ([Sized s a] -> [a]) -> [Sized s a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sized s a -> a) -> [Sized s a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Sized s a -> a
forall s a. Sized s a -> a
getSized
  toEncodingList :: [Sized s a] -> Encoding
toEncodingList = [a] -> Encoding
forall a. ToJSON a => [a] -> Encoding
toEncodingList ([a] -> Encoding)
-> ([Sized s a] -> [a]) -> [Sized s a] -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sized s a -> a) -> [Sized s a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Sized s a -> a
forall s a. Sized s a -> a
getSized

instance (ToJSONKey a) => ToJSONKey (Sized s a) where
  toJSONKey :: ToJSONKeyFunction (Sized s a)
toJSONKey = (Sized s a -> a)
-> ToJSONKeyFunction a -> ToJSONKeyFunction (Sized s a)
forall b a. (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction Sized s a -> a
forall s a. Sized s a -> a
getSized ToJSONKeyFunction a
forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey
  toJSONKeyList :: ToJSONKeyFunction [Sized s a]
toJSONKeyList = ([Sized s a] -> [a])
-> ToJSONKeyFunction [a] -> ToJSONKeyFunction [Sized s a]
forall b a. (b -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction b
contramapToJSONKeyFunction ((Sized s a -> a) -> [Sized s a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Sized s a -> a
forall s a. Sized s a -> a
getSized) ToJSONKeyFunction [a]
forall a. ToJSONKey a => ToJSONKeyFunction [a]
toJSONKeyList