module DomainDriven.Server.Types where

import Control.Monad.State
import Data.Function (on)
import Data.Generics.Product
import Data.List qualified as L
import Data.Set (Set)
import GHC.Generics (Generic)
import Language.Haskell.TH
import Lens.Micro ((^.))
import Prelude

-- Contains infromatiotion of how the API should look, gathered from the Action GADT.
data ApiSpec = ApiSpec
    { ApiSpec -> GadtName
gadtName :: GadtName
    , ApiSpec -> GadtType
gadtType :: GadtType
    -- ^ Name of the GADT representing the command
    , ApiSpec -> VarBindings
allVarBindings :: VarBindings
    , ApiSpec -> [ApiPiece]
endpoints :: [ApiPiece]
    -- ^ Endpoints created from the constructors of the GADT
    , ApiSpec -> ApiOptions
options :: ApiOptions
    -- ^ The setting to use when generating part of the API
    }
    deriving (Int -> ApiSpec -> ShowS
[ApiSpec] -> ShowS
ApiSpec -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ApiSpec] -> ShowS
$cshowList :: [ApiSpec] -> ShowS
show :: ApiSpec -> [Char]
$cshow :: ApiSpec -> [Char]
showsPrec :: Int -> ApiSpec -> ShowS
$cshowsPrec :: Int -> ApiSpec -> ShowS
Show, forall x. Rep ApiSpec x -> ApiSpec
forall x. ApiSpec -> Rep ApiSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiSpec x -> ApiSpec
$cfrom :: forall x. ApiSpec -> Rep ApiSpec x
Generic)

data VarBindings = VarBindings
    { VarBindings -> Name
paramPart :: Name
    , VarBindings -> Name
method :: Name
    , VarBindings -> Name
return :: Name
    , VarBindings -> [TyVarBndr ()]
extra :: [TyVarBndr ()]
    }
    deriving (Int -> VarBindings -> ShowS
[VarBindings] -> ShowS
VarBindings -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VarBindings] -> ShowS
$cshowList :: [VarBindings] -> ShowS
show :: VarBindings -> [Char]
$cshow :: VarBindings -> [Char]
showsPrec :: Int -> VarBindings -> ShowS
$cshowsPrec :: Int -> VarBindings -> ShowS
Show, forall x. Rep VarBindings x -> VarBindings
forall x. VarBindings -> Rep VarBindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VarBindings x -> VarBindings
$cfrom :: forall x. VarBindings -> Rep VarBindings x
Generic, VarBindings -> VarBindings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarBindings -> VarBindings -> Bool
$c/= :: VarBindings -> VarBindings -> Bool
== :: VarBindings -> VarBindings -> Bool
$c== :: VarBindings -> VarBindings -> Bool
Eq)

data ApiOptions = ApiOptions
    { ApiOptions -> ShowS
renameConstructor :: String -> String
    , ApiOptions -> [Char]
typenameSeparator :: String
    , ApiOptions -> Maybe [Char]
bodyNameBase :: Maybe String
    }
    deriving (forall x. Rep ApiOptions x -> ApiOptions
forall x. ApiOptions -> Rep ApiOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiOptions x -> ApiOptions
$cfrom :: forall x. ApiOptions -> Rep ApiOptions x
Generic)

defaultApiOptions :: ApiOptions
defaultApiOptions :: ApiOptions
defaultApiOptions =
    ApiOptions
        { $sel:renameConstructor:ApiOptions :: ShowS
renameConstructor =
            \[Char]
s -> case forall a. Int -> [a] -> ([a], [a])
L.splitAt (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on (-) forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Char]
s [Char]
"Action") [Char]
s of
                ([Char]
x, [Char]
"Action") -> [Char]
x
                ([Char], [Char])
_ -> [Char]
s
        , $sel:typenameSeparator:ApiOptions :: [Char]
typenameSeparator = [Char]
"_"
        , $sel:bodyNameBase:ApiOptions :: Maybe [Char]
bodyNameBase = forall a. Maybe a
Nothing
        }

instance Show ApiOptions where
    show :: ApiOptions -> [Char]
