{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Haskell types used for testing `elm-street` generated Elm types.
-}

module Types
       ( Types
       , OneType (..)
       , defaultOneType
       , defaultCustomCodeGen

         -- * All test types
       , Prims (..)
       , Id (..)
       , Age (..)
       , Newtype (..)
       , NewtypeList (..)
       , OneConstructor (..)
       , RequestStatus (..)
       , User (..)
       , Guest (..)
       , UserRequest (..)
       , CustomCodeGen (..)
       ) where

import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), object, (.=), GFromJSON, GToJSON, Zero)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..))
import Data.Word (Word32)
import Elm (Elm (..), ElmStreet (..), elmNewtype)
import Elm.Generic (CodeGenOptions (..), ElmStreetGenericConstraints, GenericElmDefinition(..))
import Elm.Aeson (elmStreetParseJsonWith, elmStreetToJsonWith)
import GHC.Generics (Generic, Rep)

import qualified GHC.Generics as Generic (from)
import qualified Data.Text as Text

data Prims = Prims
    { Prims -> ()
primsUnit     :: !()
    , Prims -> Bool
primsBool     :: !Bool
    , Prims -> Char
primsChar     :: !Char
    , Prims -> Int
primsInt      :: !Int
    , Prims -> Double
primsFloat    :: !Double
    , Prims -> Text
primsText     :: !Text
    , Prims -> String
primsString   :: !String
    , Prims -> UTCTime
primsTime     :: !UTCTime
    , Prims -> Value
primsValue    :: !Value
    , Prims -> Maybe Word
primsMaybe    :: !(Maybe Word)
    , Prims -> Either Int Text
primsResult   :: !(Either Int Text)
    , Prims -> (Char, Bool)
primsPair     :: !(Char, Bool)
    , Prims -> (Char, Bool, [Int])
primsTriple   :: !(Char, Bool, [Int])
    , Prims -> [Int]
primsList     :: ![Int]
    , Prims -> NonEmpty Int
primsNonEmpty :: !(NonEmpty Int)
    } deriving ((forall x. Prims -> Rep Prims x)
-> (forall x. Rep Prims x -> Prims) -> Generic Prims
forall x. Rep Prims x -> Prims
forall x. Prims -> Rep Prims x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Prims -> Rep Prims x
from :: forall x. Prims -> Rep Prims x
$cto :: forall x. Rep Prims x -> Prims
to :: forall x. Rep Prims x -> Prims
Generic, Prims -> Prims -> Bool
(Prims -> Prims -> Bool) -> (Prims -> Prims -> Bool) -> Eq Prims
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Prims -> Prims -> Bool
== :: Prims -> Prims -> Bool
$c/= :: Prims -> Prims -> Bool
/= :: Prims -> Prims -> Bool
Eq, Int -> Prims -> ShowS
[Prims] -> ShowS
Prims -> String
(Int -> Prims -> ShowS)
-> (Prims -> String) -> ([Prims] -> ShowS) -> Show Prims
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prims -> ShowS
showsPrec :: Int -> Prims -> ShowS
$cshow :: Prims -> String
show :: Prims -> String
$cshowList :: [Prims] -> ShowS
showList :: [Prims] -> ShowS
Show)
      deriving (Proxy Prims -> ElmDefinition
(Proxy Prims -> ElmDefinition) -> Elm Prims
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy Prims -> ElmDefinition
toElmDefinition :: Proxy Prims -> ElmDefinition
Elm, [Prims] -> Value
[Prims] -> Encoding
Prims -> Bool
Prims -> Value
Prims -> Encoding
(Prims -> Value)
-> (Prims -> Encoding)
-> ([Prims] -> Value)
-> ([Prims] -> Encoding)
-> (Prims -> Bool)
-> ToJSON Prims
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Prims -> Value
toJSON :: Prims -> Value
$ctoEncoding :: Prims -> Encoding
toEncoding :: Prims -> Encoding
$ctoJSONList :: [Prims] -> Value
toJSONList :: [Prims] -> Value
$ctoEncodingList :: [Prims] -> Encoding
toEncodingList :: [Prims] -> Encoding
$comitField :: Prims -> Bool
omitField :: Prims -> Bool
ToJSON, Maybe Prims
Value -> Parser [Prims]
Value -> Parser Prims
(Value -> Parser Prims)
-> (Value -> Parser [Prims]) -> Maybe Prims -> FromJSON Prims
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Prims
parseJSON :: Value -> Parser Prims
$cparseJSONList :: Value -> Parser [Prims]
parseJSONList :: Value -> Parser [Prims]
$comittedField :: Maybe Prims
omittedField :: Maybe Prims
FromJSON) via ElmStreet Prims

newtype Id a = Id
    { forall a. Id a -> Text
unId :: Text
    } deriving (Int -> Id a -> ShowS
[Id a] -> ShowS
Id a -> String
(Int -> Id a -> ShowS)
-> (Id a -> String) -> ([Id a] -> ShowS) -> Show (Id a)
forall a. Int -> Id a -> ShowS
forall a. [Id a] -> ShowS
forall a. Id a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Id a -> ShowS
showsPrec :: Int -> Id a -> ShowS
$cshow :: forall a. Id a -> String
show :: Id a -> String
$cshowList :: forall a. [Id a] -> ShowS
showList :: [Id a] -> ShowS
Show, Id a -> Id a -> Bool
(Id a -> Id a -> Bool) -> (Id a -> Id a -> Bool) -> Eq (Id a)
forall a. Id a -> Id a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Id a -> Id a -> Bool
== :: Id a -> Id a -> Bool
$c/= :: forall a. Id a -> Id a -> Bool
/= :: Id a -> Id a -> Bool
Eq)
      deriving newtype (Maybe (Id a)
Value -> Parser [Id a]
Value -> Parser (Id a)
(Value -> Parser (Id a))
-> (Value -> Parser [Id a]) -> Maybe (Id a) -> FromJSON (Id a)
forall a. Maybe (Id a)
forall a. Value -> Parser [Id a]
forall a. Value -> Parser (Id a)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall a. Value -> Parser (Id a)
parseJSON :: Value -> Parser (Id a)
$cparseJSONList :: forall a. Value -> Parser [Id a]
parseJSONList :: Value -> Parser [Id a]
$comittedField :: forall a. Maybe (Id a)
omittedField :: Maybe (Id a)
FromJSON, [Id a] -> Value
[Id a] -> Encoding
Id a -> Bool
Id a -> Value
Id a -> Encoding
(Id a -> Value)
-> (Id a -> Encoding)
-> ([Id a] -> Value)
-> ([Id a] -> Encoding)
-> (Id a -> Bool)
-> ToJSON (Id a)
forall a. [Id a] -> Value
forall a. [Id a] -> Encoding
forall a. Id a -> Bool
forall a. Id a -> Value
forall a. Id a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. Id a -> Value
toJSON :: Id a -> Value
$ctoEncoding :: forall a. Id a -> Encoding
toEncoding :: Id a -> Encoding
$ctoJSONList :: forall a. [Id a] -> Value
toJSONList :: [Id a] -> Value
$ctoEncodingList :: forall a. [Id a] -> Encoding
toEncodingList :: [Id a] -> Encoding
$comitField :: forall a. Id a -> Bool
omitField :: Id a -> Bool
ToJSON)

