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

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

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

instance
  ( FromJSON a,
    Semigroup a,
    NonEmptySingleton a,
    NonEmptyFromContainer a,
    FromJSON (NonEmptySingletonElement a)
  ) =>
  FromJSON (NonEmpty a)
  where
  parseJSON :: Value -> Parser (NonEmpty a)
parseJSON Value
x = do
    a
raw <- Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
    case a -> Maybe (NonEmpty a)
forall a. NonEmptyFromContainer a => a -> Maybe (NonEmpty a)
nonEmpty a
raw of
      Just NonEmpty a
y -> NonEmpty a -> Parser (NonEmpty a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty a
y
      Maybe (NonEmpty a)
Nothing -> String -> Parser (NonEmpty a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parsing NonEmpty failed, unexpected empty container"

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

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

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