show ApiOptions
o =
        [Char]
"ApiOptions {renameConstructor = ***, typenameSeparator = \""
            forall a. Semigroup a => a -> a -> a
<> ApiOptions
o
                forall s a. s -> Getting a s a -> a
^. forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"typenameSeparator"
            forall a. Semigroup a => a -> a -> a
<> [Char]
"\"}"

data Mutability
    = Mutable
    | Immutable
    deriving (Int -> Mutability -> ShowS
[Mutability] -> ShowS
Mutability -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Mutability] -> ShowS
$cshowList :: [Mutability] -> ShowS
show :: Mutability -> [Char]
$cshow :: Mutability -> [Char]
showsPrec :: Int -> Mutability -> ShowS
$cshowsPrec :: Int -> Mutability -> ShowS
Show, Mutability -> Mutability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mutability -> Mutability -> Bool
$c/= :: Mutability -> Mutability -> Bool
== :: Mutability -> Mutability -> Bool
$c== :: Mutability -> Mutability -> Bool
Eq)

data ApiPiece
    = Endpoint
        ConstructorName
        ConstructorArgs
        VarBindings
        HandlerSettings
        Mutability
        EpReturnType
    | SubApi ConstructorName ConstructorArgs ApiSpec
    deriving (Int -> ApiPiece -> ShowS
[ApiPiece] -> ShowS
ApiPiece -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ApiPiece] -> ShowS
$cshowList :: [ApiPiece] -> ShowS
show :: ApiPiece -> [Char]
$cshow :: ApiPiece -> [Char]
showsPrec :: Int -> ApiPiece -> ShowS
$cshowsPrec :: Int -> ApiPiece -> ShowS
Show, forall x. Rep ApiPiece x -> ApiPiece
forall x. ApiPiece -> Rep ApiPiece x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiPiece x -> ApiPiece
$cfrom :: forall x. ApiPiece -> Rep ApiPiece x
Generic)

data HandlerSettings = HandlerSettings
    { HandlerSettings -> Type
contentTypes :: Type
    , HandlerSettings -> Type
verb :: Type
    }
    deriving (Int -> HandlerSettings -> ShowS
[HandlerSettings] -> ShowS
HandlerSettings -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HandlerSettings] -> ShowS
$cshowList :: [HandlerSettings] -> ShowS
show :: HandlerSettings -> [Char]
$cshow :: HandlerSettings -> [Char]
showsPrec :: Int -> HandlerSettings -> ShowS
$cshowsPrec :: Int -> HandlerSettings -> ShowS
Show, forall x. Rep HandlerSettings x -> HandlerSettings
forall x. HandlerSettings -> Rep HandlerSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HandlerSettings x -> HandlerSettings
$cfrom :: forall x. HandlerSettings -> Rep HandlerSettings x
Generic, HandlerSettings -> HandlerSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HandlerSettings -> HandlerSettings -> Bool
$c/= :: HandlerSettings -> HandlerSettings -> Bool
== :: HandlerSettings -> HandlerSettings -> Bool
$c== :: HandlerSettings -> HandlerSettings -> Bool
Eq)

