{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Aeson.Extra.CollapsedList
-- Copyright   :  (C) 2015-2016 Oleg Grenrus
-- License     :  BSD3
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
-- Note: the contexts of functions are different with @aeson-1@.
module Data.Aeson.Extra.CollapsedList (
    CollapsedList(..),
    getCollapsedList,
    parseCollapsedList,
    )where

import Prelude ()
import Prelude.Compat

import Control.Applicative (Alternative (..))
import Data.Aeson.Types    hiding ((.:?))
import Data.Text           (Text)

#if __GLASGOW_HASKELL__ >= 708
import Data.Typeable (Typeable)
#endif

import qualified Data.Foldable       as Foldable
import qualified Data.Text           as T

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif



-- | Collapsed list, singleton is represented as the value itself in JSON encoding.
--
-- > λ > decode "null" :: Maybe (CollapsedList [Int] Int)
-- > Just (CollapsedList [])
-- > λ > decode "42" :: Maybe (CollapsedList [Int] Int)
-- > Just (CollapsedList [42])
-- > λ > decode "[1, 2, 3]" :: Maybe (CollapsedList [Int] Int)
-- > Just (CollapsedList [1,2,3])
--
-- > λ > encode (CollapsedList ([] :: [Int]))
-- > "null"
-- > λ > encode (CollapsedList ([42] :: [Int]))
-- > "42"
-- > λ > encode (CollapsedList ([1, 2, 3] :: [Int]))
-- > "[1,2,3]"
--
-- Documentation rely on @f@ 'Alternative' instance behaving like lists'.
newtype CollapsedList f a = CollapsedList (f a)
  deriving (CollapsedList f a -> CollapsedList f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
Eq (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
/= :: CollapsedList f a -> CollapsedList f a -> Bool
$c/= :: forall (f :: * -> *) a.
Eq (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
== :: CollapsedList f a -> CollapsedList f a -> Bool
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
Eq, CollapsedList f a -> CollapsedList f a -> Bool
CollapsedList f a -> CollapsedList f a -> Ordering
CollapsedList f a -> CollapsedList f a -> CollapsedList f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {f :: * -> *} {a}. Ord (f a) => Eq (CollapsedList f a)
forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> CollapsedList f a
min :: CollapsedList f a -> CollapsedList f a -> CollapsedList f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> CollapsedList f a
max :: CollapsedList f a -> CollapsedList f a -> CollapsedList f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> CollapsedList f a
>= :: CollapsedList f a -> CollapsedList f a -> Bool
$c>= :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
> :: CollapsedList f a -> CollapsedList f a -> Bool
$c> :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
<= :: CollapsedList f a -> CollapsedList f a -> Bool
$c<= :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
< :: CollapsedList f a -> CollapsedList f a -> Bool
$c< :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Bool
compare :: CollapsedList f a -> CollapsedList f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
CollapsedList f a -> CollapsedList f a -> Ordering
Ord, Int -> CollapsedList f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a.
Show (f a) =>
Int -> CollapsedList f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [CollapsedList f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => CollapsedList f a -> String
showList :: [CollapsedList f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [CollapsedList f a] -> ShowS
show :: CollapsedList f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => CollapsedList f a -> String
showsPrec :: Int -> CollapsedList f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a.
Show (f a) =>
Int -> CollapsedList f a -> ShowS
Show, ReadPrec [CollapsedList f a]
ReadPrec (CollapsedList f a)
ReadS [CollapsedList f a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [CollapsedList f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (CollapsedList f a)
forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (CollapsedList f a)
forall (f :: * -> *) a. Read (f a) => ReadS [CollapsedList f a]
readListPrec :: ReadPrec [CollapsedList f a]
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [CollapsedList f a]
readPrec :: ReadPrec (CollapsedList f a)
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (CollapsedList f a)
readList :: ReadS [CollapsedList f a]
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [CollapsedList f a]
readsPrec :: Int -> ReadS (CollapsedList f a)
$creadsPrec :: forall (f :: * -> *) a.
Read (f a) =>
Int -> ReadS (CollapsedList f a)
Read, forall a b. a -> CollapsedList f b -> CollapsedList f a
forall a b. (a -> b) -> CollapsedList f a -> CollapsedList f b
forall (f :: * -> *) a b.
Functor f =>
a -> CollapsedList f b -> CollapsedList f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CollapsedList f a -> CollapsedList f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CollapsedList f b -> CollapsedList f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> CollapsedList f b -> CollapsedList f a
fmap :: forall a b. (a -> b) -> CollapsedList f a -> CollapsedList f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CollapsedList f a -> CollapsedList f b
Functor, forall a. CollapsedList f a -> Bool
forall m a. Monoid m => (a -> m) -> CollapsedList f a -> m
forall a b. (a -> b -> b) -> b -> CollapsedList f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> CollapsedList f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
CollapsedList f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
CollapsedList f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
CollapsedList f m -> m
forall (f :: * -> *) a. Foldable f => CollapsedList f a -> Bool
forall (f :: * -> *) a. Foldable f => CollapsedList f a -> Int
forall (f :: * -> *) a. Foldable f => CollapsedList f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> CollapsedList f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> CollapsedList f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> CollapsedList f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> CollapsedList f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => CollapsedList f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
CollapsedList f a -> a
sum :: forall a. Num a => CollapsedList f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
CollapsedList f a -> a
minimum :: forall a. Ord a => CollapsedList f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
CollapsedList f a -> a
maximum :: forall a. Ord a => CollapsedList f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
CollapsedList f a -> a
elem :: forall a. Eq a => a -> CollapsedList f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> CollapsedList f a -> Bool
length :: forall a. CollapsedList f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => CollapsedList f a -> Int
null :: forall a. CollapsedList f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => CollapsedList f a -> Bool
toList :: forall a. CollapsedList f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => CollapsedList f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> CollapsedList f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> CollapsedList f a -> a
foldr1 :: forall a. (a -> a -> a) -> CollapsedList f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> CollapsedList f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> CollapsedList f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> CollapsedList f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CollapsedList f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> CollapsedList f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CollapsedList f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> CollapsedList f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CollapsedList f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> CollapsedList f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> CollapsedList f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> CollapsedList f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CollapsedList f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> CollapsedList f a -> m
fold :: forall m. Monoid m => CollapsedList f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
CollapsedList f m -> m
Foldable, forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {f :: * -> *}. Traversable f => Functor (CollapsedList f)
forall {f :: * -> *}. Traversable f => Foldable (CollapsedList f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
CollapsedList f (m a) -> m (CollapsedList f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
CollapsedList f (f a) -> f (CollapsedList f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> CollapsedList f a -> m (CollapsedList f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> CollapsedList f a -> f (CollapsedList f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CollapsedList f a -> f (CollapsedList f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
CollapsedList f (m a) -> m (CollapsedList f a)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
CollapsedList f (m a) -> m (CollapsedList f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CollapsedList f a -> m (CollapsedList f b)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> CollapsedList f a -> m (CollapsedList f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CollapsedList f (f a) -> f (CollapsedList f a)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
CollapsedList f (f a) -> f (CollapsedList f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CollapsedList f a -> f (CollapsedList f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> CollapsedList f a -> f (CollapsedList f b)
Traversable
#if __GLASGOW_HASKELL__ >= 708
           , Typeable
#endif
           )

getCollapsedList :: CollapsedList f a -> f a
getCollapsedList :: forall (f :: * -> *) a. CollapsedList f a -> f a
getCollapsedList (CollapsedList f a
l) = f a
l

instance (FromJSON1 f, Alternative f) => FromJSON1 (CollapsedList f) where
    liftParseJSON :: forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (CollapsedList f a)
liftParseJSON Value -> Parser a
p Value -> Parser [a]
_ Value
v = forall (f :: * -> *) a. f a -> CollapsedList f a
CollapsedList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Value
v of
        Value
Null    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty
        Array Array
_ -> forall (f :: * -> *) a.
FromJSON1 f =>
(Value -> Parser a)
-> (Value -> Parser [a]) -> Value -> Parser (f a)
liftParseJSON Value -> Parser a
p (forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser a
p) Value
v
        Value
x       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
x

instance (ToJSON1 f, Foldable f) => ToJSON1 (CollapsedList f) where
    liftToEncoding :: forall a.
(a -> Encoding)
-> ([a] -> Encoding) -> CollapsedList f a -> Encoding
liftToEncoding a -> Encoding
to [a] -> Encoding
_ (CollapsedList f a
l) = case [a]
l' of
        []   -> forall a. ToJSON a => a -> Encoding
toEncoding Value
Null
        [a
x]  -> a -> Encoding
to a
x
        [a]
_    -> forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Encoding) -> ([a] -> Encoding) -> f a -> Encoding
liftToEncoding a -> Encoding
to (forall a. (a -> Encoding) -> [a] -> Encoding
listEncoding a -> Encoding
to) f a
l
      where
        l' :: [a]
l' = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f a
l

    liftToJSON :: forall a.
(a -> Value) -> ([a] -> Value) -> CollapsedList f a -> Value
liftToJSON a -> Value
to [a] -> Value
_ (CollapsedList f a
l) = case [a]
l' of
        []   -> forall a. ToJSON a => a -> Value
toJSON Value
Null
        [a
x]  -> a -> Value
to a
x
        [a]
_    -> forall (f :: * -> *) a.
ToJSON1 f =>
(a -> Value) -> ([a] -> Value) -> f a -> Value
liftToJSON a -> Value
to (forall a. (a -> Value) -> [a] -> Value
listValue a -> Value
to) f a
l
      where
        l' :: [a]
l' = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList f a
l

instance (ToJSON1 f, Foldable f, ToJSON a) => ToJSON (CollapsedList f a) where
    toJSON :: CollapsedList f a -> Value
toJSON         = forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Value
toJSON1
    toEncoding :: CollapsedList f a -> Encoding
toEncoding     = forall (f :: * -> *) a. (ToJSON1 f, ToJSON a) => f a -> Encoding
toEncoding1

instance (FromJSON1 f, Alternative f, FromJSON a) => FromJSON (CollapsedList f a) where
    parseJSON :: Value -> Parser (CollapsedList f a)
parseJSON     = forall (f :: * -> *) a.
(FromJSON1 f, FromJSON a) =>
Value -> Parser (f a)
parseJSON1

-- | Parses possibly collapsed array value from the object's field.
--
-- > λ > newtype V = V [Int] deriving (Show)
-- > λ > instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value"
-- > λ > decode "{}" :: Maybe V
-- > Just (V [])
-- > λ > decode "{\"value\": null}" :: Maybe V
-- > Just (V [])
-- > λ > decode "{\"value\": 42}" :: Maybe V
-- > Just (V [42])
-- > λ > decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V
-- > Just (V [1,2,3,4])
parseCollapsedList :: (FromJSON a, FromJSON1 f, Alternative f) => Object -> Text -> Parser (f a)
parseCollapsedList :: forall a (f :: * -> *).
(FromJSON a, FromJSON1 f, Alternative f) =>
Object -> Text -> Parser (f a)
parseCollapsedList Object
obj Text
key' =
    case forall v. Key -> KeyMap v -> Maybe v
KM.lookup Key
key Object
obj of
        Maybe Value
Nothing   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty
        Just Value
v    -> forall a. ShowS -> Parser a -> Parser a
modifyFailure ShowS
addKeyName forall a b. (a -> b) -> a -> b
$ (forall (f :: * -> *) a. CollapsedList f a -> f a
getCollapsedList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) -- <?> Key key
  where
#if MIN_VERSION_aeson(2,0,0)
    key :: Key
key = Text -> Key
Key.fromText Text
key'
#else
    key = key'
#endif
    addKeyName :: ShowS
addKeyName = (forall a. Monoid a => a -> a -> a
mappend (String
"failed to parse field " forall a. Monoid a => a -> a -> a
`mappend` Text -> String
T.unpack Text
key' forall a. Monoid a => a -> a -> a
`mappend`String
": "))