instance Elm (Id a) where
    toElmDefinition :: Proxy (Id a) -> ElmDefinition
toElmDefinition Proxy (Id a)
_ = forall a. Elm a => Text -> Text -> ElmDefinition
elmNewtype @Text Text
"Id" Text
"unId"

newtype Age = Age
    { Age -> Int
unAge :: Int
    } deriving ((forall x. Age -> Rep Age x)
-> (forall x. Rep Age x -> Age) -> Generic Age
forall x. Rep Age x -> Age
forall x. Age -> Rep Age x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Age -> Rep Age x
from :: forall x. Age -> Rep Age x
$cto :: forall x. Rep Age x -> Age
to :: forall x. Rep Age x -> Age
Generic, Age -> Age -> Bool
(Age -> Age -> Bool) -> (Age -> Age -> Bool) -> Eq Age
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Age -> Age -> Bool
== :: Age -> Age -> Bool
$c/= :: Age -> Age -> Bool
/= :: Age -> Age -> Bool
Eq, Int -> Age -> ShowS
[Age] -> ShowS
Age -> String
(Int -> Age -> ShowS)
-> (Age -> String) -> ([Age] -> ShowS) -> Show Age
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Age -> ShowS
showsPrec :: Int -> Age -> ShowS
$cshow :: Age -> String
show :: Age -> String
$cshowList :: [Age] -> ShowS
showList :: [Age] -> ShowS
Show)
      deriving anyclass (Proxy Age -> ElmDefinition
(Proxy Age -> ElmDefinition) -> Elm Age
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy Age -> ElmDefinition
toElmDefinition :: Proxy Age -> ElmDefinition
Elm)
      deriving newtype (Maybe Age
Value -> Parser [Age]
Value -> Parser Age
(Value -> Parser Age)
-> (Value -> Parser [Age]) -> Maybe Age -> FromJSON Age
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Age
parseJSON :: Value -> Parser Age
$cparseJSONList :: Value -> Parser [Age]
parseJSONList :: Value -> Parser [Age]
$comittedField :: Maybe Age
omittedField :: Maybe Age
FromJSON, [Age] -> Value
[Age] -> Encoding
Age -> Bool
Age -> Value
Age -> Encoding
(Age -> Value)
-> (Age -> Encoding)
-> ([Age] -> Value)
-> ([Age] -> Encoding)
-> (Age -> Bool)
-> ToJSON Age
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Age -> Value
toJSON :: Age -> Value
$ctoEncoding :: Age -> Encoding
toEncoding :: Age -> Encoding
$ctoJSONList :: [Age] -> Value
toJSONList :: [Age] -> Value
$ctoEncodingList :: [Age] -> Encoding
toEncodingList :: [Age] -> Encoding
$comitField :: Age -> Bool
omitField :: Age -> Bool
ToJSON)

newtype Newtype = Newtype Int
    deriving stock ((forall x. Newtype -> Rep Newtype x)
-> (forall x. Rep Newtype x -> Newtype) -> Generic Newtype
forall x. Rep Newtype x -> Newtype
forall x. Newtype -> Rep Newtype x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Newtype -> Rep Newtype x
from :: forall x. Newtype -> Rep Newtype x
$cto :: forall x. Rep Newtype x -> Newtype
to :: forall x. Rep Newtype x -> Newtype
Generic, Newtype -> Newtype -> Bool
(Newtype -> Newtype -> Bool)
-> (Newtype -> Newtype -> Bool) -> Eq Newtype
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Newtype -> Newtype -> Bool
== :: Newtype -> Newtype -> Bool
$c/= :: Newtype -> Newtype -> Bool
/= :: Newtype -> Newtype -> Bool
Eq, Int -> Newtype -> ShowS
[Newtype] -> ShowS
Newtype -> String
(Int -> Newtype -> ShowS)
-> (Newtype -> String) -> ([Newtype] -> ShowS) -> Show Newtype
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Newtype -> ShowS
showsPrec :: Int -> Newtype -> ShowS
$cshow :: Newtype -> String
show :: Newtype -> String
$cshowList :: [Newtype] -> ShowS
showList :: [Newtype] -> ShowS
Show)
    deriving newtype (Maybe Newtype
Value -> Parser [Newtype]
Value -> Parser Newtype
(Value -> Parser Newtype)
-> (Value -> Parser [Newtype]) -> Maybe Newtype -> FromJSON Newtype
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Newtype
parseJSON :: Value -> Parser Newtype
$cparseJSONList :: Value -> Parser [Newtype]
parseJSONList :: Value -> Parser [Newtype]
$comittedField :: Maybe Newtype
omittedField :: Maybe Newtype
FromJSON, [Newtype] -> Value
[Newtype] -> Encoding
Newtype -> Bool
Newtype -> Value
Newtype -> Encoding
(Newtype -> Value)
-> (Newtype -> Encoding)
-> ([Newtype] -> Value)
-> ([Newtype] -> Encoding)
-> (Newtype -> Bool)
-> ToJSON Newtype
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Newtype -> Value
toJSON :: Newtype -> Value
$ctoEncoding :: Newtype -> Encoding
toEncoding :: Newtype -> Encoding
$ctoJSONList :: [Newtype] -> Value
toJSONList :: [Newtype] -> Value
$ctoEncodingList :: [Newtype] -> Encoding
toEncodingList :: [Newtype] -> Encoding
$comitField :: Newtype -> Bool
omitField :: Newtype -> Bool
ToJSON)
    deriving anyclass (Proxy Newtype -> ElmDefinition
(Proxy Newtype -> ElmDefinition) -> Elm Newtype
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy Newtype -> ElmDefinition
toElmDefinition :: Proxy Newtype -> ElmDefinition
Elm)