newtype ConstructorName = ConstructorName Name deriving (Int -> ConstructorName -> ShowS
[ConstructorName] -> ShowS
ConstructorName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorName] -> ShowS
$cshowList :: [ConstructorName] -> ShowS
show :: ConstructorName -> [Char]
$cshow :: ConstructorName -> [Char]
showsPrec :: Int -> ConstructorName -> ShowS
$cshowsPrec :: Int -> ConstructorName -> ShowS
Show, forall x. Rep ConstructorName x -> ConstructorName
forall x. ConstructorName -> Rep ConstructorName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstructorName x -> ConstructorName
$cfrom :: forall x. ConstructorName -> Rep ConstructorName x
Generic, ConstructorName -> ConstructorName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorName -> ConstructorName -> Bool
$c/= :: ConstructorName -> ConstructorName -> Bool
== :: ConstructorName -> ConstructorName -> Bool
$c== :: ConstructorName -> ConstructorName -> Bool
Eq)
newtype EpReturnType = EpReturnType Type deriving (Int -> EpReturnType -> ShowS
[EpReturnType] -> ShowS
EpReturnType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EpReturnType] -> ShowS
$cshowList :: [EpReturnType] -> ShowS
show :: EpReturnType -> [Char]
$cshow :: EpReturnType -> [Char]
showsPrec :: Int -> EpReturnType -> ShowS
$cshowsPrec :: Int -> EpReturnType -> ShowS
Show, forall x. Rep EpReturnType x -> EpReturnType
forall x. EpReturnType -> Rep EpReturnType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpReturnType x -> EpReturnType
$cfrom :: forall x. EpReturnType -> Rep EpReturnType x
Generic, EpReturnType -> EpReturnType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpReturnType -> EpReturnType -> Bool
$c/= :: EpReturnType -> EpReturnType -> Bool
== :: EpReturnType -> EpReturnType -> Bool
$c== :: EpReturnType -> EpReturnType -> Bool
Eq)
newtype GadtName = GadtName Name deriving (Int -> GadtName -> ShowS
[GadtName] -> ShowS
GadtName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GadtName] -> ShowS
$cshowList :: [GadtName] -> ShowS
show :: GadtName -> [Char]
$cshow :: GadtName -> [Char]
showsPrec :: Int -> GadtName -> ShowS
$cshowsPrec :: Int -> GadtName -> ShowS
Show, forall x. Rep GadtName x -> GadtName
forall x. GadtName -> Rep GadtName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GadtName x -> GadtName
$cfrom :: forall x. GadtName -> Rep GadtName x
Generic, GadtName -> GadtName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GadtName -> GadtName -> Bool
$c/= :: GadtName -> GadtName -> Bool
== :: GadtName -> GadtName -> Bool
$c== :: GadtName -> GadtName -> Bool
Eq)
newtype GadtType = GadtType Type deriving (Int -> GadtType -> ShowS
[GadtType] -> ShowS
GadtType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GadtType] -> ShowS
$cshowList :: [GadtType] -> ShowS
show :: GadtType -> [Char]
$cshow :: GadtType -> [Char]
showsPrec :: Int -> GadtType -> ShowS
$cshowsPrec :: Int -> GadtType -> ShowS
Show, forall x. Rep GadtType x -> GadtType
forall x. GadtType -> Rep GadtType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GadtType x -> GadtType
$cfrom :: forall x. GadtType -> Rep GadtType x
Generic, GadtType -> GadtType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GadtType -> GadtType -> Bool
$c/= :: GadtType -> GadtType -> Bool
== :: GadtType -> GadtType -> Bool
$c== :: GadtType -> GadtType -> Bool
Eq)

