{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Jordan.Generic.Options where

import Data.Coerce
import Data.Text (Text)
import qualified Data.Text as T
import Data.Type.Bool
import Data.Typeable (TypeRep, splitTyConApp, tyConModule, tyConName)
import GHC.Exts (Constraint)
import GHC.Generics
import GHC.TypeLits

type Representational (f :: * -> *) =
  (forall a b. (Coercible a b) => Coercible (f a) (f b) :: Constraint)

data SumTypeEncoding
  = TagVal
  | TagInField
  deriving (Int -> SumTypeEncoding -> ShowS
[SumTypeEncoding] -> ShowS
SumTypeEncoding -> String
(Int -> SumTypeEncoding -> ShowS)
-> (SumTypeEncoding -> String)
-> ([SumTypeEncoding] -> ShowS)
-> Show SumTypeEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumTypeEncoding] -> ShowS
$cshowList :: [SumTypeEncoding] -> ShowS
show :: SumTypeEncoding -> String
$cshow :: SumTypeEncoding -> String
showsPrec :: Int -> SumTypeEncoding -> ShowS
$cshowsPrec :: Int -> SumTypeEncoding -> ShowS
Show, ReadPrec [SumTypeEncoding]
ReadPrec SumTypeEncoding
Int -> ReadS SumTypeEncoding
ReadS [SumTypeEncoding]
(Int -> ReadS SumTypeEncoding)
-> ReadS [SumTypeEncoding]
-> ReadPrec SumTypeEncoding
-> ReadPrec [SumTypeEncoding]
-> Read SumTypeEncoding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SumTypeEncoding]
$creadListPrec :: ReadPrec [SumTypeEncoding]
readPrec :: ReadPrec SumTypeEncoding
$creadPrec :: ReadPrec SumTypeEncoding
readList :: ReadS [SumTypeEncoding]
$creadList :: ReadS [SumTypeEncoding]
readsPrec :: Int -> ReadS SumTypeEncoding
$creadsPrec :: Int -> ReadS SumTypeEncoding
Read, SumTypeEncoding -> SumTypeEncoding -> Bool
(SumTypeEncoding -> SumTypeEncoding -> Bool)
-> (SumTypeEncoding -> SumTypeEncoding -> Bool)
-> Eq SumTypeEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c/= :: SumTypeEncoding -> SumTypeEncoding -> Bool
== :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c== :: SumTypeEncoding -> SumTypeEncoding -> Bool
Eq, Eq SumTypeEncoding
Eq SumTypeEncoding
-> (SumTypeEncoding -> SumTypeEncoding -> Ordering)
-> (SumTypeEncoding -> SumTypeEncoding -> Bool)
-> (SumTypeEncoding -> SumTypeEncoding -> Bool)
-> (SumTypeEncoding -> SumTypeEncoding -> Bool)
-> (SumTypeEncoding -> SumTypeEncoding -> Bool)
-> (SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding)
-> (SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding)
-> Ord SumTypeEncoding
SumTypeEncoding -> SumTypeEncoding -> Bool
SumTypeEncoding -> SumTypeEncoding -> Ordering
SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding
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
min :: SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding
$cmin :: SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding
max :: SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding
$cmax :: SumTypeEncoding -> SumTypeEncoding -> SumTypeEncoding
>= :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c>= :: SumTypeEncoding -> SumTypeEncoding -> Bool
> :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c> :: SumTypeEncoding -> SumTypeEncoding -> Bool
<= :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c<= :: SumTypeEncoding -> SumTypeEncoding -> Bool
< :: SumTypeEncoding -> SumTypeEncoding -> Bool
$c< :: SumTypeEncoding -> SumTypeEncoding -> Bool
compare :: SumTypeEncoding -> SumTypeEncoding -> Ordering
$ccompare :: SumTypeEncoding -> SumTypeEncoding -> Ordering
$cp1Ord :: Eq SumTypeEncoding
Ord, SumTypeEncoding
SumTypeEncoding -> SumTypeEncoding -> Bounded SumTypeEncoding
forall a. a -> a -> Bounded a
maxBound :: SumTypeEncoding
$cmaxBound :: SumTypeEncoding
minBound :: SumTypeEncoding
$cminBound :: SumTypeEncoding
Bounded, Int -> SumTypeEncoding
SumTypeEncoding -> Int
SumTypeEncoding -> [SumTypeEncoding]
SumTypeEncoding -> SumTypeEncoding
SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
SumTypeEncoding
-> SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
(SumTypeEncoding -> SumTypeEncoding)
-> (SumTypeEncoding -> SumTypeEncoding)
-> (Int -> SumTypeEncoding)
-> (SumTypeEncoding -> Int)
-> (SumTypeEncoding -> [SumTypeEncoding])
-> (SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding])
-> (SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding])
-> (SumTypeEncoding
    -> SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding])