newtype NewtypeList = NewtypeList [Int]
    deriving stock ((forall x. NewtypeList -> Rep NewtypeList x)
-> (forall x. Rep NewtypeList x -> NewtypeList)
-> Generic NewtypeList
forall x. Rep NewtypeList x -> NewtypeList
forall x. NewtypeList -> Rep NewtypeList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewtypeList -> Rep NewtypeList x
from :: forall x. NewtypeList -> Rep NewtypeList x
$cto :: forall x. Rep NewtypeList x -> NewtypeList
to :: forall x. Rep NewtypeList x -> NewtypeList
Generic, NewtypeList -> NewtypeList -> Bool
(NewtypeList -> NewtypeList -> Bool)
-> (NewtypeList -> NewtypeList -> Bool) -> Eq NewtypeList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewtypeList -> NewtypeList -> Bool
== :: NewtypeList -> NewtypeList -> Bool
$c/= :: NewtypeList -> NewtypeList -> Bool
/= :: NewtypeList -> NewtypeList -> Bool
Eq, Int -> NewtypeList -> ShowS
[NewtypeList] -> ShowS
NewtypeList -> String
(Int -> NewtypeList -> ShowS)
-> (NewtypeList -> String)
-> ([NewtypeList] -> ShowS)
-> Show NewtypeList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewtypeList -> ShowS
showsPrec :: Int -> NewtypeList -> ShowS
$cshow :: NewtypeList -> String
show :: NewtypeList -> String
$cshowList :: [NewtypeList] -> ShowS
showList :: [NewtypeList] -> ShowS
Show)
    deriving newtype (Maybe NewtypeList
Value -> Parser [NewtypeList]
Value -> Parser NewtypeList
(Value -> Parser NewtypeList)
-> (Value -> Parser [NewtypeList])
-> Maybe NewtypeList
-> FromJSON NewtypeList
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NewtypeList
parseJSON :: Value -> Parser NewtypeList
$cparseJSONList :: Value -> Parser [NewtypeList]
parseJSONList :: Value -> Parser [NewtypeList]
$comittedField :: Maybe NewtypeList
omittedField :: Maybe NewtypeList
FromJSON, [NewtypeList] -> Value
[NewtypeList] -> Encoding
NewtypeList -> Bool
NewtypeList -> Value
NewtypeList -> Encoding
(NewtypeList -> Value)
-> (NewtypeList -> Encoding)
-> ([NewtypeList] -> Value)
-> ([NewtypeList] -> Encoding)
-> (NewtypeList -> Bool)
-> ToJSON NewtypeList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NewtypeList -> Value
toJSON :: NewtypeList -> Value
$ctoEncoding :: NewtypeList -> Encoding
toEncoding :: NewtypeList -> Encoding
$ctoJSONList :: [NewtypeList] -> Value
toJSONList :: [NewtypeList] -> Value
$ctoEncodingList :: [NewtypeList] -> Encoding
toEncodingList :: [NewtypeList] -> Encoding
$comitField :: NewtypeList -> Bool
omitField :: NewtypeList -> Bool
ToJSON)
    deriving anyclass (Proxy NewtypeList -> ElmDefinition
(Proxy NewtypeList -> ElmDefinition) -> Elm NewtypeList
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy NewtypeList -> ElmDefinition
toElmDefinition :: Proxy NewtypeList -> ElmDefinition
Elm)

data OneConstructor = OneConstructor
    deriving stock ((forall x. OneConstructor -> Rep OneConstructor x)
-> (forall x. Rep OneConstructor x -> OneConstructor)
-> Generic OneConstructor
forall x. Rep OneConstructor x -> OneConstructor
forall x. OneConstructor -> Rep OneConstructor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OneConstructor -> Rep OneConstructor x
from :: forall x. OneConstructor -> Rep OneConstructor x
$cto :: forall x. Rep OneConstructor x -> OneConstructor
to :: forall x. Rep OneConstructor x -> OneConstructor
Generic, OneConstructor -> OneConstructor -> Bool
(OneConstructor -> OneConstructor -> Bool)
-> (OneConstructor -> OneConstructor -> Bool) -> Eq OneConstructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OneConstructor -> OneConstructor -> Bool
== :: OneConstructor -> OneConstructor -> Bool
$c/= :: OneConstructor -> OneConstructor -> Bool
/= :: OneConstructor -> OneConstructor -> Bool
Eq, Int -> OneConstructor -> ShowS
[OneConstructor] -> ShowS
OneConstructor -> String
(Int -> OneConstructor -> ShowS)
-> (OneConstructor -> String)
-> ([OneConstructor] -> ShowS)
-> Show OneConstructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneConstructor -> ShowS
showsPrec :: Int -> OneConstructor -> ShowS
$cshow :: OneConstructor -> String
show :: OneConstructor -> String
$cshowList :: [OneConstructor] -> ShowS
showList :: [OneConstructor] -> ShowS
Show)
    deriving (Proxy OneConstructor -> ElmDefinition
(Proxy OneConstructor -> ElmDefinition) -> Elm OneConstructor
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy OneConstructor -> ElmDefinition
toElmDefinition :: Proxy OneConstructor -> ElmDefinition
Elm, Maybe OneConstructor
Value -> Parser [OneConstructor]
Value -> Parser OneConstructor
(Value -> Parser OneConstructor)
-> (Value -> Parser [OneConstructor])
-> Maybe OneConstructor
-> FromJSON OneConstructor
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser OneConstructor
parseJSON :: Value -> Parser OneConstructor
$cparseJSONList :: Value -> Parser [OneConstructor]
parseJSONList :: Value -> Parser [OneConstructor]
$comittedField :: Maybe OneConstructor
omittedField :: Maybe OneConstructor
FromJSON, [OneConstructor] -> Value
[OneConstructor] -> Encoding
OneConstructor -> Bool
OneConstructor -> Value
OneConstructor -> Encoding
(OneConstructor -> Value)
-> (OneConstructor -> Encoding)
-> ([OneConstructor] -> Value)
-> ([OneConstructor] -> Encoding)
-> (OneConstructor -> Bool)
-> ToJSON OneConstructor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OneConstructor -> Value
toJSON :: OneConstructor -> Value
$ctoEncoding :: OneConstructor -> Encoding
toEncoding :: OneConstructor -> Encoding
$ctoJSONList :: [OneConstructor] -> Value
toJSONList :: [OneConstructor] -> Value
$ctoEncodingList :: [OneConstructor] -> Encoding
toEncodingList :: [OneConstructor] -> Encoding
$comitField :: OneConstructor -> Bool
omitField :: OneConstructor -> Bool
ToJSON) via ElmStreet OneConstructor