newtype UrlSegment = UrlSegment String deriving (Int -> UrlSegment -> ShowS
[UrlSegment] -> ShowS
UrlSegment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UrlSegment] -> ShowS
$cshowList :: [UrlSegment] -> ShowS
show :: UrlSegment -> [Char]
$cshow :: UrlSegment -> [Char]
showsPrec :: Int -> UrlSegment -> ShowS
$cshowsPrec :: Int -> UrlSegment -> ShowS
Show, forall x. Rep UrlSegment x -> UrlSegment
forall x. UrlSegment -> Rep UrlSegment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UrlSegment x -> UrlSegment
$cfrom :: forall x. UrlSegment -> Rep UrlSegment x
Generic, UrlSegment -> UrlSegment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UrlSegment -> UrlSegment -> Bool
$c/= :: UrlSegment -> UrlSegment -> Bool
== :: UrlSegment -> UrlSegment -> Bool
$c== :: UrlSegment -> UrlSegment -> Bool
Eq)
newtype ConstructorArgs = ConstructorArgs [(String, Type)] deriving (Int -> ConstructorArgs -> ShowS
[ConstructorArgs] -> ShowS
ConstructorArgs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorArgs] -> ShowS
$cshowList :: [ConstructorArgs] -> ShowS
show :: ConstructorArgs -> [Char]
$cshow :: ConstructorArgs -> [Char]
showsPrec :: Int -> ConstructorArgs -> ShowS
$cshowsPrec :: Int -> ConstructorArgs -> ShowS
Show, forall x. Rep ConstructorArgs x -> ConstructorArgs
forall x. ConstructorArgs -> Rep ConstructorArgs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstructorArgs x -> ConstructorArgs
$cfrom :: forall x. ConstructorArgs -> Rep ConstructorArgs x
Generic, ConstructorArgs -> ConstructorArgs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstructorArgs -> ConstructorArgs -> Bool
$c/= :: ConstructorArgs -> ConstructorArgs -> Bool
== :: ConstructorArgs -> ConstructorArgs -> Bool
$c== :: ConstructorArgs -> ConstructorArgs -> Bool
Eq)
newtype Runner = Runner Type deriving (Int -> Runner -> ShowS
[Runner] -> ShowS
Runner -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Runner] -> ShowS
$cshowList :: [Runner] -> ShowS
show :: Runner -> [Char]
$cshow :: Runner -> [Char]
showsPrec :: Int -> Runner -> ShowS
$cshowsPrec :: Int -> Runner -> ShowS
Show, forall x. Rep Runner x -> Runner
forall x. Runner -> Rep Runner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Runner x -> Runner
$cfrom :: forall x. Runner -> Rep Runner x
Generic, Runner -> Runner -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Runner -> Runner -> Bool
$c/= :: Runner -> Runner -> Bool
== :: Runner -> Runner -> Bool
$c== :: Runner -> Runner -> Bool
Eq)

-- | Carries information regarding how the API looks at the place we're currently at.
data ServerInfo = ServerInfo
    { ServerInfo -> GadtName
baseGadt :: GadtName
    -- ^ Use as a prefix of all types
    , ServerInfo -> GadtName
currentGadt :: GadtName
    , ServerInfo -> [ConstructorName]
parentConstructors :: [ConstructorName]
    -- ^ To create good names without conflict
    , ServerInfo -> [UrlSegment]
prefixSegments :: [UrlSegment]
    -- ^ Used to give a good name to the request body
    , ServerInfo -> ApiOptions
options :: ApiOptions
    -- ^ The current options
    }
    deriving (Int -> ServerInfo -> ShowS
[ServerInfo] -> ShowS
ServerInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ServerInfo] -> ShowS
$cshowList :: [ServerInfo] -> ShowS
show :: ServerInfo -> [Char]
$cshow :: ServerInfo -> [Char]
showsPrec :: Int -> ServerInfo -> ShowS
$cshowsPrec :: Int -> ServerInfo -> ShowS
Show, forall x. Rep ServerInfo x -> ServerInfo
forall x. ServerInfo -> Rep ServerInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServerInfo x -> ServerInfo
$cfrom :: forall x. ServerInfo -> Rep ServerInfo x
Generic)

data ServerGenState = ServerGenState
    { ServerGenState -> ServerInfo
info :: ServerInfo
    , ServerGenState -> Set [Char]
usedParamNames :: Set String
    }
    deriving (Int -> ServerGenState -> ShowS
[ServerGenState] -> ShowS
ServerGenState -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ServerGenState] -> ShowS
$cshowList :: [ServerGenState] -> ShowS
show :: ServerGenState -> [Char]
$cshow :: ServerGenState -> [Char]
showsPrec :: Int -> ServerGenState -> ShowS
$cshowsPrec :: Int -> ServerGenState -> ShowS
Show, forall x. Rep ServerGenState x -> ServerGenState
forall x. ServerGenState -> Rep ServerGenState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServerGenState x -> ServerGenState
$cfrom :: forall x. ServerGenState -> Rep ServerGenState x
Generic)

