{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DerivingVia            #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}

module Deriving.Aeson.Stripped
       (
         -- $presentation
         --
         -- $setup
         --
         -- $examples

         -- * Core type
         StrippedJSON(..)

         -- * Stripping fields
       , RField
       , CField

         -- * Recovering fields
       , RecoverableValue(..)
       , Coerce
       , FromString
       , FromList
       , Mempty
       , Pure

         -- * Re-exports
       , module Deriving.Aeson
       ) where

import Data.Aeson
import Data.Aeson.Types
import Data.Coerce (Coercible, coerce)
import Data.Functor.Contravariant (Contravariant)
import Data.Kind (Constraint, Type)
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import Data.Symbol.Ascii (Head)
import Data.Type.Equality (type (==))
import Deriving.Aeson
import Fcf (type (-), type (=<<), type (>=), Eval, Exp, UnBool, type (||))
import Fcf.Utils (TError)
import Generic.Data.Surgery
import Generic.Data.Surgery.Internal
import GHC.Exts (IsList (..))
import GHC.Generics (Generic, Rep)
import GHC.TypeLits (CmpSymbol, KnownNat, KnownSymbol, Nat, Symbol, natVal, symbolVal)

import qualified Fcf
import qualified GHC.TypeLits as Error


-- | A newtype wrapper which provides 'FromJSON' / 'ToJSON' instances based on a specific
-- set of 'AesonOptions' (see the "Deriving.Aeson" module), and the ability to strip one
-- or more fields from the JSON output, recovered when decoding using some default
-- `RecoverableValue`s.
newtype StrippedJSON (fds :: [Type]) (opts :: [Type]) a
    = StrippedJSON { StrippedJSON fds opts a -> a
unStrippedJSON :: a }


instance
       ( AesonOptions opts
       , StripFields lt fds l
       , Generic a
       , ToOR f l
       , FromORRepLazy a lt
       , Functor (Arborify l)
       , Contravariant (Arborify l)
       , GFromJSON Zero (Arborify l)
       )
    => FromJSON (StrippedJSON fds opts a) where
    parseJSON :: Value -> Parser (StrippedJSON fds opts a)
parseJSON
        = (Data f Any -> StrippedJSON fds opts a)
-> Parser (Data f Any) -> Parser (StrippedJSON fds opts a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> StrippedJSON fds opts a
forall (fds :: [*]) (opts :: [*]) a. a -> StrippedJSON fds opts a
StrippedJSON (a -> StrippedJSON fds opts a)
-> (Data f Any -> a) -> Data f Any -> StrippedJSON fds opts a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (l :: * -> *) x.
(Generic a, FromORRepLazy a l) =>
OR l x -> a
forall (l :: * -> *) x.
(Generic a, FromORRepLazy a l) =>
OR l x -> a
fromORLazy @a (OR lt Any -> a) -> (Data f Any -> OR lt Any) -> Data f Any -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR l x -> OR lt x
forall (l :: * -> *) x. StripFields lt fds l => OR l x -> OR lt x
recoverFields @lt @fds (OR l Any -> OR lt Any)
-> (Data f Any -> OR l Any) -> Data f Any -> OR lt Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data f Any -> OR l Any
forall (f :: * -> *) (l :: * -> *) x.
ToOR f l =>
Data f x -> OR l x
toOR')
        (Parser (Data f Any) -> Parser (StrippedJSON fds opts a))
-> (Value -> Parser (Data f Any))
-> Value
-> Parser (StrippedJSON fds opts a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Value -> Parser (Data f Any)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (AesonOptions opts => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @opts)

instance
       ( AesonOptions opts
       , StripFields lt fds l
       , Generic a
       , FromOR f l
       , ToORRepLazy a lt
       , Functor (Arborify l)
       , Contravariant (Arborify l)
       , GToJSON Zero (Arborify l)
       , GToEncoding Zero (Arborify l)
       )
    => ToJSON (StrippedJSON fds opts a) where
    toJSON :: StrippedJSON fds opts a -> Value
toJSON
        = Options -> Data f Any -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (AesonOptions opts => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @opts)
        (Data f Any -> Value)
-> (StrippedJSON fds opts a -> Data f Any)
-> StrippedJSON fds opts a
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OR l Any -> Data f Any
forall (f :: * -> *) (l :: * -> *) x.
FromOR f l =>
OR l x -> Data f x
fromOR'
        (OR l Any -> Data f Any)
-> (StrippedJSON fds opts a -> OR l Any)
-> StrippedJSON fds opts a
-> Data f Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR lt x -> OR l x
forall (l :: * -> *) x. StripFields lt fds l => OR lt x -> OR l x
stripFields @lt @fds
        (OR lt Any -> OR l Any)
-> (StrippedJSON fds opts a -> OR lt Any)
-> StrippedJSON fds opts a
-> OR l Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (l :: * -> *) x.
(Generic a, ToORRepLazy a l) =>
a -> OR l x
forall (l :: * -> *) x. (Generic a, ToORRepLazy a l) => a -> OR l x
toORLazy @a
        (a -> OR lt Any)
-> (StrippedJSON fds opts a -> a)
-> StrippedJSON fds opts a
-> OR lt Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrippedJSON fds opts a -> a
forall (fds :: [*]) (opts :: [*]) a. StrippedJSON fds opts a -> a
unStrippedJSON

    toEncoding :: StrippedJSON fds opts a -> Encoding
toEncoding
        = Options -> Data f Any -> Encoding
forall a.
(Generic a, GToJSON Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (AesonOptions opts => Options
forall k (xs :: k). AesonOptions xs => Options
aesonOptions @opts)
        (Data f Any -> Encoding)
-> (StrippedJSON fds opts a -> Data f Any)
-> StrippedJSON fds opts a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OR l Any -> Data f Any
forall (f :: * -> *) (l :: * -> *) x.
FromOR f l =>
OR l x -> Data f x
fromOR'
        (OR l Any -> Data f Any)
-> (StrippedJSON fds opts a -> OR l Any)
-> StrippedJSON fds opts a
-> Data f Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR lt x -> OR l x
forall (l :: * -> *) x. StripFields lt fds l => OR lt x -> OR l x
stripFields @lt @fds
        (OR lt Any -> OR l Any)
-> (StrippedJSON fds opts a -> OR lt Any)
-> StrippedJSON fds opts a
-> OR l Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (l :: * -> *) x.
(Generic a, ToORRepLazy a l) =>
a -> OR l x
forall (l :: * -> *) x. (Generic a, ToORRepLazy a l) => a -> OR l x
toORLazy @a
        (a -> OR lt Any)
-> (StrippedJSON fds opts a -> a)
-> StrippedJSON fds opts a
-> OR lt Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrippedJSON fds opts a -> a
forall (fds :: [*]) (opts :: [*]) a. StrippedJSON fds opts a -> a
unStrippedJSON


-- | A field to be stripped from record values, identified by its @name@.
--
-- The @def@ value is used to recover the field when decoding (see 'RecoverableValue').
data RField (name :: Symbol) (def :: k)

-- | A field to be stripped from non-record single-constructor values,
-- identified by its __zero-based__ @position@ in the data constructor.
--
-- The @def@ value is used to recover the field when decoding (see 'RecoverableValue').
data CField (position :: Nat) (def :: k)


-- | A field row from / in which a set of fields can be stripped / recovered.
class StripFields lt fds l | lt fds -> l where
    -- | Strips a set of fields from a field row.
    stripFields :: OR lt x -> OR l x

    -- | Recovers a set of fields in a field row.
    recoverFields :: OR l x -> OR lt x


instance StripFields lt '[] lt where
    stripFields :: OR lt x -> OR lt x
stripFields = OR lt x -> OR lt x
forall a. a -> a
id
    {-# INLINE stripFields #-}

    recoverFields :: OR lt x -> OR lt x
recoverFields = OR lt x -> OR lt x
forall a. a -> a
id
    {-# INLINE recoverFields #-}

instance
       ( StripFields lt' fds l
       , RmvRField name n t' lt lt'
       , InsRField name n t' lt lt'
       , RecoverableValue def t'
       )
    => StripFields lt (RField name (def :: t) ': fds) l where
    stripFields :: OR lt x -> OR l x
stripFields
        = forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR lt x -> OR l x
forall (l :: k -> *) (x :: k).
StripFields lt' fds l =>
OR lt' x -> OR l x
stripFields @lt' @fds (OR lt' x -> OR l x) -> (OR lt x -> OR lt' x) -> OR lt x -> OR l x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t', OR lt' x) -> OR lt' x
forall a b. (a, b) -> b
snd ((t', OR lt' x) -> OR lt' x)
-> (OR lt x -> (t', OR lt' x)) -> OR lt x -> OR lt' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (fd :: Symbol) (n :: Nat) t (lt :: k -> *) (l :: k -> *)
       (x :: k).
RmvRField fd n t lt l =>
OR lt x -> (t, OR l x)
forall (n :: Nat) t (lt :: k -> *) (l :: k -> *) (x :: k).
RmvRField name n t lt l =>
OR lt x -> (t, OR l x)
removeRField @name

    recoverFields :: OR l x -> OR lt x
recoverFields
        = t' -> OR lt' x -> OR lt x
forall k (fd :: Symbol) (n :: Nat) t (lt :: k -> *) (l :: k -> *)
       (x :: k).
InsRField fd n t lt l =>
t -> OR l x -> OR lt x
insertRField' @name (Proxy def -> t'
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy def -> t') -> Proxy def -> t'
forall a b. (a -> b) -> a -> b
$ Proxy def
forall k (t :: k). Proxy t
Proxy @def)
        (OR lt' x -> OR lt x) -> (OR l x -> OR lt' x) -> OR l x -> OR lt x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR l x -> OR lt x
forall (l :: k -> *) (x :: k).
StripFields lt' fds l =>
OR l x -> OR lt' x
recoverFields @lt' @fds

instance
       ( fds' ~ DecrementAllAfter idx fds
       , StripFields lt' fds' l
       , RmvCField idx t' lt lt'
       , InsCField idx t' lt lt'
       , RecoverableValue def t'
       )
    => StripFields lt (CField idx (def :: t) ': fds) l where
    stripFields :: OR lt x -> OR l x
stripFields
        = forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR lt x -> OR l x
forall (l :: k -> *) (x :: k).
StripFields lt' fds' l =>
OR lt' x -> OR l x
stripFields @lt' @fds'
        (OR lt' x -> OR l x) -> (OR lt x -> OR lt' x) -> OR lt x -> OR l x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t', OR lt' x) -> OR lt' x
forall a b. (a, b) -> b
snd
        ((t', OR lt' x) -> OR lt' x)
-> (OR lt x -> (t', OR lt' x)) -> OR lt x -> OR lt' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (n :: Nat) t (lt :: k -> *) (l :: k -> *) (x :: k).
RmvCField n t lt l =>
OR lt x -> (t, OR l x)
forall t (lt :: k -> *) (l :: k -> *) (x :: k).
RmvCField idx t lt l =>
OR lt x -> (t, OR l x)
removeCField @idx

    recoverFields :: OR l x -> OR lt x
recoverFields
        = t' -> OR lt' x -> OR lt x
forall k (n :: Nat) t (lt :: k -> *) (l :: k -> *) (x :: k).
InsCField n t lt l =>
t -> OR l x -> OR lt x
insertCField' @idx (Proxy def -> t'
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy def -> t') -> Proxy def -> t'
forall a b. (a -> b) -> a -> b
$ Proxy def
forall k (t :: k). Proxy t
Proxy @def)
        (OR lt' x -> OR lt x) -> (OR l x -> OR lt' x) -> OR l x -> OR lt x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k k (lt :: k -> *) (fds :: k) (l :: k -> *) (x :: k).
StripFields lt fds l =>
OR l x -> OR lt x
forall (l :: k -> *) (x :: k).
StripFields lt' fds' l =>
OR l x -> OR lt' x
recoverFields @lt' @fds'


-- | Decrement the index of a 'CField' if it comes after another given field.
type family DecrementAfter (idx :: Nat) (fd :: Type) where
    DecrementAfter idx (CField idx' def)
        = CField (Eval (UnBool (Fcf.Pure idx') (idx' - 1) =<< (idx' >= idx))) def
    DecrementAfter _ fd
        = fd

-- | Decrement the indices of all the 'CField's in a list that come after a given field.
type family DecrementAllAfter (idx :: Nat) (fds :: [Type]) :: [Type] where
    DecrementAllAfter _ '[] = '[]
    DecrementAllAfter idx (fd ': fds) = DecrementAfter idx fd ': DecrementAllAfter idx fds


-- | Recovers a value by 'coerce'-ing it from another 'RecoverableValue'.
--
-- >>> recoverValue (Proxy @(Coerce 7 Int)) :: WrappedInt
-- WrappedInt 7
data Coerce (x :: k) (a :: Type)

-- | Recovers a 'String'-like value using 'fromString' from 'IsString'.
--
-- >>> recoverValue (Proxy @(FromString "text")) :: Text
-- "text"
data FromString (s :: Symbol)

-- | Recovers a list-like value using 'fromList' from 'IsList'.
--
-- >>> recoverValue (Proxy @(FromList '[1,2,3])) :: [Int]
-- [1,2,3]
data FromList (xs :: [k])

-- | Recovers a 'Monoid' value using 'mempty'.
--
-- >>> recoverValue (Proxy @Mempty) :: [Int]
-- []
data Mempty

-- | Recovers an 'Applicative' value using 'pure'.
--
-- >>> recoverValue (Proxy @(Pure 1)) :: Maybe Int
-- Just 1
data Pure (x :: k)


-- | A default field value which can be recovered when decoding.
class RecoverableValue (x :: k) (a :: Type) where
    -- | Recovers a default field value from the type-level.
    recoverValue :: Proxy x -> a


instance RecoverableValue '() () where
    recoverValue :: Proxy '() -> ()
recoverValue Proxy '()
_ = ()
    {-# INLINE recoverValue #-}

instance RecoverableValue 'False Bool where
    recoverValue :: Proxy 'False -> Bool
recoverValue Proxy 'False
_ = Bool
False
    {-# INLINE recoverValue #-}

instance RecoverableValue 'True Bool where
    recoverValue :: Proxy 'True -> Bool
recoverValue Proxy 'True
_ = Bool
True
    {-# INLINE recoverValue #-}

instance (KnownNat n, Num a) => RecoverableValue (n :: Nat) a where
    recoverValue :: Proxy n -> a
recoverValue = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> a) -> (Proxy n -> Integer) -> Proxy n -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal
    {-# INLINE recoverValue #-}

-- | A constraint for requiring a 'Symbol' to represent a valid ASCII 'Char'.
type IsValidChar char =
    ( KnownSymbol char
    , char ~ Head char
    , Eval
        ( UnBool
            (Fcf.Pure (() :: Constraint))
            (TError (Error.ShowType char Error.:<>: Error.Text " is not a valid Char."))
        =<< ((char == "") || (False == (CmpSymbol char (Head char) == 'EQ)))
        )
    )

instance IsValidChar c => RecoverableValue (c :: Symbol) Char where
    recoverValue :: Proxy c -> Char
recoverValue = [Char] -> Char
forall a. [a] -> a
head ([Char] -> Char) -> (Proxy c -> [Char]) -> Proxy c -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy c -> [Char]
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue
    {-# INLINE recoverValue #-}

instance KnownSymbol s => RecoverableValue (s :: Symbol) String where
    recoverValue :: Proxy s -> [Char]
recoverValue = Proxy s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal
    {-# INLINE recoverValue #-}

instance (KnownSymbol s, IsString a) => RecoverableValue (FromString s) a where
    recoverValue :: Proxy (FromString s) -> a
recoverValue Proxy (FromString s)
_ = [Char] -> a
forall a. IsString a => [Char] -> a
fromString ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ Proxy s -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy s -> [Char]) -> Proxy s -> [Char]
forall a b. (a -> b) -> a -> b
$ Proxy s
forall k (t :: k). Proxy t
Proxy @s
    {-# INLINE recoverValue #-}

instance RecoverableValue '[] [a] where
    recoverValue :: Proxy '[] -> [a]
recoverValue Proxy '[]
_ = []
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue x a
       , RecoverableValue xs [a]
       )
    => RecoverableValue (x ': xs) [a] where
    recoverValue :: Proxy (x : xs) -> [a]
recoverValue Proxy (x : xs)
_ = Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x
forall k (t :: k). Proxy t
Proxy @x) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Proxy xs -> [a]
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy xs
forall k (t :: k). Proxy t
Proxy @xs)
    {-# INLINE recoverValue #-}

instance (Coercible a b, RecoverableValue x a) => RecoverableValue (Coerce x a) b where
    recoverValue :: Proxy (Coerce x a) -> b
recoverValue Proxy (Coerce x a)
_ = Coercible a b => a -> b
coerce @a @b (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
    {-# INLINE recoverValue #-}

instance
       ( IsList a
       , RecoverableValue xs [Item a]
       )
    => RecoverableValue (FromList xs) a where
    recoverValue :: Proxy (FromList xs) -> a
recoverValue Proxy (FromList xs)
_ = [Item a] -> a
forall l. IsList l => [Item l] -> l
fromList ([Item a] -> a) -> [Item a] -> a
forall a b. (a -> b) -> a -> b
$ Proxy xs -> [Item a]
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy xs -> [Item a]) -> Proxy xs -> [Item a]
forall a b. (a -> b) -> a -> b
$ Proxy xs
forall k (t :: k). Proxy t
Proxy @xs
    {-# INLINE recoverValue #-}

instance RecoverableValue 'Nothing (Maybe a) where
    recoverValue :: Proxy 'Nothing -> Maybe a
recoverValue Proxy 'Nothing
_ = Maybe a
forall a. Maybe a
Nothing
    {-# INLINE recoverValue #-}

instance RecoverableValue x a => RecoverableValue ('Just x) (Maybe a) where
    recoverValue :: Proxy ('Just x) -> Maybe a
recoverValue Proxy ('Just x)
_ = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
    {-# INLINE recoverValue #-}

instance RecoverableValue x e => RecoverableValue ('Left x) (Either e a) where
    recoverValue :: Proxy ('Left x) -> Either e a
recoverValue Proxy ('Left x)
_ = e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ Proxy x -> e
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> e) -> Proxy x -> e
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
    {-# INLINE recoverValue #-}

instance RecoverableValue x a => RecoverableValue ('Right x) (Either e a) where
    recoverValue :: Proxy ('Right x) -> Either e a
recoverValue Proxy ('Right x)
_ = a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> a -> Either e a
forall a b. (a -> b) -> a -> b
$ Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue x a
       , RecoverableValue y b
       )
    => RecoverableValue '(x, y) (a, b) where
    recoverValue :: Proxy '(x, y) -> (a, b)
recoverValue Proxy '(x, y)
_ =
        ( Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
        , Proxy y -> b
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy y -> b) -> Proxy y -> b
forall a b. (a -> b) -> a -> b
$ Proxy y
forall k (t :: k). Proxy t
Proxy @y
        )
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue x a
       , RecoverableValue y b
       , RecoverableValue z c
       )
    => RecoverableValue '(x, y, z) (a, b, c) where
    recoverValue :: Proxy '(x, y, z) -> (a, b, c)
recoverValue Proxy '(x, y, z)
_ =
        ( Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
        , Proxy y -> b
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy y -> b) -> Proxy y -> b
forall a b. (a -> b) -> a -> b
$ Proxy y
forall k (t :: k). Proxy t
Proxy @y
        , Proxy z -> c
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy z -> c) -> Proxy z -> c
forall a b. (a -> b) -> a -> b
$ Proxy z
forall k (t :: k). Proxy t
Proxy @z
        )
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue w a
       , RecoverableValue x b
       , RecoverableValue y c
       , RecoverableValue z d
       )
    => RecoverableValue '(w, x, y, z) (a, b, c, d) where
    recoverValue :: Proxy '(w, x, y, z) -> (a, b, c, d)
recoverValue Proxy '(w, x, y, z)
_ =
        ( Proxy w -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy w -> a) -> Proxy w -> a
forall a b. (a -> b) -> a -> b
$ Proxy w
forall k (t :: k). Proxy t
Proxy @w
        , Proxy x -> b
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> b) -> Proxy x -> b
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
        , Proxy y -> c
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy y -> c) -> Proxy y -> c
forall a b. (a -> b) -> a -> b
$ Proxy y
forall k (t :: k). Proxy t
Proxy @y
        , Proxy z -> d
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy z -> d) -> Proxy z -> d
forall a b. (a -> b) -> a -> b
$ Proxy z
forall k (t :: k). Proxy t
Proxy @z
        )
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue v a
       , RecoverableValue w b
       , RecoverableValue x c
       , RecoverableValue y d
       , RecoverableValue z e
       )
    => RecoverableValue '(v, w, x, y, z) (a, b, c, d, e) where
    recoverValue :: Proxy '(v, w, x, y, z) -> (a, b, c, d, e)
recoverValue Proxy '(v, w, x, y, z)
_ =
        ( Proxy v -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy v -> a) -> Proxy v -> a
forall a b. (a -> b) -> a -> b
$ Proxy v
forall k (t :: k). Proxy t
Proxy @v
        , Proxy w -> b
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy w -> b) -> Proxy w -> b
forall a b. (a -> b) -> a -> b
$ Proxy w
forall k (t :: k). Proxy t
Proxy @w
        , Proxy x -> c
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> c) -> Proxy x -> c
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
        , Proxy y -> d
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy y -> d) -> Proxy y -> d
forall a b. (a -> b) -> a -> b
$ Proxy y
forall k (t :: k). Proxy t
Proxy @y
        , Proxy z -> e
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy z -> e) -> Proxy z -> e
forall a b. (a -> b) -> a -> b
$ Proxy z
forall k (t :: k). Proxy t
Proxy @z
        )
    {-# INLINE recoverValue #-}

instance
       ( RecoverableValue u a
       , RecoverableValue v b
       , RecoverableValue w c
       , RecoverableValue x d
       , RecoverableValue y e
       , RecoverableValue z f
       )
    => RecoverableValue '(u, v, w, x, y, z) (a, b, c, d, e, f) where
    recoverValue :: Proxy '(u, v, w, x, y, z) -> (a, b, c, d, e, f)
recoverValue Proxy '(u, v, w, x, y, z)
_ =
        ( Proxy u -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy u -> a) -> Proxy u -> a
forall a b. (a -> b) -> a -> b
$ Proxy u
forall k (t :: k). Proxy t
Proxy @u
        , Proxy v -> b
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy v -> b) -> Proxy v -> b
forall a b. (a -> b) -> a -> b
$ Proxy v
forall k (t :: k). Proxy t
Proxy @v
        , Proxy w -> c
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy w -> c) -> Proxy w -> c
forall a b. (a -> b) -> a -> b
$ Proxy w
forall k (t :: k). Proxy t
Proxy @w
        , Proxy x -> d
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> d) -> Proxy x -> d
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
        , Proxy y -> e
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy y -> e) -> Proxy y -> e
forall a b. (a -> b) -> a -> b
$ Proxy y
forall k (t :: k). Proxy t
Proxy @y
        , Proxy z -> f
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy z -> f) -> Proxy z -> f
forall a b. (a -> b) -> a -> b
$ Proxy z
forall k (t :: k). Proxy t
Proxy @z
        )
    {-# INLINE recoverValue #-}

instance (Applicative f, RecoverableValue x a) => RecoverableValue (Pure x) (f a) where
    recoverValue :: Proxy (Pure x) -> f a
recoverValue Proxy (Pure x)
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a) -> a -> f a
forall a b. (a -> b) -> a -> b
$ Proxy x -> a
forall k (x :: k) a. RecoverableValue x a => Proxy x -> a
recoverValue (Proxy x -> a) -> Proxy x -> a
forall a b. (a -> b) -> a -> b
$ Proxy x
forall k (t :: k). Proxy t
Proxy @x
    {-# INLINE recoverValue #-}

instance Monoid m => RecoverableValue Mempty m where
    recoverValue :: Proxy Mempty -> m
recoverValue Proxy Mempty
_ = m
forall a. Monoid a => a
mempty
    {-# INLINE recoverValue #-}


-- $presentation
--
-- A layer around the [deriving-aeson](http://hackage.haskell.org/package/deriving-aeson)
-- package, with the ability to strip one or more fields from the JSON output, and recover
-- them when decoding using some specified defaults.

-- $setup
--
-- == Examples
--
-- === Setup
--
-- All the examples on this page are based on the following setup code:
--
-- >>> :set -XDataKinds
-- >>> :set -XDeriveGeneric
-- >>> :set -XDerivingVia
-- >>> :set -XGeneralizedNewtypeDeriving
-- >>> :set -XOverloadedStrings
-- >>> :set -XTypeApplications
--
-- >>> import Data.Aeson
-- >>> import Deriving.Aeson.Stripped
-- >>> import qualified Data.Set as Set
-- >>> import Data.Text (Text)
--
-- >>> :{
--  newtype WrappedInt
--      = WrappedInt Int
--      deriving (FromJSON, Show, ToJSON)
-- :}
--
-- >>> :{
--  data RecordTest = RecordTest
--      { testBool     :: !Bool
--      , testNumber   :: {-# UNPACK #-} !Int
--      , testNewtype  :: !WrappedInt
--      , testString   :: String
--      , testIsString :: !Text
--      , testList     :: ![Int]
--      , testIsList   :: Set.Set Int
--      , testMonoid   :: !Ordering
--      , testValue    :: Double
--      }
--      deriving (Generic, Show)
--      deriving (FromJSON, ToJSON)
--          via StrippedJSON
--              '[ RField "testBool"     'False
--               , RField "testIsList"   (FromList '[ 13, 14, 13 ])
--               , RField "testIsString" (FromString "text")
--               , RField "testList"     '[ 10, 11, 12 ]
--               , RField "testMonoid"   Mempty
--               , RField "testNewtype"  (Coerce 42 Int)
--               , RField "testNumber"   7
--               , RField "testString"   "string"
--               ]
--              '[]
--              RecordTest
-- :}
--
-- Note that the order of the `RField` instructions does not matter ..
--
-- >>> let recordTest = RecordTest True 1 (WrappedInt 2) "s" "t" [1..3] (Set.fromList [4..6]) GT 3.14
--
-- >>> :{
--  data NonRecordTest
--      = NonRecordTest () (Either String Int) (Maybe Int) ![Int] (Bool, Char, Int)
--      deriving (Generic, Show)
--      deriving (FromJSON, ToJSON)
--          via StrippedJSON
--              '[ CField 0 '()
--               , CField 1 ('Left "test")
--               , CField 3 (Pure 7)
--               , CField 2 'Nothing
--               , CField 4 '( 'False, "z", 42 )
--               ]
--              '[]
--              NonRecordTest
-- :}
--
-- .. nor does the order of the `CField` instructions.
--
-- >>> let nonRecordTest = NonRecordTest () (Right 1) (Just 2) [3..5] (True, 'a', 6)

-- $examples
--
-- === Stripping fields in a record value: ..
--
-- >>> encode recordTest
-- "{\"testValue\":3.14}"
--
-- === .. and recovering them when decoding using the specified defaults:
--
-- >>> decode @RecordTest $ encode recordTest
-- Just (RecordTest {testBool = False, testNumber = 7, testNewtype = WrappedInt 42, testString = "string", testIsString = "text", testList = [10,11,12], testIsList = fromList [13,14], testMonoid = EQ, testValue = 3.14})
--
-- === Stripping fields in a non-record value: ..
-- >>> encode nonRecordTest
-- "[]"
--
-- === .. and recovering them when decoding using the specified defaults:
--
-- >>> decode @NonRecordTest $ encode nonRecordTest
-- Just (NonRecordTest () (Left "test") Nothing [7] (False,'z',42))
--
-- === Specifying encoding / decoding options:
--
-- The second parameter to 'StrippedJSON' works exactly the same as the only parameter
-- to 'CustomJSON' from the
-- [deriving-aeson](http://hackage.haskell.org/package/deriving-aeson) package.
--
-- >>> encode $ StrippedJSON @'[] @'[ FieldLabelModifier CamelToSnake ] recordTest
-- "{\"test_bool\":true,\"test_number\":1,\"test_newtype\":2,\"test_string\":\"s\",\"test_is_string\":\"t\",\"test_list\":[1,2,3],\"test_is_list\":[4,5,6],\"test_monoid\":\"GT\",\"test_value\":3.14}"