data RequestStatus
    = Approved
    | Rejected
    | Reviewing
    deriving ((forall x. RequestStatus -> Rep RequestStatus x)
-> (forall x. Rep RequestStatus x -> RequestStatus)
-> Generic RequestStatus
forall x. Rep RequestStatus x -> RequestStatus
forall x. RequestStatus -> Rep RequestStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestStatus -> Rep RequestStatus x
from :: forall x. RequestStatus -> Rep RequestStatus x
$cto :: forall x. Rep RequestStatus x -> RequestStatus
to :: forall x. Rep RequestStatus x -> RequestStatus
Generic, RequestStatus -> RequestStatus -> Bool
(RequestStatus -> RequestStatus -> Bool)
-> (RequestStatus -> RequestStatus -> Bool) -> Eq RequestStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestStatus -> RequestStatus -> Bool
== :: RequestStatus -> RequestStatus -> Bool
$c/= :: RequestStatus -> RequestStatus -> Bool
/= :: RequestStatus -> RequestStatus -> Bool
Eq, Int -> RequestStatus -> ShowS
[RequestStatus] -> ShowS
RequestStatus -> String
(Int -> RequestStatus -> ShowS)
-> (RequestStatus -> String)
-> ([RequestStatus] -> ShowS)
-> Show RequestStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestStatus -> ShowS
showsPrec :: Int -> RequestStatus -> ShowS
$cshow :: RequestStatus -> String
show :: RequestStatus -> String
$cshowList :: [RequestStatus] -> ShowS
showList :: [RequestStatus] -> ShowS
Show)
    deriving (Proxy RequestStatus -> ElmDefinition
(Proxy RequestStatus -> ElmDefinition) -> Elm RequestStatus
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy RequestStatus -> ElmDefinition
toElmDefinition :: Proxy RequestStatus -> ElmDefinition
Elm, Maybe RequestStatus
Value -> Parser [RequestStatus]
Value -> Parser RequestStatus
(Value -> Parser RequestStatus)
-> (Value -> Parser [RequestStatus])
-> Maybe RequestStatus
-> FromJSON RequestStatus
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RequestStatus
parseJSON :: Value -> Parser RequestStatus
$cparseJSONList :: Value -> Parser [RequestStatus]
parseJSONList :: Value -> Parser [RequestStatus]
$comittedField :: Maybe RequestStatus
omittedField :: Maybe RequestStatus
FromJSON, [RequestStatus] -> Value
[RequestStatus] -> Encoding
RequestStatus -> Bool
RequestStatus -> Value
RequestStatus -> Encoding
(RequestStatus -> Value)
-> (RequestStatus -> Encoding)
-> ([RequestStatus] -> Value)
-> ([RequestStatus] -> Encoding)
-> (RequestStatus -> Bool)
-> ToJSON RequestStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RequestStatus -> Value
toJSON :: RequestStatus -> Value
$ctoEncoding :: RequestStatus -> Encoding
toEncoding :: RequestStatus -> Encoding
$ctoJSONList :: [RequestStatus] -> Value
toJSONList :: [RequestStatus] -> Value
$ctoEncodingList :: [RequestStatus] -> Encoding
toEncodingList :: [RequestStatus] -> Encoding
$comitField :: RequestStatus -> Bool
omitField :: RequestStatus -> Bool
ToJSON) via ElmStreet RequestStatus

data User = User
    { User -> Id User
userId     :: !(Id User)
    , User -> Text
userName   :: !Text
    , User -> Age
userAge    :: !Age
    , User -> RequestStatus
userStatus :: !RequestStatus
    } deriving ((forall x. User -> Rep User x)
-> (forall x. Rep User x -> User) -> Generic User
forall x. Rep User x -> User
forall x. User -> Rep User x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. User -> Rep User x
from :: forall x. User -> Rep User x
$cto :: forall x. Rep User x -> User
to :: forall x. Rep User x -> User
Generic, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
Eq, Int -> User -> ShowS
[User] -> ShowS
User -> String
(Int -> User -> ShowS)
-> (User -> String) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> String
show :: User -> String
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
Show)
      deriving (Proxy User -> ElmDefinition
(Proxy User -> ElmDefinition) -> Elm User
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy User -> ElmDefinition
toElmDefinition :: Proxy User -> ElmDefinition
Elm, Maybe User
Value -> Parser [User]
Value -> Parser User
(Value -> Parser User)
-> (Value -> Parser [User]) -> Maybe User -> FromJSON User
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser User
parseJSON :: Value -> Parser User
$cparseJSONList :: Value -> Parser [User]
parseJSONList :: Value -> Parser [User]
$comittedField :: Maybe User
omittedField :: Maybe User
FromJSON, [User] -> Value
[User] -> Encoding
User -> Bool
User -> Value
User -> Encoding
(User -> Value)
-> (User -> Encoding)
-> ([User] -> Value)
-> ([User] -> Encoding)
-> (User -> Bool)
-> ToJSON User
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: User -> Value
toJSON :: User -> Value
$ctoEncoding :: User -> Encoding
toEncoding :: User -> Encoding
$ctoJSONList :: [User] -> Value
toJSONList :: [User] -> Value
$ctoEncodingList :: [User] -> Encoding
toEncodingList :: [User] -> Encoding
$comitField :: User -> Bool
omitField :: User -> Bool
ToJSON) via ElmStreet User

data Guest
    = Regular Text Int
    | Visitor Text
    | Special (Maybe [Int])
    | Blocked
    deriving ((forall x. Guest -> Rep Guest x)
-> (forall x. Rep Guest x -> Guest) -> Generic Guest
forall x. Rep Guest x -> Guest
forall x. Guest -> Rep Guest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Guest -> Rep Guest x
from :: forall x. Guest -> Rep Guest x
$cto :: forall x. Rep Guest x -> Guest
to :: forall x. Rep Guest x -> Guest
Generic, Guest -> Guest -> Bool
(Guest -> Guest -> Bool) -> (Guest -> Guest -> Bool) -> Eq Guest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Guest -> Guest -> Bool
== :: Guest -> Guest -> Bool
$c/= :: Guest -> Guest -> Bool
/= :: Guest -> Guest -> Bool
Eq, Int -> Guest -> ShowS
[Guest] -> ShowS
Guest -> String
(Int -> Guest -> ShowS)
-> (Guest -> String) -> ([Guest] -> ShowS) -> Show Guest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Guest -> ShowS
showsPrec :: Int -> Guest -> ShowS
$cshow :: Guest -> String
show :: Guest -> String
$cshowList :: [Guest] -> ShowS
showList :: [Guest] -> ShowS
Show)
    deriving (Proxy Guest -> ElmDefinition
(Proxy Guest -> ElmDefinition) -> Elm Guest
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy Guest -> ElmDefinition
toElmDefinition :: Proxy Guest -> ElmDefinition
Elm, Maybe Guest
Value -> Parser [Guest]
Value -> Parser Guest
(Value -> Parser Guest)
-> (Value -> Parser [Guest]) -> Maybe Guest -> FromJSON Guest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Guest
parseJSON :: Value -> Parser Guest
$cparseJSONList :: Value -> Parser [Guest]
parseJSONList :: Value -> Parser [Guest]
$comittedField :: Maybe Guest
omittedField :: Maybe Guest
FromJSON, [Guest] -> Value
[Guest] -> Encoding
Guest -> Bool
Guest -> Value
Guest -> Encoding
(Guest -> Value)
-> (Guest -> Encoding)
-> ([Guest] -> Value)
-> ([Guest] -> Encoding)
-> (Guest -> Bool)
-> ToJSON Guest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Guest -> Value
toJSON :: Guest -> Value
$ctoEncoding :: Guest -> Encoding
toEncoding :: Guest -> Encoding
$ctoJSONList :: [Guest] -> Value
toJSONList :: [Guest] -> Value
$ctoEncodingList :: [Guest] -> Encoding
toEncodingList :: [Guest] -> Encoding
$comitField :: Guest -> Bool
omitField :: Guest -> Bool
ToJSON) via ElmStreet Guest