-> Enum SumTypeEncoding
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SumTypeEncoding
-> SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
$cenumFromThenTo :: SumTypeEncoding
-> SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
enumFromTo :: SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
$cenumFromTo :: SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
enumFromThen :: SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
$cenumFromThen :: SumTypeEncoding -> SumTypeEncoding -> [SumTypeEncoding]
enumFrom :: SumTypeEncoding -> [SumTypeEncoding]
$cenumFrom :: SumTypeEncoding -> [SumTypeEncoding]
fromEnum :: SumTypeEncoding -> Int
$cfromEnum :: SumTypeEncoding -> Int
toEnum :: Int -> SumTypeEncoding
$ctoEnum :: Int -> SumTypeEncoding
pred :: SumTypeEncoding -> SumTypeEncoding
$cpred :: SumTypeEncoding -> SumTypeEncoding
succ :: SumTypeEncoding -> SumTypeEncoding
$csucc :: SumTypeEncoding -> SumTypeEncoding
Enum, (forall x. SumTypeEncoding -> Rep SumTypeEncoding x)
-> (forall x. Rep SumTypeEncoding x -> SumTypeEncoding)
-> Generic SumTypeEncoding
forall x. Rep SumTypeEncoding x -> SumTypeEncoding
forall x. SumTypeEncoding -> Rep SumTypeEncoding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SumTypeEncoding x -> SumTypeEncoding
$cfrom :: forall x. SumTypeEncoding -> Rep SumTypeEncoding x
Generic)

type family AllNullary cons where
  AllNullary (C1 ('MetaCons _ _ 'False) (S1 ('MetaSel 'Nothing _ _ _) U1)) = True
  AllNullary (a :+: b) = AllNullary a && AllNullary b
  AllNullary _ = False

