aeson-schemas-1.3.3: Easily consume JSON data on-demand with type-safety
MaintainerBrandon Chinn <brandon@leapyear.io>
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Data.Aeson.Schema.Utils.Sum

Description

The SumType data type that represents a sum type consisting of types specified in a type-level list.

Synopsis

Documentation

data SumType (types :: [Type]) where Source #

Represents a sum type.

Loads the first type that successfully parses the JSON value.

Example:

data Owl = Owl
data Cat = Cat
data Toad = Toad
type Animal = SumType '[Owl, Cat, Toad]

Here Owl                         :: Animal
There (Here Cat)                 :: Animal
There (There (Here Toad))        :: Animal

{- Fails at compile-time
Here True                        :: Animal
Here Cat                         :: Animal
There (Here Owl)                 :: Animal
There (There (There (Here Owl))) :: Animal
-}

Constructors

Here :: forall x xs. x -> SumType (x ': xs) 
There :: forall x xs. SumType xs -> SumType (x ': xs) 

Instances

Instances details
(Eq x, Eq (SumType xs)) => Eq (SumType (x ': xs)) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

(==) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

(/=) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

Eq (SumType ('[] :: [Type])) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

(==) :: SumType '[] -> SumType '[] -> Bool #

(/=) :: SumType '[] -> SumType '[] -> Bool #

(Ord x, Ord (SumType xs)) => Ord (SumType (x ': xs)) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

compare :: SumType (x ': xs) -> SumType (x ': xs) -> Ordering #

(<) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

(<=) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

(>) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

(>=) :: SumType (x ': xs) -> SumType (x ': xs) -> Bool #

max :: SumType (x ': xs) -> SumType (x ': xs) -> SumType (x ': xs) #

min :: SumType (x ': xs) -> SumType (x ': xs) -> SumType (x ': xs) #

Ord (SumType ('[] :: [Type])) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

compare :: SumType '[] -> SumType '[] -> Ordering #

(<) :: SumType '[] -> SumType '[] -> Bool #

(<=) :: SumType '[] -> SumType '[] -> Bool #

(>) :: SumType '[] -> SumType '[] -> Bool #

(>=) :: SumType '[] -> SumType '[] -> Bool #

max :: SumType '[] -> SumType '[] -> SumType '[] #

min :: SumType '[] -> SumType '[] -> SumType '[] #

(Show x, Show (SumType xs)) => Show (SumType (x ': xs)) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

showsPrec :: Int -> SumType (x ': xs) -> ShowS #

show :: SumType (x ': xs) -> String #

showList :: [SumType (x ': xs)] -> ShowS #

Show (SumType ('[] :: [Type])) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

showsPrec :: Int -> SumType '[] -> ShowS #

show :: SumType '[] -> String #

showList :: [SumType '[]] -> ShowS #

(ToJSON x, ToJSON (SumType xs)) => ToJSON (SumType (x ': xs)) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

toJSON :: SumType (x ': xs) -> Value #

toEncoding :: SumType (x ': xs) -> Encoding #

toJSONList :: [SumType (x ': xs)] -> Value #

toEncodingList :: [SumType (x ': xs)] -> Encoding #

ToJSON (SumType ('[] :: [Type])) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

(FromJSON x, FromJSON (SumType xs)) => FromJSON (SumType (x ': xs)) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

Methods

parseJSON :: Value -> Parser (SumType (x ': xs)) #

parseJSONList :: Value -> Parser [SumType (x ': xs)] #

FromJSON (SumType ('[] :: [Type])) Source # 
Instance details

Defined in Data.Aeson.Schema.Utils.Sum

fromSumType :: (IsInRange n types, 'Just result ~ GetIndex n types, FromSumType n types result) => proxy n -> SumType types -> Maybe result Source #

Extract a value from a SumType

Example:

type Animal = SumType '[Owl, Cat, Toad]
let someAnimal = ... :: Animal

fromSumType (Proxy :: Proxy 0) someAnimal :: Maybe Owl
fromSumType (Proxy :: Proxy 1) someAnimal :: Maybe Cat
fromSumType (Proxy :: Proxy 2) someAnimal :: Maybe Toad

-- Compile-time error
-- fromSumType (Proxy :: Proxy 3) someAnimal