data UserRequest = UserRequest
    { UserRequest -> [Id User]
userRequestIds     :: ![Id User]
    , UserRequest -> Word32
userRequestLimit   :: !Word32
    , UserRequest -> Maybe (Either User Guest)
userRequestExample :: !(Maybe (Either User Guest))
    } deriving ((forall x. UserRequest -> Rep UserRequest x)
-> (forall x. Rep UserRequest x -> UserRequest)
-> Generic UserRequest
forall x. Rep UserRequest x -> UserRequest
forall x. UserRequest -> Rep UserRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserRequest -> Rep UserRequest x
from :: forall x. UserRequest -> Rep UserRequest x
$cto :: forall x. Rep UserRequest x -> UserRequest
to :: forall x. Rep UserRequest x -> UserRequest
Generic, UserRequest -> UserRequest -> Bool
(UserRequest -> UserRequest -> Bool)
-> (UserRequest -> UserRequest -> Bool) -> Eq UserRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserRequest -> UserRequest -> Bool
== :: UserRequest -> UserRequest -> Bool
$c/= :: UserRequest -> UserRequest -> Bool
/= :: UserRequest -> UserRequest -> Bool
Eq, Int -> UserRequest -> ShowS
[UserRequest] -> ShowS
UserRequest -> String
(Int -> UserRequest -> ShowS)
-> (UserRequest -> String)
-> ([UserRequest] -> ShowS)
-> Show UserRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserRequest -> ShowS
showsPrec :: Int -> UserRequest -> ShowS
$cshow :: UserRequest -> String
show :: UserRequest -> String
$cshowList :: [UserRequest] -> ShowS
showList :: [UserRequest] -> ShowS
Show)
      deriving (Proxy UserRequest -> ElmDefinition
(Proxy UserRequest -> ElmDefinition) -> Elm UserRequest
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy UserRequest -> ElmDefinition
toElmDefinition :: Proxy UserRequest -> ElmDefinition
Elm, Maybe UserRequest
Value -> Parser [UserRequest]
Value -> Parser UserRequest
(Value -> Parser UserRequest)
-> (Value -> Parser [UserRequest])
-> Maybe UserRequest
-> FromJSON UserRequest
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser UserRequest
parseJSON :: Value -> Parser UserRequest
$cparseJSONList :: Value -> Parser [UserRequest]
parseJSONList :: Value -> Parser [UserRequest]
$comittedField :: Maybe UserRequest
omittedField :: Maybe UserRequest
FromJSON, [UserRequest] -> Value
[UserRequest] -> Encoding
UserRequest -> Bool
UserRequest -> Value
UserRequest -> Encoding
(UserRequest -> Value)
-> (UserRequest -> Encoding)
-> ([UserRequest] -> Value)
-> ([UserRequest] -> Encoding)
-> (UserRequest -> Bool)
-> ToJSON UserRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: UserRequest -> Value
toJSON :: UserRequest -> Value
$ctoEncoding :: UserRequest -> Encoding
toEncoding :: UserRequest -> Encoding
$ctoJSONList :: [UserRequest] -> Value
toJSONList :: [UserRequest] -> Value
$ctoEncodingList :: [UserRequest] -> Encoding
toEncodingList :: [UserRequest] -> Encoding
$comitField :: UserRequest -> Bool
omitField :: UserRequest -> Bool
ToJSON) via ElmStreet UserRequest

data MyUnit = MyUnit ()
    deriving stock (Int -> MyUnit -> ShowS
[MyUnit] -> ShowS
MyUnit -> String
(Int -> MyUnit -> ShowS)
-> (MyUnit -> String) -> ([MyUnit] -> ShowS) -> Show MyUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyUnit -> ShowS
showsPrec :: Int -> MyUnit -> ShowS
$cshow :: MyUnit -> String
show :: MyUnit -> String
$cshowList :: [MyUnit] -> ShowS
showList :: [MyUnit] -> ShowS
Show, MyUnit -> MyUnit -> Bool
(MyUnit -> MyUnit -> Bool)
-> (MyUnit -> MyUnit -> Bool) -> Eq MyUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyUnit -> MyUnit -> Bool
== :: MyUnit -> MyUnit -> Bool
$c/= :: MyUnit -> MyUnit -> Bool
/= :: MyUnit -> MyUnit -> Bool
Eq, Eq MyUnit
Eq MyUnit =>
(MyUnit -> MyUnit -> Ordering)
-> (MyUnit -> MyUnit -> Bool)
-> (MyUnit -> MyUnit -> Bool)
-> (MyUnit -> MyUnit -> Bool)
-> (MyUnit -> MyUnit -> Bool)
-> (MyUnit -> MyUnit -> MyUnit)
-> (MyUnit -> MyUnit -> MyUnit)
-> Ord MyUnit
MyUnit -> MyUnit -> Bool
MyUnit -> MyUnit -> Ordering
MyUnit -> MyUnit -> MyUnit
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
$ccompare :: MyUnit -> MyUnit -> Ordering
compare :: MyUnit -> MyUnit -> Ordering
$c< :: MyUnit -> MyUnit -> Bool
< :: MyUnit -> MyUnit -> Bool
$c<= :: MyUnit -> MyUnit -> Bool
<= :: MyUnit -> MyUnit -> Bool
$c> :: MyUnit -> MyUnit -> Bool
> :: MyUnit -> MyUnit -> Bool
$c>= :: MyUnit -> MyUnit -> Bool
>= :: MyUnit -> MyUnit -> Bool
$cmax :: MyUnit -> MyUnit -> MyUnit
max :: MyUnit -> MyUnit -> MyUnit
$cmin :: MyUnit -> MyUnit -> MyUnit
min :: MyUnit -> MyUnit -> MyUnit
Ord, (forall x. MyUnit -> Rep MyUnit x)
-> (forall x. Rep MyUnit x -> MyUnit) -> Generic MyUnit
forall x. Rep MyUnit x -> MyUnit
forall x. MyUnit -> Rep MyUnit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MyUnit -> Rep MyUnit x
from :: forall x. MyUnit -> Rep MyUnit x
$cto :: forall x. Rep MyUnit x -> MyUnit
to :: forall x. Rep MyUnit x -> MyUnit
Generic)
    deriving (Proxy MyUnit -> ElmDefinition
(Proxy MyUnit -> ElmDefinition) -> Elm MyUnit
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy MyUnit -> ElmDefinition
toElmDefinition :: Proxy MyUnit -> ElmDefinition
Elm, [MyUnit] -> Value
[MyUnit] -> Encoding
MyUnit -> Bool
MyUnit -> Value
MyUnit -> Encoding
(MyUnit -> Value)
-> (MyUnit -> Encoding)
-> ([MyUnit] -> Value)
-> ([MyUnit] -> Encoding)
-> (MyUnit -> Bool)
-> ToJSON MyUnit
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: MyUnit -> Value
toJSON :: MyUnit -> Value
$ctoEncoding :: MyUnit -> Encoding
toEncoding :: MyUnit -> Encoding
$ctoJSONList :: [MyUnit] -> Value
toJSONList :: [MyUnit] -> Value
$ctoEncodingList :: [MyUnit] -> Encoding
toEncodingList :: [MyUnit] -> Encoding
$comitField :: MyUnit -> Bool
omitField :: MyUnit -> Bool
ToJSON, Maybe MyUnit
Value -> Parser [MyUnit]
Value -> Parser MyUnit
(Value -> Parser MyUnit)
-> (Value -> Parser [MyUnit]) -> Maybe MyUnit -> FromJSON MyUnit
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MyUnit
parseJSON :: Value -> Parser MyUnit
$cparseJSONList :: Value -> Parser [MyUnit]
parseJSONList :: Value -> Parser [MyUnit]
$comittedField :: Maybe MyUnit
omittedField :: Maybe MyUnit
FromJSON) via ElmStreet MyUnit