newtype ServerGenM a = ServerGenM {forall a. ServerGenM a -> StateT ServerGenState Q a
unServerGenM :: StateT ServerGenState Q a}
    deriving newtype (forall a b. a -> ServerGenM b -> ServerGenM a
forall a b. (a -> b) -> ServerGenM a -> ServerGenM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ServerGenM b -> ServerGenM a
$c<$ :: forall a b. a -> ServerGenM b -> ServerGenM a
fmap :: forall a b. (a -> b) -> ServerGenM a -> ServerGenM b
$cfmap :: forall a b. (a -> b) -> ServerGenM a -> ServerGenM b
Functor, Functor ServerGenM
forall a. a -> ServerGenM a
forall a b. ServerGenM a -> ServerGenM b -> ServerGenM a
forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
forall a b. ServerGenM (a -> b) -> ServerGenM a -> ServerGenM b
forall a b c.
(a -> b -> c) -> ServerGenM a -> ServerGenM b -> ServerGenM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM a
$c<* :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM a
*> :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
$c*> :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
liftA2 :: forall a b c.
(a -> b -> c) -> ServerGenM a -> ServerGenM b -> ServerGenM c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ServerGenM a -> ServerGenM b -> ServerGenM c
<*> :: forall a b. ServerGenM (a -> b) -> ServerGenM a -> ServerGenM b
$c<*> :: forall a b. ServerGenM (a -> b) -> ServerGenM a -> ServerGenM b
pure :: forall a. a -> ServerGenM a
$cpure :: forall a. a -> ServerGenM a
Applicative, Applicative ServerGenM
forall a. a -> ServerGenM a
forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
forall a b. ServerGenM a -> (a -> ServerGenM b) -> ServerGenM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ServerGenM a
$creturn :: forall a. a -> ServerGenM a
>> :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
$c>> :: forall a b. ServerGenM a -> ServerGenM b -> ServerGenM b
>>= :: forall a b. ServerGenM a -> (a -> ServerGenM b) -> ServerGenM b
$c>>= :: forall a b. ServerGenM a -> (a -> ServerGenM b) -> ServerGenM b
Monad, MonadState ServerGenState, Monad ServerGenM
forall a. [Char] -> ServerGenM a
forall (m :: * -> *).
Monad m -> (forall a. [Char] -> m a) -> MonadFail m
fail :: forall a. [Char] -> ServerGenM a
$cfail :: forall a. [Char] -> ServerGenM a
MonadFail)

data Pmatch = Pmatch
    { Pmatch -> Name
paramPart :: Name
    , Pmatch -> [Char]
paramName :: String
    , Pmatch -> Type
paramType :: Type
    }
    deriving (Int -> Pmatch -> ShowS
[Pmatch] -> ShowS
Pmatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Pmatch] -> ShowS
$cshowList :: [Pmatch] -> ShowS
show :: Pmatch -> [Char]
$cshow :: Pmatch -> [Char]
showsPrec :: Int -> Pmatch -> ShowS
$cshowsPrec :: Int -> Pmatch -> ShowS
Show, forall x. Rep Pmatch x -> Pmatch
forall x. Pmatch -> Rep Pmatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pmatch x -> Pmatch
$cfrom :: forall x. Pmatch -> Rep Pmatch x
Generic)

data ConstructorMatch = ConstructorMatch
    { ConstructorMatch -> Name
xParam :: Name
    -- ^ Of kind ParamPart
    , ConstructorMatch -> Name
constructorName :: Name
    , ConstructorMatch -> [Pmatch]
parameters :: [Pmatch]
    , ConstructorMatch -> FinalConstructorTypeMatch
finalType :: FinalConstructorTypeMatch
    }
    deriving (Int -> ConstructorMatch -> ShowS
[ConstructorMatch] -> ShowS
ConstructorMatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstructorMatch] -> ShowS
$cshowList :: [ConstructorMatch] -> ShowS
show :: ConstructorMatch -> [Char]
$cshow :: ConstructorMatch -> [Char]
showsPrec :: Int -> ConstructorMatch -> ShowS
$cshowsPrec :: Int -> ConstructorMatch -> ShowS
Show, forall x. Rep ConstructorMatch x -> ConstructorMatch
forall x. ConstructorMatch -> Rep ConstructorMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConstructorMatch x -> ConstructorMatch
$cfrom :: forall x. ConstructorMatch -> Rep ConstructorMatch x
Generic)

