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