-- | For name clashes testing.
data MyResult
    = Ok
    | Err Text
    deriving ((forall x. MyResult -> Rep MyResult x)
-> (forall x. Rep MyResult x -> MyResult) -> Generic MyResult
forall x. Rep MyResult x -> MyResult
forall x. MyResult -> Rep MyResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MyResult -> Rep MyResult x
from :: forall x. MyResult -> Rep MyResult x
$cto :: forall x. Rep MyResult x -> MyResult
to :: forall x. Rep MyResult x -> MyResult
Generic, MyResult -> MyResult -> Bool
(MyResult -> MyResult -> Bool)
-> (MyResult -> MyResult -> Bool) -> Eq MyResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MyResult -> MyResult -> Bool
== :: MyResult -> MyResult -> Bool
$c/= :: MyResult -> MyResult -> Bool
/= :: MyResult -> MyResult -> Bool
Eq, Int -> MyResult -> ShowS
[MyResult] -> ShowS
MyResult -> String
(Int -> MyResult -> ShowS)
-> (MyResult -> String) -> ([MyResult] -> ShowS) -> Show MyResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MyResult -> ShowS
showsPrec :: Int -> MyResult -> ShowS
$cshow :: MyResult -> String
show :: MyResult -> String
$cshowList :: [MyResult] -> ShowS
showList :: [MyResult] -> ShowS
Show)
    deriving (Proxy MyResult -> ElmDefinition
(Proxy MyResult -> ElmDefinition) -> Elm MyResult
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy MyResult -> ElmDefinition
toElmDefinition :: Proxy MyResult -> ElmDefinition
Elm, Maybe MyResult
Value -> Parser [MyResult]
Value -> Parser MyResult
(Value -> Parser MyResult)
-> (Value -> Parser [MyResult])
-> Maybe MyResult
-> FromJSON MyResult
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser MyResult
parseJSON :: Value -> Parser MyResult
$cparseJSONList :: Value -> Parser [MyResult]
parseJSONList :: Value -> Parser [MyResult]
$comittedField :: Maybe MyResult
omittedField :: Maybe MyResult
FromJSON, [MyResult] -> Value
[MyResult] -> Encoding
MyResult -> Bool
MyResult -> Value
MyResult -> Encoding
(MyResult -> Value)
-> (MyResult -> Encoding)
-> ([MyResult] -> Value)
-> ([MyResult] -> Encoding)
-> (MyResult -> Bool)
-> ToJSON MyResult
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: MyResult -> Value
toJSON :: MyResult -> Value
$ctoEncoding :: MyResult -> Encoding
toEncoding :: MyResult -> Encoding
$ctoJSONList :: [MyResult] -> Value
toJSONList :: [MyResult] -> Value
$ctoEncodingList :: [MyResult] -> Encoding
toEncodingList :: [MyResult] -> Encoding
$comitField :: MyResult -> Bool
omitField :: MyResult -> Bool
ToJSON) via ElmStreet MyResult

