{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
module Data.HighJson
    ( -- * A json specification for any type
      HighSpec(..), SpecType(..)
      -- * Construct specifications for records
    , recSpec, RecordTypeSpec, reqField, (.=), optField, (.=?)
      -- * Construct specifications for sum types
    , sumSpec, SumTypeSpec, sumOpt, (.->)
      -- * Construct specifications for enum types
    , enumSpec, EnumTypeSpec, enumOpt, (@->)
      -- * Shared between specifications for simplicity
    , IsDataSpec(..), (:&)(..)
      -- * Generate json serializers/encoders and parsers from specs
    , jsonSerializer, jsonEncoder, jsonParser
      -- * Specification structures
    , BodySpec(..)
    , RecordField(..), RecordSpec(..), RecordFields(..)
    , SumOption(..), SumSpec(..), SumOptions(..)
    , EnumOption(..), EnumSpec(..)
      -- * Aeson reexports
    , ToJSON(..), FromJSON(..)
      -- * Implementation detail structures
    , PhantomEnumContainer(..), CombinableContainer(..)
    )
where

import Data.HighJson.Types

import Control.Lens hiding ((.=))
import Data.Aeson ((.:), (.:?), FromJSON(..), ToJSON(..))
import Data.Typeable
import qualified Data.HVect as HV
import qualified Data.Text as T

-- | Combination of two local specifications. For records, these are fields, for sum types and enums
-- these are the options.
data a :& b
    = a :& b
    deriving (Typeable, (a :& b) -> (a :& b) -> Bool
((a :& b) -> (a :& b) -> Bool)
-> ((a :& b) -> (a :& b) -> Bool) -> Eq (a :& b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
/= :: (a :& b) -> (a :& b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
== :: (a :& b) -> (a :& b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
Eq, Int -> (a :& b) -> ShowS
[a :& b] -> ShowS
(a :& b) -> String
(Int -> (a :& b) -> ShowS)
-> ((a :& b) -> String) -> ([a :& b] -> ShowS) -> Show (a :& b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a :& b) -> ShowS
forall a b. (Show a, Show b) => [a :& b] -> ShowS
forall a b. (Show a, Show b) => (a :& b) -> String
showList :: [a :& b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [a :& b] -> ShowS
show :: (a :& b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :& b) -> String
showsPrec :: Int -> (a :& b) -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :& b) -> ShowS
Show, a -> (a :& b) -> a :& a
(a -> b) -> (a :& a) -> a :& b
(forall a b. (a -> b) -> (a :& a) -> a :& b)
-> (forall a b. a -> (a :& b) -> a :& a) -> Functor ((:&) a)
forall a b. a -> (a :& b) -> a :& a
forall a b. (a -> b) -> (a :& a) -> a :& b
forall a a b. a -> (a :& b) -> a :& a
forall a a b. (a -> b) -> (a :& a) -> a :& b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> (a :& b) -> a :& a
$c<$ :: forall a a b. a -> (a :& b) -> a :& a
fmap :: (a -> b) -> (a :& a) -> a :& b
$cfmap :: forall a a b. (a -> b) -> (a :& a) -> a :& b
Functor, Functor ((:&) a)
Foldable ((:&) a)
Functor ((:&) a)
-> Foldable ((:&) a)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> (a :& a) -> f (a :& b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    (a :& f a) -> f (a :& a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> (a :& a) -> m (a :& b))
-> (forall (m :: * -> *) a. Monad m => (a :& m a) -> m (a :& a))
-> Traversable ((:&) a)
(a -> f b) -> (a :& a) -> f (a :& b)
forall a. Functor ((:&) a)
forall a. Foldable ((:&) a)
forall a (m :: * -> *) a. Monad m => (a :& m a) -> m (a :& a)
forall a (f :: * -> *) a. Applicative f => (a :& f a) -> f (a :& a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a :& a) -> m (a :& b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (a :& a) -> f (a :& b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => (a :& m a) -> m (a :& a)
forall (f :: * -> *) a. Applicative f => (a :& f a) -> f (a :& a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a :& a) -> m (a :& b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (a :& a) -> f (a :& b)
sequence :: (a :& m a) -> m (a :& a)
$csequence :: forall a (m :: * -> *) a. Monad m => (a :& m a) -> m (a :& a)
mapM :: (a -> m b) -> (a :& a) -> m (a :& b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> (a :& a) -> m (a :& b)
sequenceA :: (a :& f a) -> f (a :& a)
$csequenceA :: forall a (f :: * -> *) a. Applicative f => (a :& f a) -> f (a :& a)
traverse :: (a -> f b) -> (a :& a) -> f (a :& b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (a :& a) -> f (a :& b)
$cp2Traversable :: forall a. Foldable ((:&) a)
$cp1Traversable :: forall a. Functor ((:&) a)
Traversable, (a :& a) -> Bool
(a -> m) -> (a :& a) -> m
(a -> b -> b) -> b -> (a :& a) -> b
(forall m. Monoid m => (a :& m) -> m)
-> (forall m a. Monoid m => (a -> m) -> (a :& a) -> m)
-> (forall m a. Monoid m => (a -> m) -> (a :& a) -> m)
-> (forall a b. (a -> b -> b) -> b -> (a :& a) -> b)
-> (forall a b. (a -> b -> b) -> b -> (a :& a) -> b)
-> (forall b a. (b -> a -> b) -> b -> (a :& a) -> b)
-> (forall b a. (b -> a -> b) -> b -> (a :& a) -> b)
-> (forall a. (a -> a -> a) -> (a :& a) -> a)
-> (forall a. (a -> a -> a) -> (a :& a) -> a)
-> (forall a. (a :& a) -> [a])
-> (forall a. (a :& a) -> Bool)
-> (forall a. (a :& a) -> Int)
-> (forall a. Eq a => a -> (a :& a) -> Bool)
-> (forall a. Ord a => (a :& a) -> a)
-> (forall a. Ord a => (a :& a) -> a)
-> (forall a. Num a => (a :& a) -> a)
-> (forall a. Num a => (a :& a) -> a)
-> Foldable ((:&) a)
forall a. Eq a => a -> (a :& a) -> Bool
forall a. Num a => (a :& a) -> a
forall a. Ord a => (a :& a) -> a
forall m. Monoid m => (a :& m) -> m
forall a. (a :& a) -> Bool
forall a. (a :& a) -> Int
forall a. (a :& a) -> [a]
forall a. (a -> a -> a) -> (a :& a) -> a
forall a a. Eq a => a -> (a :& a) -> Bool
forall a a. Num a => (a :& a) -> a
forall a a. Ord a => (a :& a) -> a
forall m a. Monoid m => (a -> m) -> (a :& a) -> m
forall a m. Monoid m => (a :& m) -> m
forall a a. (a :& a) -> Bool
forall a a. (a :& a) -> Int
forall a a. (a :& a) -> [a]
forall b a. (b -> a -> b) -> b -> (a :& a) -> b
forall a b. (a -> b -> b) -> b -> (a :& a) -> b
forall a a. (a -> a -> a) -> (a :& a) -> a
forall a m a. Monoid m => (a -> m) -> (a :& a) -> m
forall a b a. (b -> a -> b) -> b -> (a :& a) -> b
forall a a b. (a -> b -> b) -> b -> (a :& a) -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: (a :& a) -> a
$cproduct :: forall a a. Num a => (a :& a) -> a
sum :: (a :& a) -> a
$csum :: forall a a. Num a => (a :& a) -> a
minimum :: (a :& a) -> a
$cminimum :: forall a a. Ord a => (a :& a) -> a
maximum :: (a :& a) -> a
$cmaximum :: forall a a. Ord a => (a :& a) -> a
elem :: a -> (a :& a) -> Bool
$celem :: forall a a. Eq a => a -> (a :& a) -> Bool
length :: (a :& a) -> Int
$clength :: forall a a. (a :& a) -> Int
null :: (a :& a) -> Bool
$cnull :: forall a a. (a :& a) -> Bool
toList :: (a :& a) -> [a]
$ctoList :: forall a a. (a :& a) -> [a]
foldl1 :: (a -> a -> a) -> (a :& a) -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> (a :& a) -> a
foldr1 :: (a -> a -> a) -> (a :& a) -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> (a :& a) -> a
foldl' :: (b -> a -> b) -> b -> (a :& a) -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> (a :& a) -> b
foldl :: (b -> a -> b) -> b -> (a :& a) -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> (a :& a) -> b
foldr' :: (a -> b -> b) -> b -> (a :& a) -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> (a :& a) -> b
foldr :: (a -> b -> b) -> b -> (a :& a) -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> (a :& a) -> b
foldMap' :: (a -> m) -> (a :& a) -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> (a :& a) -> m
foldMap :: (a -> m) -> (a :& a) -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> (a :& a) -> m
fold :: (a :& m) -> m
$cfold :: forall a m. Monoid m => (a :& m) -> m
Foldable, a :& b
(a :& b) -> (a :& b) -> Bounded (a :& b)
forall a. a -> a -> Bounded a
forall a b. (Bounded a, Bounded b) => a :& b
maxBound :: a :& b
$cmaxBound :: forall a b. (Bounded a, Bounded b) => a :& b
minBound :: a :& b
$cminBound :: forall a b. (Bounded a, Bounded b) => a :& b
Bounded)
infixr 8 :&

instance (Semigroup a, Semigroup b) => Semigroup (a :& b) where
    (a
a :& b
b) <> :: (a :& b) -> (a :& b) -> a :& b
<> (a
a' :& b
b') = (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a') a -> b -> a :& b
forall a b. a -> b -> a :& b
:& (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b')

instance (Monoid a, Monoid b) => Monoid (a :& b) where
    mempty :: a :& b
mempty = a
forall a. Monoid a => a
mempty a -> b -> a :& b
forall a b. a -> b -> a :& b
:& b
forall a. Monoid a => a
mempty

-- | A monoidal type class that respects type level lists associated to the bodies
class CombinableContainer t where
    combineContainer :: t a (as :: [*]) -> t a (bs :: [*]) -> t a (HV.Append as bs)

instance CombinableContainer RecordFields where
    combineContainer :: RecordFields a as
-> RecordFields a bs -> RecordFields a (Append as bs)
combineContainer = RecordFields a as
-> RecordFields a bs -> RecordFields a (Append as bs)
forall a (as :: [*]) (bs :: [*]).
RecordFields a as
-> RecordFields a bs -> RecordFields a (Append as bs)
recAppend

instance CombinableContainer SumOptions where
    combineContainer :: SumOptions a as -> SumOptions a bs -> SumOptions a (Append as bs)
combineContainer = SumOptions a as -> SumOptions a bs -> SumOptions a (Append as bs)
forall a (as :: [*]) (bs :: [*]).
SumOptions a as -> SumOptions a bs -> SumOptions a (Append as bs)
sumAppend

instance CombinableContainer PhantomEnumContainer where
    combineContainer :: PhantomEnumContainer a as
-> PhantomEnumContainer a bs
-> PhantomEnumContainer a (Append as bs)
combineContainer (PhantomEnumContainer [EnumOption a]
x) (PhantomEnumContainer [EnumOption a]
y) =
        [EnumOption a] -> PhantomEnumContainer a (Append as bs)
forall t (ts :: [*]). [EnumOption t] -> PhantomEnumContainer t ts
PhantomEnumContainer ([EnumOption a] -> PhantomEnumContainer a (Append as bs))
-> [EnumOption a] -> PhantomEnumContainer a (Append as bs)
forall a b. (a -> b) -> a -> b
$ [EnumOption a]
x [EnumOption a] -> [EnumOption a] -> [EnumOption a]
forall a. [a] -> [a] -> [a]
++ [EnumOption a]
y

-- | A type class that allows a unified notation for records and sum types. Build specifications
-- using '(:&)' and '(.=)', '(.=?)', '(.->)' or '(@->)'
class IsDataSpec t where
    type DFields t :: [*]
    type DType t
    type DContainer t :: * -> [*] -> *
    compileRec :: t -> (DContainer t) (DType t) (DFields t)

instance IsDataSpec (RecordField t f) where
    type DFields (RecordField t f) = (f ': '[])
    type DType (RecordField t f) = t
    type DContainer (RecordField t f) = RecordFields
    compileRec :: RecordField t f
-> DContainer
     (RecordField t f)
     (DType (RecordField t f))
     (DFields (RecordField t f))
compileRec RecordField t f
x = RecordField t f
x RecordField t f -> RecordFields t '[] -> RecordFields t '[f]
forall t f (fs :: [*]).
RecordField t f -> RecordFields t fs -> RecordFields t (f : fs)
:+: RecordFields t '[]
forall t. RecordFields t '[]
RFEmpty

instance IsDataSpec (SumOption t f) where
    type DFields (SumOption t f) = (f ': '[])
    type DType (SumOption t f) = t
    type DContainer (SumOption t f) = SumOptions
    compileRec :: SumOption t f
-> DContainer
     (SumOption t f) (DType (SumOption t f)) (DFields (SumOption t f))
compileRec SumOption t f
x = SumOption t f
x SumOption t f -> SumOptions t '[] -> SumOptions t '[f]
forall t o (os :: [*]).
SumOption t o -> SumOptions t os -> SumOptions t (o : os)
:|: SumOptions t '[]
forall t. SumOptions t '[]
SOEmpty

newtype PhantomEnumContainer t (ts :: [*])
    = PhantomEnumContainer { PhantomEnumContainer t ts -> [EnumOption t]
unPhantomEnumContainer :: [EnumOption t] }

instance IsDataSpec (EnumOption t) where
    type DFields (EnumOption t) = (() ': '[])
    type DType (EnumOption t) = t
    type DContainer (EnumOption t) = PhantomEnumContainer
    compileRec :: EnumOption t
-> DContainer
     (EnumOption t) (DType (EnumOption t)) (DFields (EnumOption t))
compileRec EnumOption t
x = [EnumOption t] -> PhantomEnumContainer t '[()]
forall t (ts :: [*]). [EnumOption t] -> PhantomEnumContainer t ts
PhantomEnumContainer [EnumOption t
x]

instance (IsDataSpec x, IsDataSpec y, DType x ~ DType y, DContainer x ~ DContainer y, CombinableContainer (DContainer x)) => IsDataSpec (x :& y) where
    type DFields (x :& y) = HV.Append (DFields x) (DFields y)
    type DType (x :& y) = DType x
    type DContainer (x :& y) = DContainer x
    compileRec :: (x :& y) -> DContainer (x :& y) (DType (x :& y)) (DFields (x :& y))
compileRec (x
x :& y
y) = DContainer y (DType y) (DFields x)
-> DContainer y (DType y) (DFields y)
-> DContainer y (DType y) (Append (DFields x) (DFields y))
forall (t :: * -> [*] -> *) a (as :: [*]) (bs :: [*]).
CombinableContainer t =>
t a as -> t a bs -> t a (Append as bs)
combineContainer (x -> DContainer x (DType x) (DFields x)
forall t. IsDataSpec t => t -> DContainer t (DType t) (DFields t)
compileRec x
x) (y -> DContainer y (DType y) (DFields y)
forall t. IsDataSpec t => t -> DContainer t (DType t) (DFields t)
compileRec y
y)

recAppend :: RecordFields t as -> RecordFields t bs -> RecordFields t (HV.Append as bs)
recAppend :: RecordFields t as
-> RecordFields t bs -> RecordFields t (Append as bs)
recAppend RecordFields t as
RFEmpty RecordFields t bs
bs = RecordFields t bs
RecordFields t (Append as bs)
bs
recAppend (RecordField t f
a :+: RecordFields t fs
as) RecordFields t bs
bs = RecordField t f
a RecordField t f
-> RecordFields t (Append fs bs)
-> RecordFields t (f : Append fs bs)
forall t f (fs :: [*]).
RecordField t f -> RecordFields t fs -> RecordFields t (f : fs)
:+: (RecordFields t fs
as RecordFields t fs
-> RecordFields t bs -> RecordFields t (Append fs bs)
forall a (as :: [*]) (bs :: [*]).
RecordFields a as
-> RecordFields a bs -> RecordFields a (Append as bs)
`recAppend` RecordFields t bs
bs)

sumAppend :: SumOptions t as -> SumOptions t bs -> SumOptions t (HV.Append as bs)
sumAppend :: SumOptions t as -> SumOptions t bs -> SumOptions t (Append as bs)
sumAppend SumOptions t as
SOEmpty SumOptions t bs
bs = SumOptions t bs
SumOptions t (Append as bs)
bs
sumAppend (SumOption t o
a :|: SumOptions t os
as) SumOptions t bs
bs = SumOption t o
a SumOption t o
-> SumOptions t (Append os bs) -> SumOptions t (o : Append os bs)
forall t o (os :: [*]).
SumOption t o -> SumOptions t os -> SumOptions t (o : os)
:|: (SumOptions t os
as SumOptions t os -> SumOptions t bs -> SumOptions t (Append os bs)
forall a (as :: [*]) (bs :: [*]).
SumOptions a as -> SumOptions a bs -> SumOptions a (Append as bs)
`sumAppend` SumOptions t bs
bs)

-- | A required json field. The key must be present in the json.
reqField :: FromJSON f => T.Text -> (t -> f) -> RecordField t f
reqField :: Text -> (t -> f) -> RecordField t f
reqField Text
jsonKey t -> f
g =
    RecordField :: forall t f.
Text
-> Bool
-> (Object -> Text -> Parser f)
-> (t -> f)
-> RecordField t f
RecordField
    { rf_jsonKey :: Text
rf_jsonKey = Text
jsonKey
    , rf_optional :: Bool
rf_optional = Bool
False
    , rf_jsonLoader :: Object -> Text -> Parser f
rf_jsonLoader = Object -> Text -> Parser f
forall a. FromJSON a => Object -> Text -> Parser a
(.:)
    , rf_get :: t -> f
rf_get = t -> f
g
    }

-- | Alias for 'reqField'
(.=) :: FromJSON f =>  T.Text -> (t -> f) -> RecordField t f
Text
jsonKey .= :: Text -> (t -> f) -> RecordField t f
.= t -> f
reader = Text -> (t -> f) -> RecordField t f
forall f t. FromJSON f => Text -> (t -> f) -> RecordField t f
reqField Text
jsonKey t -> f
reader

-- | An optional json field.
optField :: FromJSON f => T.Text -> (t -> Maybe f) -> RecordField t (Maybe f)
optField :: Text -> (t -> Maybe f) -> RecordField t (Maybe f)
optField Text
jsonKey t -> Maybe f
g =
    RecordField :: forall t f.
Text
-> Bool
-> (Object -> Text -> Parser f)
-> (t -> f)
-> RecordField t f
RecordField
    { rf_jsonKey :: Text
rf_jsonKey = Text
jsonKey
    , rf_optional :: Bool
rf_optional = Bool
True
    , rf_jsonLoader :: Object -> Text -> Parser (Maybe f)
rf_jsonLoader = Object -> Text -> Parser (Maybe f)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
(.:?)
    , rf_get :: t -> Maybe f
rf_get = t -> Maybe f
g
    }

-- | Alias for 'optField'
(.=?) :: FromJSON f =>  T.Text -> (t -> Maybe f) -> RecordField t (Maybe f)
Text
name .=? :: Text -> (t -> Maybe f) -> RecordField t (Maybe f)
.=? t -> Maybe f
reader = Text -> (t -> Maybe f) -> RecordField t (Maybe f)
forall f t.
FromJSON f =>
Text -> (t -> Maybe f) -> RecordField t (Maybe f)
optField Text
name t -> Maybe f
reader

-- | An option of a sum type
sumOpt :: T.Text -> Prism' t o -> SumOption t o
sumOpt :: Text -> Prism' t o -> SumOption t o
sumOpt Text
jsonKey Prism' t o
p =
    SumOption :: forall t o. Text -> Prism' t o -> SumOption t o
SumOption
    { so_jsonKey :: Text
so_jsonKey = Text
jsonKey
    , so_prism :: Prism' t o
so_prism = Prism' t o
p
    }

-- | Alias for 'sumOpt'
(.->) :: T.Text -> Prism' t o -> SumOption t o
Text
jsonKey .-> :: Text -> Prism' t o -> SumOption t o
.-> Prism' t o
p = Text -> Prism' t o -> SumOption t o
forall t o. Text -> Prism' t o -> SumOption t o
sumOpt Text
jsonKey Prism' t o
p

-- | An option of a classic enum
enumOpt :: T.Text -> Prism' t () -> EnumOption t
enumOpt :: Text -> Prism' t () -> EnumOption t
enumOpt Text
jsonKey Prism' t ()
p =
    EnumOption :: forall t. Text -> Prism' t () -> EnumOption t
EnumOption
    { eo_jsonKey :: Text
eo_jsonKey = Text
jsonKey
    , eo_prism :: Prism' t ()
eo_prism = Prism' t ()
p
    }

-- | Alias for 'enumOpt'
(@->) :: T.Text -> Prism' t () -> EnumOption t
Text
jsonKey @-> :: Text -> Prism' t () -> EnumOption t
@-> Prism' t ()
p = Text -> Prism' t () -> EnumOption t
forall t. Text -> Prism' t () -> EnumOption t
enumOpt Text
jsonKey Prism' t ()
p

-- | A specification for a record
type RecordTypeSpec t flds = HighSpec t 'SpecRecord flds

-- | The specification for a record. Contains a name, an optional description,
-- the constructor and a description how to parse and serialize fields respecting
-- a given json key.
recSpec ::
    (IsDataSpec q, DContainer q ~ RecordFields)
    => T.Text -> Maybe T.Text -> HV.HVectElim (DFields q) (DType q)
    -> q
    -> RecordTypeSpec (DType q) (DFields q)
recSpec :: Text
-> Maybe Text
-> HVectElim (DFields q) (DType q)
-> q
-> RecordTypeSpec (DType q) (DFields q)
recSpec Text
name Maybe Text
mDesc HVectElim (DFields q) (DType q)
mk q
fields =
    HighSpec :: forall a (ty :: SpecType) (as :: [*]).
Text -> Maybe Text -> BodySpec ty a as -> HighSpec a ty as
HighSpec
    { hs_name :: Text
hs_name = Text
name
    , hs_description :: Maybe Text
hs_description = Maybe Text
mDesc
    , hs_bodySpec :: BodySpec 'SpecRecord (DType q) (DFields q)
hs_bodySpec = RecordSpec (DType q) (DFields q)
-> BodySpec 'SpecRecord (DType q) (DFields q)
forall a (as :: [*]). RecordSpec a as -> BodySpec 'SpecRecord a as
BodySpecRecord (RecordSpec (DType q) (DFields q)
 -> BodySpec 'SpecRecord (DType q) (DFields q))
-> RecordSpec (DType q) (DFields q)
-> BodySpec 'SpecRecord (DType q) (DFields q)
forall a b. (a -> b) -> a -> b
$ (HVect (DFields q) -> DType q)
-> RecordFields (DType q) (DFields q)
-> RecordSpec (DType q) (DFields q)
forall a (fs :: [*]).
(HVect fs -> a) -> RecordFields a fs -> RecordSpec a fs
RecordSpec (HVectElim (DFields q) (DType q) -> HVect (DFields q) -> DType q
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry HVectElim (DFields q) (DType q)
mk) (q -> DContainer q (DType q) (DFields q)
forall t. IsDataSpec t => t -> DContainer t (DType t) (DFields t)
compileRec q
fields)
    }

-- | A specification for an arbitrary sum type
type SumTypeSpec t flds = HighSpec t 'SpecSum flds

-- | The specification for a sum type. Contains a name, an optional description
-- and a mapping from all constructor (prims) to their respective json fields
sumSpec ::
    (IsDataSpec q, DContainer q ~ SumOptions)
    => T.Text -> Maybe T.Text -> q -> SumTypeSpec (DType q) (DFields q)
sumSpec :: Text -> Maybe Text -> q -> SumTypeSpec (DType q) (DFields q)
sumSpec Text
name Maybe Text
mDesc q
opts =
    HighSpec :: forall a (ty :: SpecType) (as :: [*]).
Text -> Maybe Text -> BodySpec ty a as -> HighSpec a ty as
HighSpec
    { hs_name :: Text
hs_name = Text
name
    , hs_description :: Maybe Text
hs_description = Maybe Text
mDesc
    , hs_bodySpec :: BodySpec 'SpecSum (DType q) (DFields q)
hs_bodySpec = SumSpec (DType q) (DFields q)
-> BodySpec 'SpecSum (DType q) (DFields q)
forall a (as :: [*]). SumSpec a as -> BodySpec 'SpecSum a as
BodySpecSum (SumSpec (DType q) (DFields q)
 -> BodySpec 'SpecSum (DType q) (DFields q))
-> SumSpec (DType q) (DFields q)
-> BodySpec 'SpecSum (DType q) (DFields q)
forall a b. (a -> b) -> a -> b
$ SumOptions (DType q) (DFields q) -> SumSpec (DType q) (DFields q)
forall a (os :: [*]). SumOptions a os -> SumSpec a os
SumSpec (q -> DContainer q (DType q) (DFields q)
forall t. IsDataSpec t => t -> DContainer t (DType t) (DFields t)
compileRec q
opts)
    }

-- | A specification for a classic enum
type EnumTypeSpec t flds = HighSpec t 'SpecEnum flds

-- | The specification for a classic enum type. Contains a name, an optional description
-- and a mapping from all constructors to ther counterpart json string names.
enumSpec ::
    (IsDataSpec q, DContainer q ~ PhantomEnumContainer)
    => T.Text -> Maybe T.Text -> q -> EnumTypeSpec (DType q) (DFields q)
enumSpec :: Text -> Maybe Text -> q -> EnumTypeSpec (DType q) (DFields q)
enumSpec Text
name Maybe Text
mDesc q
opts =
    HighSpec :: forall a (ty :: SpecType) (as :: [*]).
Text -> Maybe Text -> BodySpec ty a as -> HighSpec a ty as
HighSpec
    { hs_name :: Text
hs_name = Text
name
    , hs_description :: Maybe Text
hs_description = Maybe Text
mDesc
    , hs_bodySpec :: BodySpec 'SpecEnum (DType q) (DFields q)
hs_bodySpec = EnumSpec (DType q) -> BodySpec 'SpecEnum (DType q) (DFields q)
forall a (as :: [*]). EnumSpec a -> BodySpec 'SpecEnum a as
BodySpecEnum (EnumSpec (DType q) -> BodySpec 'SpecEnum (DType q) (DFields q))
-> EnumSpec (DType q) -> BodySpec 'SpecEnum (DType q) (DFields q)
forall a b. (a -> b) -> a -> b
$ [EnumOption (DType q)] -> EnumSpec (DType q)
forall a. [EnumOption a] -> EnumSpec a
EnumSpec (PhantomEnumContainer (DType q) (DFields q)
-> [EnumOption (DType q)]
forall t (ts :: [*]). PhantomEnumContainer t ts -> [EnumOption t]
unPhantomEnumContainer (PhantomEnumContainer (DType q) (DFields q)
 -> [EnumOption (DType q)])
-> PhantomEnumContainer (DType q) (DFields q)
-> [EnumOption (DType q)]
forall a b. (a -> b) -> a -> b
$ q -> DContainer q (DType q) (DFields q)
forall t. IsDataSpec t => t -> DContainer t (DType t) (DFields t)
compileRec q
opts)
    }