newtype PartOfSum f a = MkPartOfSum {PartOfSum f a -> f a
getPartOfSum :: f a}
  deriving (Int -> PartOfSum f a -> ShowS
[PartOfSum f a] -> ShowS
PartOfSum f a -> String
(Int -> PartOfSum f a -> ShowS)
-> (PartOfSum f a -> String)
-> ([PartOfSum f a] -> ShowS)
-> Show (PartOfSum f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> PartOfSum f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [PartOfSum f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => PartOfSum f a -> String
showList :: [PartOfSum f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [PartOfSum f a] -> ShowS
show :: PartOfSum f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => PartOfSum f a -> String
showsPrec :: Int -> PartOfSum f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> PartOfSum f a -> ShowS
Show, ReadPrec [PartOfSum f a]
ReadPrec (PartOfSum f a)
Int -> ReadS (PartOfSum f a)
ReadS [PartOfSum f a]
(Int -> ReadS (PartOfSum f a))
-> ReadS [PartOfSum f a]
-> ReadPrec (PartOfSum f a)
-> ReadPrec [PartOfSum f a]
-> Read (PartOfSum f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [PartOfSum f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (PartOfSum f a)
forall (f :: * -> *) a. Read (f a) => Int -> ReadS (PartOfSum f a)
forall (f :: * -> *) a. Read (f a) => ReadS [PartOfSum f a]
readListPrec :: ReadPrec [PartOfSum f a]
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [PartOfSum f a]
readPrec :: ReadPrec (PartOfSum f a)
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (PartOfSum f a)
readList :: ReadS [PartOfSum f a]
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [PartOfSum f a]
readsPrec :: Int -> ReadS (PartOfSum f a)
$creadsPrec :: forall (f :: * -> *) a. Read (f a) => Int -> ReadS (PartOfSum f a)
Read, PartOfSum f a -> PartOfSum f a -> Bool
(PartOfSum f a -> PartOfSum f a -> Bool)
-> (PartOfSum f a -> PartOfSum f a -> Bool) -> Eq (PartOfSum f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a.
Eq (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
/= :: PartOfSum f a -> PartOfSum f a -> Bool
$c/= :: forall (f :: * -> *) a.
Eq (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
== :: PartOfSum f a -> PartOfSum f a -> Bool
$c== :: forall (f :: * -> *) a.
Eq (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
Eq, Eq (PartOfSum f a)
Eq (PartOfSum f a)
-> (PartOfSum f a -> PartOfSum f a -> Ordering)
-> (PartOfSum f a -> PartOfSum f a -> Bool)
-> (PartOfSum f a -> PartOfSum f a -> Bool)
-> (PartOfSum f a -> PartOfSum f a -> Bool)
-> (PartOfSum f a -> PartOfSum f a -> Bool)
-> (PartOfSum f a -> PartOfSum f a -> PartOfSum f a)
-> (PartOfSum f a -> PartOfSum f a -> PartOfSum f a)
-> Ord (PartOfSum f a)
PartOfSum f a -> PartOfSum f a -> Bool
PartOfSum f a -> PartOfSum f a -> Ordering
PartOfSum f a -> PartOfSum f a -> PartOfSum 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 (PartOfSum f a)
forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> PartOfSum f a
min :: PartOfSum f a -> PartOfSum f a -> PartOfSum f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> PartOfSum f a
max :: PartOfSum f a -> PartOfSum f a -> PartOfSum f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> PartOfSum f a
>= :: PartOfSum f a -> PartOfSum f a -> Bool
$c>= :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
> :: PartOfSum f a -> PartOfSum f a -> Bool
$c> :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
<= :: PartOfSum f a -> PartOfSum f a -> Bool
$c<= :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
< :: PartOfSum f a -> PartOfSum f a -> Bool
$c< :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Bool
compare :: PartOfSum f a -> PartOfSum f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
PartOfSum f a -> PartOfSum f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. Ord (f a) => Eq (PartOfSum f a)
Ord, (forall x. PartOfSum f a -> Rep (PartOfSum f a) x)
-> (forall x. Rep (PartOfSum f a) x -> PartOfSum f a)
-> Generic (PartOfSum f a)
forall x. Rep (PartOfSum f a) x -> PartOfSum f a
forall x. PartOfSum f a -> Rep (PartOfSum f a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) a x. Rep (PartOfSum f a) x -> PartOfSum f a
forall (f :: * -> *) a x. PartOfSum f a -> Rep (PartOfSum f a) x
$cto :: forall (f :: * -> *) a x. Rep (PartOfSum f a) x -> PartOfSum f a
$cfrom :: forall (f :: * -> *) a x. PartOfSum f a -> Rep (PartOfSum f a) x
Generic)

-- | A newtype wrapper, designed to make it easier to derive ToJSON and FromJSON instances.
-- The API of abstract JSON serializing is awkward due to the somewhat bad ergonomics of the
-- 'Data.Functor.Contravariant.Divisible.Divisible' and (especially)
-- 'Data.Functor.Contravariant.Divisible.Decidable' typeclasses.
--
-- In general, using @ -XDerivingVia @, @ -XDeriveGeneric @, @ -XDataKinds @ and this wrapper will make your life much easier.
-- Unfortunately, due to a weird GHC quirk, you also need @ -XDerivingVia @.
--
-- That is, the following won't work, complaining about role errors:
--
-- @
--  data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
--    deriving (Show, Generic)
--    deriving (ToJSON, FromJSON) via (WithOptions '[KeepNothingFields] PersonFilter)
-- @
--
-- But this will:
--
-- @
--  data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
--    deriving (Show, Generic)
--
--  deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (ToJSON PersonFilter)
--  deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (FromJSON PersonFilter)
-- @
newtype WithOptions (options :: [*]) a = WithOptions {WithOptions options a -> a
getWithOptions :: a}
  deriving (Int -> WithOptions options a -> ShowS
[WithOptions options a] -> ShowS
WithOptions options a -> String
(Int -> WithOptions options a -> ShowS)
-> (WithOptions options a -> String)
-> ([WithOptions options a] -> ShowS)
-> Show (WithOptions options a)
forall (options :: [*]) a.
Show a =>
Int -> WithOptions options a -> ShowS
forall (options :: [*]) a.
Show a =>
[WithOptions options a] -> ShowS
forall (options :: [*]) a.
Show a =>
WithOptions options a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithOptions options a] -> ShowS
$cshowList :: forall (options :: [*]) a.
Show a =>
[WithOptions options a] -> ShowS
show :: WithOptions options a -> String
$cshow :: forall (options :: [*]) a.
Show a =>
WithOptions options a -> String
showsPrec :: Int -> WithOptions options a -> ShowS
$cshowsPrec :: forall (options :: [*]) a.
Show a =>
Int -> WithOptions options a -> ShowS
Show, WithOptions options a -> WithOptions options a -> Bool
(WithOptions options a -> WithOptions options a -> Bool)
-> (WithOptions options a -> WithOptions options a -> Bool)
-> Eq (WithOptions options a)
forall (options :: [*]) a.
Eq a =>
WithOptions options a -> WithOptions options a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithOptions options a -> WithOptions options a -> Bool
$c/= :: forall (options :: [*]) a.
Eq a =>
WithOptions options a -> WithOptions options a -> Bool
== :: WithOptions options a -> WithOptions options a -> Bool
$c== :: forall (options :: [*]) a.
Eq a =>
WithOptions options a -> WithOptions options a -> Bool
Eq, Eq (WithOptions options a)
Eq (WithOptions options a)
-> (WithOptions options a -> WithOptions options a -> Ordering)
-> (WithOptions options a -> WithOptions options a -> Bool)
-> (WithOptions options a -> WithOptions options a -> Bool)
-> (WithOptions options a -> WithOptions options a -> Bool)
-> (WithOptions options a -> WithOptions options a -> Bool)
-> (WithOptions options a
    -> WithOptions options a -> WithOptions options a)
-> (WithOptions options a
    -> WithOptions options a -> WithOptions options a)
-> Ord (WithOptions options a)
WithOptions options a -> WithOptions options a -> Bool
WithOptions options a -> WithOptions options a -> Ordering
WithOptions options a
-> WithOptions options a -> WithOptions options a
forall (options :: [*]) a. Ord a => Eq (WithOptions options a)
forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Bool
forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Ordering
forall (options :: [*]) a.
Ord a =>
WithOptions options a
-> WithOptions options a -> WithOptions options 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
min :: WithOptions options a
-> WithOptions options a -> WithOptions options a
$cmin :: forall (options :: [*]) a.
Ord a =>
WithOptions options a
-> WithOptions options a -> WithOptions options a
max :: WithOptions options a
-> WithOptions options a -> WithOptions options a
$cmax :: forall (options :: [*]) a.
Ord a =>
WithOptions options a
-> WithOptions options a -> WithOptions options a
>= :: WithOptions options a -> WithOptions options a -> Bool
$c>= :: forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Bool
> :: WithOptions options a -> WithOptions options a -> Bool
$c> :: forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Bool
<= :: WithOptions options a -> WithOptions options a -> Bool
$c<= :: forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Bool
< :: WithOptions options a -> WithOptions options a -> Bool
$c< :: forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Bool
compare :: WithOptions options a -> WithOptions options a -> Ordering
$ccompare :: forall (options :: [*]) a.
Ord a =>
WithOptions options a -> WithOptions options a -> Ordering
$cp1Ord :: forall (options :: [*]) a. Ord a => Eq (WithOptions options a)
Ord)

-- | Newtype for use with GeneralizedNewtypeDeriving.
-- Will have us omit Nothing fields for parsing and serializing.
data OmitNothingFields = OmitNothingFields

-- | Keep nothing fields.
-- Will have us omit @ null @ when serializing Maybe types.
data KeepNothingFields = KeepNothingFields

fullyQualifyName ::
  TypeRep ->
  Text
fullyQualifyName :: TypeRep -> Text
fullyQualifyName TypeRep
tr =
  case TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
tr of
    (TyCon
tc, []) -> TyCon -> Text
baseName TyCon
tc
    (TyCon
tc, [TypeRep]
args) -> TyCon -> Text
baseName TyCon
tc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"," (TypeRep -> Text
fullyQualifyName (TypeRep -> Text) -> [TypeRep] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeRep]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    baseName :: TyCon -> Text
baseName TyCon
tc = String -> Text
T.pack (TyCon -> String
tyConModule TyCon
tc String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TyCon -> String
tyConName TyCon
tc)