{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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