{-# 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. 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
$cto :: forall x. Rep Prims x -> Prims
$cfrom :: forall x. Prims -> Rep Prims x
Generic, Prims -> Prims -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prims -> Prims -> Bool
$c/= :: Prims -> Prims -> Bool
== :: Prims -> Prims -> Bool
$c== :: Prims -> Prims -> Bool
Eq, Int -> Prims -> ShowS
[Prims] -> ShowS
Prims -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prims] -> ShowS
$cshowList :: [Prims] -> ShowS
show :: Prims -> String
$cshow :: Prims -> String
showsPrec :: Int -> Prims -> ShowS
$cshowsPrec :: Int -> Prims -> ShowS
Show)
      deriving (Proxy Prims -> ElmDefinition
forall a. (Proxy a -> ElmDefinition) -> Elm a
toElmDefinition :: Proxy Prims -> ElmDefinition
$ctoElmDefinition :: Proxy Prims -> ElmDefinition
Elm, [Prims] -> Encoding
[Prims] -> Value
Prims -> Encoding
Prims -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Prims] -> Encoding
$ctoEncodingList :: [Prims] -> Encoding
toJSONList :: [Prims] -> Value
$ctoJSONList :: [Prims] -> Value
toEncoding :: Prims -> Encoding
$ctoEncoding :: Prims -> Encoding
toJSON :: Prims -> Value
$ctoJSON :: Prims -> Value
ToJSON, Value -> Parser [Prims]
Value -> Parser Prims
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Prims]
$cparseJSONList :: Value -> Parser [Prims]
parseJSON :: Value -> Parser Prims
$cparseJSON :: Value -> Parser Prims
FromJSON) via ElmStreet Prims

newtype Id a = Id
    { forall a. Id a -> Text
unId :: Text
    } deriving (Int -> Id a -> ShowS
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
showList :: [Id a] -> ShowS
$cshowList :: forall a. [Id a] -> ShowS
show :: Id a -> String
$cshow :: forall a. Id a -> String
showsPrec :: Int -> Id a -> ShowS
$cshowsPrec :: forall a. Int -> Id a -> ShowS
Show, Id a -> Id a -> Bool
forall a. Id a -> Id a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Id a -> Id a -> Bool
$c/= :: forall a. Id a -> Id a -> Bool
== :: Id a -> Id a -> Bool
$c== :: forall a. Id a -> Id a -> Bool
Eq)
      deriving newtype (Value -> Parser [Id a]
Value -> Parser (Id a)
forall a. Value -> Parser [Id a]
forall a. Value -> Parser (Id a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Id a]
$cparseJSONList :: forall a. Value -> Parser [Id a]
parseJSON :: Value -> Parser (Id a)
$cparseJSON :: forall a. Value -> Parser (Id a)
FromJSON, [Id a] -> Encoding
[Id a] -> Value
Id a -> Encoding
Id a -> Value
forall a. [Id a] -> Encoding
forall a. [Id a] -> Value
forall a. Id a -> Encoding
forall a. Id a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Id a] -> Encoding
$ctoEncodingList :: forall a. [Id a] -> Encoding
toJSONList :: [Id a] -> Value
$ctoJSONList :: forall a. [Id a] -> Value
toEncoding :: Id a -> Encoding
$ctoEncoding :: forall a. Id a -> Encoding
toJSON :: Id a -> Value
$ctoJSON :: forall a. Id a -> Value
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. 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
$cto :: forall x. Rep Age x -> Age
$cfrom :: forall x. Age -> Rep Age x
Generic, Age -> Age -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Age -> Age -> Bool
$c/= :: Age -> Age -> Bool
== :: Age -> Age -> Bool
$c== :: Age -> Age -> Bool
Eq, Int -> Age -> ShowS
[Age] -> ShowS
Age -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Age] -> ShowS
$cshowList :: [Age] -> ShowS
show :: Age -> String
$cshow :: Age -> String
showsPrec :: Int -> Age -> ShowS
$cshowsPrec :: Int -> Age -> ShowS
Show)
      deriving anyclass (Proxy Age -> ElmDefinition
forall a. (Proxy a -> ElmDefinition) -> Elm a
toElmDefinition :: Proxy Age -> ElmDefinition
$ctoElmDefinition :: Proxy Age -> ElmDefinition
Elm)
      deriving newtype (Value -> Parser [Age]
Value -> Parser Age
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Age]
$cparseJSONList :: Value -> Parser [Age]
parseJSON :: Value -> Parser Age
$cparseJSON :: Value -> Parser Age
FromJSON, [Age] -> Encoding
[Age] -> Value
Age -> Encoding
Age -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Age] -> Encoding
$ctoEncodingList :: [Age] -> Encoding
toJSONList :: [Age] -> Value
$ctoJSONList :: [Age] -> Value
toEncoding :: Age -> Encoding
$ctoEncoding :: Age -> Encoding
toJSON :: Age -> Value
$ctoJSON :: Age -> Value
ToJSON)

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

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

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

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

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

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

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

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

-- Settings which do some custom modifications of record filed names
customCodeGenOptions :: CodeGenOptions
customCodeGenOptions :: CodeGenOptions
customCodeGenOptions = (Text -> Text) -> CodeGenOptions
CodeGenOptions (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)
_ = forall k (f :: k -> *) (a :: k).
GenericElmDefinition f =>
CodeGenOptions -> f a -> ElmDefinition
genericToElmDefinition CodeGenOptions
customCodeGenOptions
        forall a b. (a -> b) -> a -> b
$ forall a x. Generic a => a -> Rep a x
Generic.from (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 = forall a.
(Generic a, GToJSON Zero (Rep a)) =>
CodeGenOptions -> a -> Value
elmStreetToJsonWith CodeGenOptions
customCodeGenOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CustomElm a -> a
unCustomElm

instance (Generic a, GFromJSON Zero (Rep a)) => FromJSON (CustomElm a) where
    parseJSON :: Value -> Parser (CustomElm a)
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> CustomElm a
CustomElm forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 (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 () 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"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
Null
            , Key
"boolField"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
            , Key
"numberField" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Int
1::Int)
            , Key
"stringField" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (String
"hi"::String)
            , Key
"arrayField"  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Int
1::Int,Int
2,Int
3]
            , Key
"objectField" forall kv v. (KeyValue 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    = forall a. a -> Maybe a
Just Word
12
        , primsResult :: Either Int Text
primsResult   = 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 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     = [forall a. Text -> Id a
Id Text
"1", forall a. Text -> Id a
Id Text
"2"]
        , userRequestLimit :: Word32
userRequestLimit   = Word32
123
        , userRequestExample :: Maybe (Either User Guest)
userRequestExample = forall a. a -> Maybe a
Just (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
    }