{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module:      Data.Aeson.Types.Generic
-- Copyright:   (c) 2012-2016 Bryan O'Sullivan
--              (c) 2011, 2012 Bas Van Dijk
--              (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
-- Stability:   experimental
-- Portability: portable
--
-- Helpers for generic derivations.

module Data.Aeson.Types.Generic
    (
      IsRecord
    , AllNullary
    , Tagged2(..)
    , True
    , False
    , And
    , Zero
    , One
    , ProductSize(..)
    , (:*)(..)
    ) where

import Prelude.Compat
import Data.Kind (Type)

import GHC.Generics

--------------------------------------------------------------------------------

class IsRecord (f :: Type -> Type) isRecord | f -> isRecord

instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
instance {-# OVERLAPPING #-} IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
instance IsRecord (K1 i c) True
instance IsRecord Par1 True
instance IsRecord (Rec1 f) True
instance IsRecord (f :.: g) True
instance IsRecord U1 False

--------------------------------------------------------------------------------

class AllNullary (f :: Type -> Type) allNullary | f -> allNullary

instance ( AllNullary a allNullaryL
         , AllNullary b allNullaryR
         , And allNullaryL allNullaryR allNullary
         ) => AllNullary (a :+: b) allNullary
instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
instance AllNullary (a :*: b) False
instance AllNullary (a :.: b) False
instance AllNullary (K1 i c) False
instance AllNullary Par1 False
instance AllNullary (Rec1 f) False
instance AllNullary U1 True

newtype Tagged2 (s :: Type -> Type) b = Tagged2 {forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 :: b}
  deriving forall a b. a -> Tagged2 s b -> Tagged2 s a
forall a b. (a -> b) -> Tagged2 s a -> Tagged2 s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (s :: * -> *) a b. a -> Tagged2 s b -> Tagged2 s a
forall (s :: * -> *) a b. (a -> b) -> Tagged2 s a -> Tagged2 s b
<$ :: forall a b. a -> Tagged2 s b -> Tagged2 s a
$c<$ :: forall (s :: * -> *) a b. a -> Tagged2 s b -> Tagged2 s a
fmap :: forall a b. (a -> b) -> Tagged2 s a -> Tagged2 s b
$cfmap :: forall (s :: * -> *) a b. (a -> b) -> Tagged2 s a -> Tagged2 s b
Functor

--------------------------------------------------------------------------------

data True
data False

class    And bool1 bool2 bool3 | bool1 bool2 -> bool3

instance And True  True  True
instance And False False False
instance And False True  False
instance And True  False False

--------------------------------------------------------------------------------

-- | A type-level indicator that 'ToJSON' or 'FromJSON' is being derived generically.
data Zero

-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.
data One

--------------------------------------------------------------------------------

class ProductSize f where
    productSize :: Tagged2 f Int

instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
    productSize :: Tagged2 (a :*: b) Int
productSize = forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 forall a b. (a -> b) -> a -> b
$ forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 (forall (f :: * -> *). ProductSize f => Tagged2 f Int
productSize :: Tagged2 a Int) forall a. Num a => a -> a -> a
+
                            forall (s :: * -> *) b. Tagged2 s b -> b
unTagged2 (forall (f :: * -> *). ProductSize f => Tagged2 f Int
productSize :: Tagged2 b Int)

instance ProductSize (S1 s a) where
    productSize :: Tagged2 (S1 s a) Int
productSize = forall (s :: * -> *) b. b -> Tagged2 s b
Tagged2 Int
1

--------------------------------------------------------------------------------

-- | Simple extensible tuple type to simplify passing around many parameters.
data a :* b = a :* b

infixr 1 :*