-- | All test types together in one type to play with.
data OneType = OneType
    { OneType -> Prims
oneTypePrims          :: !Prims
    , OneType -> MyUnit
oneTypeMyUnit         :: !MyUnit
    , OneType -> MyResult
oneTypeMyResult       :: !MyResult
    , OneType -> Id OneType
oneTypeId             :: !(Id OneType)
    , OneType -> Age
oneTypeAge            :: !Age
    , OneType -> Newtype
oneTypeNewtype        :: !Newtype
    , OneType -> NewtypeList
oneTypeNewtypeList    :: !NewtypeList
    , OneType -> OneConstructor
oneTypeOneConstructor :: !OneConstructor
    , OneType -> RequestStatus
oneTypeRequestStatus  :: !RequestStatus
    , OneType -> User
oneTypeUser           :: !User
    , OneType -> [Guest]
oneTypeGuests         :: ![Guest]
    , OneType -> UserRequest
oneTypeUserRequest    :: !UserRequest
    , OneType -> NonEmpty MyUnit
oneTypeNonEmpty       :: !(NonEmpty MyUnit)
    } deriving ((forall x. OneType -> Rep OneType x)
-> (forall x. Rep OneType x -> OneType) -> Generic OneType
forall x. Rep OneType x -> OneType
forall x. OneType -> Rep OneType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OneType -> Rep OneType x
from :: forall x. OneType -> Rep OneType x
$cto :: forall x. Rep OneType x -> OneType
to :: forall x. Rep OneType x -> OneType
Generic, OneType -> OneType -> Bool
(OneType -> OneType -> Bool)
-> (OneType -> OneType -> Bool) -> Eq OneType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OneType -> OneType -> Bool
== :: OneType -> OneType -> Bool
$c/= :: OneType -> OneType -> Bool
/= :: OneType -> OneType -> Bool
Eq, Int -> OneType -> ShowS
[OneType] -> ShowS
OneType -> String
(Int -> OneType -> ShowS)
-> (OneType -> String) -> ([OneType] -> ShowS) -> Show OneType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneType -> ShowS
showsPrec :: Int -> OneType -> ShowS
$cshow :: OneType -> String
show :: OneType -> String
$cshowList :: [OneType] -> ShowS
showList :: [OneType] -> ShowS
Show)
      deriving (Proxy OneType -> ElmDefinition
(Proxy OneType -> ElmDefinition) -> Elm OneType
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy OneType -> ElmDefinition
toElmDefinition :: Proxy OneType -> ElmDefinition
Elm, Maybe OneType
Value -> Parser [OneType]
Value -> Parser OneType
(Value -> Parser OneType)
-> (Value -> Parser [OneType]) -> Maybe OneType -> FromJSON OneType
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser OneType
parseJSON :: Value -> Parser OneType
$cparseJSONList :: Value -> Parser [OneType]
parseJSONList :: Value -> Parser [OneType]
$comittedField :: Maybe OneType
omittedField :: Maybe OneType
FromJSON, [OneType] -> Value
[OneType] -> Encoding
OneType -> Bool
OneType -> Value
OneType -> Encoding
(OneType -> Value)
-> (OneType -> Encoding)
-> ([OneType] -> Value)
-> ([OneType] -> Encoding)
-> (OneType -> Bool)
-> ToJSON OneType
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OneType -> Value
toJSON :: OneType -> Value
$ctoEncoding :: OneType -> Encoding
toEncoding :: OneType -> Encoding
$ctoJSONList :: [OneType] -> Value
toJSONList :: [OneType] -> Value
$ctoEncodingList :: [OneType] -> Encoding
toEncodingList :: [OneType] -> Encoding
$comitField :: OneType -> Bool
omitField :: OneType -> Bool
ToJSON) via ElmStreet OneType

data CustomCodeGen = CustomCodeGen
    { CustomCodeGen -> String
customCodeGenString :: String
    , CustomCodeGen -> Int
customCodeGenInt :: Int
    } deriving stock ((forall x. CustomCodeGen -> Rep CustomCodeGen x)
-> (forall x. Rep CustomCodeGen x -> CustomCodeGen)
-> Generic CustomCodeGen
forall x. Rep CustomCodeGen x -> CustomCodeGen
forall x. CustomCodeGen -> Rep CustomCodeGen x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomCodeGen -> Rep CustomCodeGen x
from :: forall x. CustomCodeGen -> Rep CustomCodeGen x
$cto :: forall x. Rep CustomCodeGen x -> CustomCodeGen
to :: forall x. Rep CustomCodeGen x -> CustomCodeGen
Generic, CustomCodeGen -> CustomCodeGen -> Bool
(CustomCodeGen -> CustomCodeGen -> Bool)
-> (CustomCodeGen -> CustomCodeGen -> Bool) -> Eq CustomCodeGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomCodeGen -> CustomCodeGen -> Bool
== :: CustomCodeGen -> CustomCodeGen -> Bool
$c/= :: CustomCodeGen -> CustomCodeGen -> Bool
/= :: CustomCodeGen -> CustomCodeGen -> Bool
Eq, Int -> CustomCodeGen -> ShowS
[CustomCodeGen] -> ShowS
CustomCodeGen -> String
(Int -> CustomCodeGen -> ShowS)
-> (CustomCodeGen -> String)
-> ([CustomCodeGen] -> ShowS)
-> Show CustomCodeGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomCodeGen -> ShowS
showsPrec :: Int -> CustomCodeGen -> ShowS
$cshow :: CustomCodeGen -> String
show :: CustomCodeGen -> String
$cshowList :: [CustomCodeGen] -> ShowS
showList :: [CustomCodeGen] -> ShowS
Show)
      deriving (Proxy CustomCodeGen -> ElmDefinition
(Proxy CustomCodeGen -> ElmDefinition) -> Elm CustomCodeGen
forall a. (Proxy a -> ElmDefinition) -> Elm a
$ctoElmDefinition :: Proxy CustomCodeGen -> ElmDefinition
toElmDefinition :: Proxy CustomCodeGen -> ElmDefinition
Elm, Maybe CustomCodeGen
Value -> Parser [CustomCodeGen]
Value -> Parser CustomCodeGen
(Value -> Parser CustomCodeGen)
-> (Value -> Parser [CustomCodeGen])
-> Maybe CustomCodeGen
-> FromJSON CustomCodeGen
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CustomCodeGen
parseJSON :: Value -> Parser CustomCodeGen
$cparseJSONList :: Value -> Parser [CustomCodeGen]
parseJSONList :: Value -> Parser [CustomCodeGen]
$comittedField :: Maybe CustomCodeGen
omittedField :: Maybe CustomCodeGen
FromJSON, [CustomCodeGen] -> Value
[CustomCodeGen] -> Encoding
CustomCodeGen -> Bool
CustomCodeGen -> Value
CustomCodeGen -> Encoding
(CustomCodeGen -> Value)
-> (CustomCodeGen -> Encoding)
-> ([CustomCodeGen] -> Value)
-> ([CustomCodeGen] -> Encoding)
-> (CustomCodeGen -> Bool)
-> ToJSON CustomCodeGen
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CustomCodeGen -> Value
toJSON :: CustomCodeGen -> Value
$ctoEncoding :: CustomCodeGen -> Encoding
toEncoding :: CustomCodeGen -> Encoding
$ctoJSONList :: [CustomCodeGen] -> Value
toJSONList :: [CustomCodeGen] -> Value
$ctoEncodingList :: [CustomCodeGen] -> Encoding
toEncodingList :: [CustomCodeGen] -> Encoding
$comitField :: CustomCodeGen -> Bool
omitField :: CustomCodeGen -> Bool
ToJSON) via CustomElm CustomCodeGen

-- Settings which do some custom modifications of record filed names
customCodeGenOptions :: CodeGenOptions
customCodeGenOptions :: CodeGenOptions
customCodeGenOptions = (Text -> Text) -> CodeGenOptions
CodeGenOptions (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"CodeGen" Text
"FunTest")

-- Newtype whose Elm/ToJSON/FromJSON instance use custom CodeGenOptions
newtype CustomElm a = CustomElm {forall a. CustomElm a -> a
unCustomElm :: a}

instance ElmStreetGenericConstraints a => Elm (CustomElm a) where
    toElmDefinition :: Proxy (CustomElm a) -> ElmDefinition
