1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE EmptyDataDecls #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FunctionalDependencies #-}
7{-# LANGUAGE KindSignatures #-}
8{-# LANGUAGE NoImplicitPrelude #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeOperators #-}
11{-# LANGUAGE UndecidableInstances #-}
12
13#include "overlapping-compat.h"
14
15-- |
16-- Module:      Data.Aeson.Types.Generic
17-- Copyright:   (c) 2012-2016 Bryan O'Sullivan
18--              (c) 2011, 2012 Bas Van Dijk
19--              (c) 2011 MailRank, Inc.
20-- License:     BSD3
21-- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>
22-- Stability:   experimental
23-- Portability: portable
24--
25-- Helpers for generic derivations.
26
27module Data.Aeson.Types.Generic
28    (
29      IsRecord
30    , AllNullary
31    , Tagged2(..)
32    , True
33    , False
34    , And
35    , Zero
36    , One
37    , ProductSize(..)
38    , (:*)(..)
39    ) where
40
41import Prelude.Compat
42
43import GHC.Generics
44
45--------------------------------------------------------------------------------
46
47class IsRecord (f :: * -> *) isRecord | f -> isRecord
48
49instance (IsRecord f isRecord) => IsRecord (f :*: g) isRecord
50#if MIN_VERSION_base(4,9,0)
51instance OVERLAPPING_ IsRecord (M1 S ('MetaSel 'Nothing u ss ds) f) False
52#else
53instance OVERLAPPING_ IsRecord (M1 S NoSelector f) False
54#endif
55instance (IsRecord f isRecord) => IsRecord (M1 S c f) isRecord
56instance IsRecord (K1 i c) True
57instance IsRecord Par1 True
58instance IsRecord (Rec1 f) True
59instance IsRecord (f :.: g) True
60instance IsRecord U1 False
61
62--------------------------------------------------------------------------------
63
64class AllNullary (f :: * -> *) allNullary | f -> allNullary
65
66instance ( AllNullary a allNullaryL
67         , AllNullary b allNullaryR
68         , And allNullaryL allNullaryR allNullary
69         ) => AllNullary (a :+: b) allNullary
70instance AllNullary a allNullary => AllNullary (M1 i c a) allNullary
71instance AllNullary (a :*: b) False
72instance AllNullary (a :.: b) False
73instance AllNullary (K1 i c) False
74instance AllNullary Par1 False
75instance AllNullary (Rec1 f) False
76instance AllNullary U1 True
77
78newtype Tagged2 (s :: * -> *) b = Tagged2 {unTagged2 :: b}
79  deriving Functor
80
81--------------------------------------------------------------------------------
82
83data True
84data False
85
86class    And bool1 bool2 bool3 | bool1 bool2 -> bool3
87
88instance And True  True  True
89instance And False False False
90instance And False True  False
91instance And True  False False
92
93--------------------------------------------------------------------------------
94
95-- | A type-level indicator that 'ToJSON' or 'FromJSON' is being derived generically.
96data Zero
97
98-- | A type-level indicator that 'ToJSON1' or 'FromJSON1' is being derived generically.
99data One
100
101--------------------------------------------------------------------------------
102
103class ProductSize f where
104    productSize :: Tagged2 f Int
105
106instance (ProductSize a, ProductSize b) => ProductSize (a :*: b) where
107    productSize = Tagged2 $ unTagged2 (productSize :: Tagged2 a Int) +
108                            unTagged2 (productSize :: Tagged2 b Int)
109
110instance ProductSize (S1 s a) where
111    productSize = Tagged2 1
112
113--------------------------------------------------------------------------------
114
115-- | Simple extensible tuple type to simplify passing around many parameters.
116data a :* b = a :* b
117
118infixr 1 :*
119