data SubActionMatch = SubActionMatch
    { SubActionMatch -> Name
constructorName :: Name
    , SubActionMatch -> [Pmatch]
parameters :: [Pmatch]
    , SubActionMatch -> Name
subActionName :: Name
    , SubActionMatch -> Type
subActionType :: Type
    }
    deriving (Int -> SubActionMatch -> ShowS
[SubActionMatch] -> ShowS
SubActionMatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubActionMatch] -> ShowS
$cshowList :: [SubActionMatch] -> ShowS
show :: SubActionMatch -> [Char]
$cshow :: SubActionMatch -> [Char]
showsPrec :: Int -> SubActionMatch -> ShowS
$cshowsPrec :: Int -> SubActionMatch -> ShowS
Show, forall x. Rep SubActionMatch x -> SubActionMatch
forall x. SubActionMatch -> Rep SubActionMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubActionMatch x -> SubActionMatch
$cfrom :: forall x. SubActionMatch -> Rep SubActionMatch x
Generic)

data SubActionTypeMatch = SubActionTypeMatch
    deriving (Int -> SubActionTypeMatch -> ShowS
[SubActionTypeMatch] -> ShowS
SubActionTypeMatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SubActionTypeMatch] -> ShowS
$cshowList :: [SubActionTypeMatch] -> ShowS
show :: SubActionTypeMatch -> [Char]
$cshow :: SubActionTypeMatch -> [Char]
showsPrec :: Int -> SubActionTypeMatch -> ShowS
$cshowsPrec :: Int -> SubActionTypeMatch -> ShowS
Show, forall x. Rep SubActionTypeMatch x -> SubActionTypeMatch
forall x. SubActionTypeMatch -> Rep SubActionTypeMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubActionTypeMatch x -> SubActionTypeMatch
$cfrom :: forall x. SubActionTypeMatch -> Rep SubActionTypeMatch x
Generic)

data FinalConstructorTypeMatch = FinalConstructorTypeMatch
    { FinalConstructorTypeMatch -> RequestTypeMatch
requestType :: RequestTypeMatch
    , FinalConstructorTypeMatch -> Type
returnType :: Type
    }
    deriving (Int -> FinalConstructorTypeMatch -> ShowS
[FinalConstructorTypeMatch] -> ShowS
FinalConstructorTypeMatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FinalConstructorTypeMatch] -> ShowS
$cshowList :: [FinalConstructorTypeMatch] -> ShowS
show :: FinalConstructorTypeMatch -> [Char]
$cshow :: FinalConstructorTypeMatch -> [Char]
showsPrec :: Int -> FinalConstructorTypeMatch -> ShowS
$cshowsPrec :: Int -> FinalConstructorTypeMatch -> ShowS
Show, forall x.
Rep FinalConstructorTypeMatch x -> FinalConstructorTypeMatch
forall x.
FinalConstructorTypeMatch -> Rep FinalConstructorTypeMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep FinalConstructorTypeMatch x -> FinalConstructorTypeMatch
$cfrom :: forall x.
FinalConstructorTypeMatch -> Rep FinalConstructorTypeMatch x
Generic)

data RequestTypeMatch = RequestTypeMatch
    { RequestTypeMatch -> Type
accessType :: Type
    , RequestTypeMatch -> Type
contentTypes :: Type
    , RequestTypeMatch -> Type
verb :: Type
    }
    deriving (Int -> RequestTypeMatch -> ShowS
[RequestTypeMatch] -> ShowS
RequestTypeMatch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RequestTypeMatch] -> ShowS
$cshowList :: [RequestTypeMatch] -> ShowS
show :: RequestTypeMatch -> [Char]
$cshow :: RequestTypeMatch -> [Char]
showsPrec :: Int -> RequestTypeMatch -> ShowS
$cshowsPrec :: Int -> RequestTypeMatch -> ShowS
Show, forall x. Rep RequestTypeMatch x -> RequestTypeMatch
forall x. RequestTypeMatch -> Rep RequestTypeMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestTypeMatch x -> RequestTypeMatch
$cfrom :: forall x. RequestTypeMatch -> Rep RequestTypeMatch x
Generic)