toElmDefinition Proxy (CustomElm a)
_ = CodeGenOptions -> Rep a Any -> ElmDefinition
forall a. CodeGenOptions -> Rep a a -> ElmDefinition
forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
CodeGenOptions -> f a -> ElmDefinition
genericToElmDefinition CodeGenOptions
customCodeGenOptions
        (Rep a Any -> ElmDefinition) -> Rep a Any -> ElmDefinition
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
Generic.from (String -> a
forall a. HasCallStack => String -> a
error String
"Proxy for generic elm was evaluated" :: a)

instance (Generic a, GToJSON Zero (Rep a)) => ToJSON (CustomElm a) where
    toJSON :: CustomElm a -> Value
toJSON = CodeGenOptions -> a -> Value
forall a.
(Generic a, GToJSON Zero (Rep a)) =>
CodeGenOptions -> a -> Value
elmStreetToJsonWith CodeGenOptions
customCodeGenOptions (a -> Value) -> (CustomElm a -> a) -> CustomElm a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomElm a -> a
forall a. CustomElm a -> a
unCustomElm

instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomElm a) where
    parseJSON :: Value -> Parser (CustomElm a)
parseJSON = (a -> CustomElm a) -> Parser a -> Parser (CustomElm a)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> CustomElm a
forall a. a -> CustomElm a
CustomElm (Parser a -> Parser (CustomElm a))
-> (Value -> Parser a) -> Value -> Parser (CustomElm a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeGenOptions -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
CodeGenOptions -> Value -> Parser a
elmStreetParseJsonWith CodeGenOptions
customCodeGenOptions

-- | Type level list of all test types.
type Types =
   '[ Prims
    , MyUnit
    , MyResult
    , Id ()
    , Age
    , Newtype
    , NewtypeList
    , OneConstructor
    , RequestStatus
    , User
    , Guest
    , UserRequest
    , OneType
    , CustomCodeGen
    ]


defaultOneType :: OneType
defaultOneType :: OneType
defaultOneType = OneType
    { oneTypePrims :: Prims
oneTypePrims = Prims
defaultPrims
    , oneTypeMyUnit :: MyUnit
oneTypeMyUnit = () -> MyUnit
MyUnit ()
    , oneTypeMyResult :: MyResult
oneTypeMyResult = Text -> MyResult
Err Text
"clashing test"
    , oneTypeId :: Id OneType
oneTypeId = Text -> Id OneType
forall a. Text -> Id a
Id Text
"myId"
    , oneTypeAge :: Age
oneTypeAge = Int -> Age
Age Int
18
    , oneTypeNewtype :: Newtype
oneTypeNewtype = Int -> Newtype
Newtype Int
666
    , oneTypeNewtypeList :: NewtypeList
oneTypeNewtypeList = [Int] -> NewtypeList
NewtypeList [Int
123]
    , oneTypeOneConstructor :: OneConstructor
oneTypeOneConstructor = OneConstructor
OneConstructor
    , oneTypeRequestStatus :: RequestStatus
oneTypeRequestStatus = RequestStatus
Reviewing
    , oneTypeUser :: User
oneTypeUser = Id User -> Text -> Age -> RequestStatus -> User
User (Text -> Id User
forall a. Text -> Id a
Id Text
"1") Text
"not-me" (Int -> Age
Age Int
100) RequestStatus
Approved
    , oneTypeGuests :: [Guest]
oneTypeGuests = [Guest
guestRegular, Guest
guestVisitor, Guest
guestBlocked]
    , oneTypeUserRequest :: UserRequest
oneTypeUserRequest = UserRequest
defaultUserRequest
    , oneTypeNonEmpty :: NonEmpty MyUnit
oneTypeNonEmpty = () -> MyUnit
MyUnit () MyUnit -> [MyUnit] -> NonEmpty MyUnit
forall a. a -> [a] -> NonEmpty a
:| [ () -> MyUnit
MyUnit () ]
    }
  where
    defaultPrims :: Prims
    defaultPrims :: Prims
defaultPrims = Prims
        { primsUnit :: ()
primsUnit     = ()
        , primsBool :: Bool
primsBool     = Bool
True
        , primsChar :: Char
primsChar     = Char
'a'
        , primsInt :: Int
primsInt      = Int
42
        , primsFloat :: Double
primsFloat    = Double
36.6
        , primsText :: Text
primsText     = Text
"heh"
        , primsString :: String
primsString   = String
"bye"
        , primsValue :: Value
primsValue    = [Pair] -> Value
object
            [ Key
"nullField"   Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
Null
            , Key
"boolField"   Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
True
            , Key
"numberField" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Int
1::Int)
            , Key
"stringField" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (String
"hi"::String)
            , Key
"arrayField"  Key -> [Int] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Int
1::Int,Int
2,Int
3]
            , Key
"objectField" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object []
            ]
        , primsTime :: UTCTime
primsTime     = Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
2019 Int
2 Int
22) DiffTime
0
        , primsMaybe :: Maybe Word
primsMaybe    = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
12
        , primsResult :: Either Int Text
primsResult   = Int -> Either Int Text
forall a b. a -> Either a b
Left Int
666
        , primsPair :: (Char, Bool)
primsPair     = (Char
'o', Bool
False)
        , primsTriple :: (Char, Bool, [Int])
primsTriple   = (Char
'o', Bool
False, [Int
0])
        , primsList :: [Int]
primsList     = [Int
1..Int
5]
        , primsNonEmpty :: NonEmpty Int
primsNonEmpty = Int
1 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| []
        }

    guestRegular, guestVisitor, guestBlocked :: Guest
    guestRegular :: Guest
guestRegular = Text -> Int -> Guest
Regular Text
"nice" Int
7
    guestVisitor :: Guest
guestVisitor = Text -> Guest
Visitor Text
"new-guest"
    guestBlocked :: Guest
guestBlocked = Guest
Blocked

    defaultUserRequest :: UserRequest
    defaultUserRequest :: UserRequest
defaultUserRequest = UserRequest
        { userRequestIds :: [Id User]
userRequestIds     = [Text -> Id User
forall a. Text -> Id a
Id Text
"1", Text -> Id User
forall a. Text -> Id a
Id Text
"2"]
        , userRequestLimit :: Word32
userRequestLimit   = Word32
123
        , userRequestExample :: Maybe (Either User Guest)
userRequestExample = Either User Guest -> Maybe (Either User Guest)
forall a. a -> Maybe a
Just (Guest -> Either User Guest
forall a b. b -> Either a b
Right Guest
Blocked)
        }

defaultCustomCodeGen :: CustomCodeGen
defaultCustomCodeGen :: CustomCodeGen
defaultCustomCodeGen = CustomCodeGen
    { customCodeGenString :: String
customCodeGenString = String
"Hello"
    , customCodeGenInt :: Int
customCodeGenInt = Int
78
    }