{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}

module Unison.Share.API.Projects
  ( -- * API
    ProjectsAPI,

    -- ** Get project
    GetProjectAPI,
    GetProjectResponse (..),

    -- ** Create project
    CreateProjectAPI,
    CreateProjectRequest (..),
    CreateProjectResponse (..),

    -- ** Get project branch
    GetProjectBranchAPI,
    GetProjectBranchResponse (..),

    -- ** Create project branch
    CreateProjectBranchAPI,
    CreateProjectBranchRequest (..),
    CreateProjectBranchResponse (..),

    -- ** Set project branch head
    SetProjectBranchHeadAPI,
    SetProjectBranchHeadRequest (..),
    SetProjectBranchHeadResponse (..),

    -- * Types
    Project (..),
    ProjectBranch (..),
    ProjectBranchIds (..),
    NotFound (..),
    Unauthorized (..),
    BranchName,
  )
where

import Data.Aeson
import Data.Aeson.Key qualified as Aeson.Key
import Data.Aeson.KeyMap qualified as Aeson.KeyMap
import Data.Aeson.Types
import Data.Monoid (Endo (..))
import Data.Text qualified as Text
import Servant.API
import Unison.Hash32 (Hash32)
import Unison.Hash32.Orphans.Aeson ()
import Unison.Prelude
import Unison.Share.API.Hash (HashJWT)

type ProjectsAPI =
  GetProjectAPI
    :<|> CreateProjectAPI
    :<|> GetProjectBranchAPI
    :<|> CreateProjectBranchAPI
    :<|> SetProjectBranchHeadAPI

------------------------------------------------------------------------------------------------------------------------
-- Get project

-- | [@GET /project?id=XXX@]: Get a project by id.
--
-- [@GET /project?name=XXX@]: Get a project by name.
type GetProjectAPI =
  "project"
    :> QueryParam "id" Text
    :> QueryParam "name" Text
    :> Verb 'GET 200 '[JSON] GetProjectResponse

-- | @GET /project@ response.
data GetProjectResponse
  = GetProjectResponseNotFound NotFound
  | GetProjectResponseUnauthorized Unauthorized
  | GetProjectResponseSuccess !Project
  deriving stock (GetProjectResponse -> GetProjectResponse -> Bool
(GetProjectResponse -> GetProjectResponse -> Bool)
-> (GetProjectResponse -> GetProjectResponse -> Bool)
-> Eq GetProjectResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetProjectResponse -> GetProjectResponse -> Bool
== :: GetProjectResponse -> GetProjectResponse -> Bool
$c/= :: GetProjectResponse -> GetProjectResponse -> Bool
/= :: GetProjectResponse -> GetProjectResponse -> Bool
Eq, Int -> GetProjectResponse -> ShowS
[GetProjectResponse] -> ShowS
GetProjectResponse -> String
(Int -> GetProjectResponse -> ShowS)
-> (GetProjectResponse -> String)
-> ([GetProjectResponse] -> ShowS)
-> Show GetProjectResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetProjectResponse -> ShowS
showsPrec :: Int -> GetProjectResponse -> ShowS
$cshow :: GetProjectResponse -> String
show :: GetProjectResponse -> String
$cshowList :: [GetProjectResponse] -> ShowS
showList :: [GetProjectResponse] -> ShowS
Show, (forall x. GetProjectResponse -> Rep GetProjectResponse x)
-> (forall x. Rep GetProjectResponse x -> GetProjectResponse)
-> Generic GetProjectResponse
forall x. Rep GetProjectResponse x -> GetProjectResponse
forall x. GetProjectResponse -> Rep GetProjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetProjectResponse -> Rep GetProjectResponse x
from :: forall x. GetProjectResponse -> Rep GetProjectResponse x
$cto :: forall x. Rep GetProjectResponse x -> GetProjectResponse
to :: forall x. Rep GetProjectResponse x -> GetProjectResponse
Generic)

instance FromJSON GetProjectResponse where
  parseJSON :: Value -> Parser GetProjectResponse
parseJSON =
    String
-> (Text -> Value -> Parser GetProjectResponse)
-> Value
-> Parser GetProjectResponse
forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
"GetProjectResponse" \Text
typ Value
val ->
      case Text
typ of
        Text
"not-found" -> NotFound -> GetProjectResponse
GetProjectResponseNotFound (NotFound -> GetProjectResponse)
-> Parser NotFound -> Parser GetProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"unauthorized" -> Unauthorized -> GetProjectResponse
GetProjectResponseUnauthorized (Unauthorized -> GetProjectResponse)
-> Parser Unauthorized -> Parser GetProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Unauthorized
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"success" -> Project -> GetProjectResponse
GetProjectResponseSuccess (Project -> GetProjectResponse)
-> Parser Project -> Parser GetProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Project
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
_ -> String -> Parser GetProjectResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack (Text
"unknown GetProjectResponse type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ))

instance ToJSON GetProjectResponse where
  toJSON :: GetProjectResponse -> Value
toJSON = \case
    GetProjectResponseNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    GetProjectResponseUnauthorized Unauthorized
unauthorized -> Text -> Value -> Value
toSumType Text
"unauthorized" (Unauthorized -> Value
forall a. ToJSON a => a -> Value
toJSON Unauthorized
unauthorized)
    GetProjectResponseSuccess Project
project -> Text -> Value -> Value
toSumType Text
"success" (Project -> Value
forall a. ToJSON a => a -> Value
toJSON Project
project)

------------------------------------------------------------------------------------------------------------------------
-- Create project

-- | [@POST /create-project@]: Create a project
type CreateProjectAPI =
  "create-project"
    :> ReqBody '[JSON] CreateProjectRequest
    :> Verb 'POST 200 '[JSON] CreateProjectResponse

-- | @POST /create-project@ request.
data CreateProjectRequest = CreateProjectRequest
  { CreateProjectRequest -> Text
projectName :: Text
  }
  deriving stock (CreateProjectRequest -> CreateProjectRequest -> Bool
(CreateProjectRequest -> CreateProjectRequest -> Bool)
-> (CreateProjectRequest -> CreateProjectRequest -> Bool)
-> Eq CreateProjectRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateProjectRequest -> CreateProjectRequest -> Bool
== :: CreateProjectRequest -> CreateProjectRequest -> Bool
$c/= :: CreateProjectRequest -> CreateProjectRequest -> Bool
/= :: CreateProjectRequest -> CreateProjectRequest -> Bool
Eq, Int -> CreateProjectRequest -> ShowS
[CreateProjectRequest] -> ShowS
CreateProjectRequest -> String
(Int -> CreateProjectRequest -> ShowS)
-> (CreateProjectRequest -> String)
-> ([CreateProjectRequest] -> ShowS)
-> Show CreateProjectRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateProjectRequest -> ShowS
showsPrec :: Int -> CreateProjectRequest -> ShowS
$cshow :: CreateProjectRequest -> String
show :: CreateProjectRequest -> String
$cshowList :: [CreateProjectRequest] -> ShowS
showList :: [CreateProjectRequest] -> ShowS
Show, (forall x. CreateProjectRequest -> Rep CreateProjectRequest x)
-> (forall x. Rep CreateProjectRequest x -> CreateProjectRequest)
-> Generic CreateProjectRequest
forall x. Rep CreateProjectRequest x -> CreateProjectRequest
forall x. CreateProjectRequest -> Rep CreateProjectRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateProjectRequest -> Rep CreateProjectRequest x
from :: forall x. CreateProjectRequest -> Rep CreateProjectRequest x
$cto :: forall x. Rep CreateProjectRequest x -> CreateProjectRequest
to :: forall x. Rep CreateProjectRequest x -> CreateProjectRequest
Generic)

instance FromJSON CreateProjectRequest where
  parseJSON :: Value -> Parser CreateProjectRequest
parseJSON =
    String
-> (Object -> Parser CreateProjectRequest)
-> Value
-> Parser CreateProjectRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateProjectRequest" \Object
o -> do
      Text
projectName <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-name"
      CreateProjectRequest -> Parser CreateProjectRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateProjectRequest {Text
$sel:projectName:CreateProjectRequest :: Text
projectName :: Text
..}

instance ToJSON CreateProjectRequest where
  toJSON :: CreateProjectRequest -> Value
toJSON (CreateProjectRequest Text
projectName) =
    [Pair] -> Value
object
      [ Key
"project-name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectName
      ]

-- | @POST /create-project@ response.
data CreateProjectResponse
  = CreateProjectResponseUnauthorized Unauthorized
  | CreateProjectResponseNotFound !NotFound
  | CreateProjectResponseSuccess !Project
  deriving stock (CreateProjectResponse -> CreateProjectResponse -> Bool
(CreateProjectResponse -> CreateProjectResponse -> Bool)
-> (CreateProjectResponse -> CreateProjectResponse -> Bool)
-> Eq CreateProjectResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateProjectResponse -> CreateProjectResponse -> Bool
== :: CreateProjectResponse -> CreateProjectResponse -> Bool
$c/= :: CreateProjectResponse -> CreateProjectResponse -> Bool
/= :: CreateProjectResponse -> CreateProjectResponse -> Bool
Eq, Int -> CreateProjectResponse -> ShowS
[CreateProjectResponse] -> ShowS
CreateProjectResponse -> String
(Int -> CreateProjectResponse -> ShowS)
-> (CreateProjectResponse -> String)
-> ([CreateProjectResponse] -> ShowS)
-> Show CreateProjectResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateProjectResponse -> ShowS
showsPrec :: Int -> CreateProjectResponse -> ShowS
$cshow :: CreateProjectResponse -> String
show :: CreateProjectResponse -> String
$cshowList :: [CreateProjectResponse] -> ShowS
showList :: [CreateProjectResponse] -> ShowS
Show, (forall x. CreateProjectResponse -> Rep CreateProjectResponse x)
-> (forall x. Rep CreateProjectResponse x -> CreateProjectResponse)
-> Generic CreateProjectResponse
forall x. Rep CreateProjectResponse x -> CreateProjectResponse
forall x. CreateProjectResponse -> Rep CreateProjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CreateProjectResponse -> Rep CreateProjectResponse x
from :: forall x. CreateProjectResponse -> Rep CreateProjectResponse x
$cto :: forall x. Rep CreateProjectResponse x -> CreateProjectResponse
to :: forall x. Rep CreateProjectResponse x -> CreateProjectResponse
Generic)

instance FromJSON CreateProjectResponse where
  parseJSON :: Value -> Parser CreateProjectResponse
parseJSON =
    String
-> (Text -> Value -> Parser CreateProjectResponse)
-> Value
-> Parser CreateProjectResponse
forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
"CreateProjectResponse" \Text
typ Value
val ->
      case Text
typ of
        Text
"not-found" -> NotFound -> CreateProjectResponse
CreateProjectResponseNotFound (NotFound -> CreateProjectResponse)
-> Parser NotFound -> Parser CreateProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"unauthorized" -> Unauthorized -> CreateProjectResponse
CreateProjectResponseUnauthorized (Unauthorized -> CreateProjectResponse)
-> Parser Unauthorized -> Parser CreateProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Unauthorized
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"success" -> Project -> CreateProjectResponse
CreateProjectResponseSuccess (Project -> CreateProjectResponse)
-> Parser Project -> Parser CreateProjectResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Project
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
_ -> String -> Parser CreateProjectResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack (Text
"unknown CreateProjectResponse type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ))

instance ToJSON CreateProjectResponse where
  toJSON :: CreateProjectResponse -> Value
toJSON = \case
    CreateProjectResponseNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    CreateProjectResponseUnauthorized Unauthorized
unauthorized -> Text -> Value -> Value
toSumType Text
"unauthorized" (Unauthorized -> Value
forall a. ToJSON a => a -> Value
toJSON Unauthorized
unauthorized)
    CreateProjectResponseSuccess Project
project -> Text -> Value -> Value
toSumType Text
"success" (Project -> Value
forall a. ToJSON a => a -> Value
toJSON Project
project)

------------------------------------------------------------------------------------------------------------------------
-- Get project branch

-- | [@GET /project-branch?projectId=XXX&branchId=YYY@]: Get a project branch by id.
--
-- [@GET /project-branch?projectId=XXX&branchName=YYY@]: Get a project branch by name.
type GetProjectBranchAPI =
  "project-branch"
    :> QueryParam' '[Required, Strict] "projectId" Text
    :> QueryParam "branchId" Text
    :> QueryParam "branchName" Text
    :> QueryFlag "includeSquashed" -- If set, include the squashed branch head in the response
    :> Verb 'GET 200 '[JSON] GetProjectBranchResponse

-- | @GET /project-branch@ response.
data GetProjectBranchResponse
  = GetProjectBranchResponseProjectNotFound NotFound
  | GetProjectBranchResponseBranchNotFound NotFound
  | GetProjectBranchResponseUnauthorized Unauthorized
  | GetProjectBranchResponseSuccess !ProjectBranch
  deriving stock (GetProjectBranchResponse -> GetProjectBranchResponse -> Bool
(GetProjectBranchResponse -> GetProjectBranchResponse -> Bool)
-> (GetProjectBranchResponse -> GetProjectBranchResponse -> Bool)
-> Eq GetProjectBranchResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetProjectBranchResponse -> GetProjectBranchResponse -> Bool
== :: GetProjectBranchResponse -> GetProjectBranchResponse -> Bool
$c/= :: GetProjectBranchResponse -> GetProjectBranchResponse -> Bool
/= :: GetProjectBranchResponse -> GetProjectBranchResponse -> Bool
Eq, Int -> GetProjectBranchResponse -> ShowS
[GetProjectBranchResponse] -> ShowS
GetProjectBranchResponse -> String
(Int -> GetProjectBranchResponse -> ShowS)
-> (GetProjectBranchResponse -> String)
-> ([GetProjectBranchResponse] -> ShowS)
-> Show GetProjectBranchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetProjectBranchResponse -> ShowS
showsPrec :: Int -> GetProjectBranchResponse -> ShowS
$cshow :: GetProjectBranchResponse -> String
show :: GetProjectBranchResponse -> String
$cshowList :: [GetProjectBranchResponse] -> ShowS
showList :: [GetProjectBranchResponse] -> ShowS
Show, (forall x.
 GetProjectBranchResponse -> Rep GetProjectBranchResponse x)
-> (forall x.
    Rep GetProjectBranchResponse x -> GetProjectBranchResponse)
-> Generic GetProjectBranchResponse
forall x.
Rep GetProjectBranchResponse x -> GetProjectBranchResponse
forall x.
GetProjectBranchResponse -> Rep GetProjectBranchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
GetProjectBranchResponse -> Rep GetProjectBranchResponse x
from :: forall x.
GetProjectBranchResponse -> Rep GetProjectBranchResponse x
$cto :: forall x.
Rep GetProjectBranchResponse x -> GetProjectBranchResponse
to :: forall x.
Rep GetProjectBranchResponse x -> GetProjectBranchResponse
Generic)

instance FromJSON GetProjectBranchResponse where
  parseJSON :: Value -> Parser GetProjectBranchResponse
parseJSON =
    String
-> (Text -> Value -> Parser GetProjectBranchResponse)
-> Value
-> Parser GetProjectBranchResponse
forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
"GetProjectBranchResponse" \Text
typ Value
val ->
      case Text
typ of
        Text
"project-not-found" -> NotFound -> GetProjectBranchResponse
GetProjectBranchResponseProjectNotFound (NotFound -> GetProjectBranchResponse)
-> Parser NotFound -> Parser GetProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"branch-not-found" -> NotFound -> GetProjectBranchResponse
GetProjectBranchResponseBranchNotFound (NotFound -> GetProjectBranchResponse)
-> Parser NotFound -> Parser GetProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"unauthorized" -> Unauthorized -> GetProjectBranchResponse
GetProjectBranchResponseUnauthorized (Unauthorized -> GetProjectBranchResponse)
-> Parser Unauthorized -> Parser GetProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Unauthorized
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"success" -> ProjectBranch -> GetProjectBranchResponse
GetProjectBranchResponseSuccess (ProjectBranch -> GetProjectBranchResponse)
-> Parser ProjectBranch -> Parser GetProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ProjectBranch
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
_ -> String -> Parser GetProjectBranchResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack (Text
"unknown GetProjectBranchResponse type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ))

instance ToJSON GetProjectBranchResponse where
  toJSON :: GetProjectBranchResponse -> Value
toJSON = \case
    GetProjectBranchResponseProjectNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"project-not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    GetProjectBranchResponseBranchNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"branch-not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    GetProjectBranchResponseUnauthorized Unauthorized
unauthorized -> Text -> Value -> Value
toSumType Text
"unauthorized" (Unauthorized -> Value
forall a. ToJSON a => a -> Value
toJSON Unauthorized
unauthorized)
    GetProjectBranchResponseSuccess ProjectBranch
branch -> Text -> Value -> Value
toSumType Text
"success" (ProjectBranch -> Value
forall a. ToJSON a => a -> Value
toJSON ProjectBranch
branch)

------------------------------------------------------------------------------------------------------------------------
-- Create project branch

-- | [@POST /create-project-branch@]: Create a project branch
type CreateProjectBranchAPI =
  "create-project-branch"
    :> ReqBody '[JSON] CreateProjectBranchRequest
    :> Verb 'POST 200 '[JSON] CreateProjectBranchResponse

-- | @POST /create-project-branch@ request.
data CreateProjectBranchRequest = CreateProjectBranchRequest
  { CreateProjectBranchRequest -> Text
projectId :: Text,
    CreateProjectBranchRequest -> Text
branchName :: Text,
    CreateProjectBranchRequest -> Hash32
branchCausalHash :: Hash32,
    CreateProjectBranchRequest -> Maybe ProjectBranchIds
branchMergeTarget :: Maybe ProjectBranchIds
  }
  deriving stock (CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool
(CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool)
-> (CreateProjectBranchRequest
    -> CreateProjectBranchRequest -> Bool)
-> Eq CreateProjectBranchRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool
== :: CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool
$c/= :: CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool
/= :: CreateProjectBranchRequest -> CreateProjectBranchRequest -> Bool
Eq, Int -> CreateProjectBranchRequest -> ShowS
[CreateProjectBranchRequest] -> ShowS
CreateProjectBranchRequest -> String
(Int -> CreateProjectBranchRequest -> ShowS)
-> (CreateProjectBranchRequest -> String)
-> ([CreateProjectBranchRequest] -> ShowS)
-> Show CreateProjectBranchRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateProjectBranchRequest -> ShowS
showsPrec :: Int -> CreateProjectBranchRequest -> ShowS
$cshow :: CreateProjectBranchRequest -> String
show :: CreateProjectBranchRequest -> String
$cshowList :: [CreateProjectBranchRequest] -> ShowS
showList :: [CreateProjectBranchRequest] -> ShowS
Show, (forall x.
 CreateProjectBranchRequest -> Rep CreateProjectBranchRequest x)
-> (forall x.
    Rep CreateProjectBranchRequest x -> CreateProjectBranchRequest)
-> Generic CreateProjectBranchRequest
forall x.
Rep CreateProjectBranchRequest x -> CreateProjectBranchRequest
forall x.
CreateProjectBranchRequest -> Rep CreateProjectBranchRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateProjectBranchRequest -> Rep CreateProjectBranchRequest x
from :: forall x.
CreateProjectBranchRequest -> Rep CreateProjectBranchRequest x
$cto :: forall x.
Rep CreateProjectBranchRequest x -> CreateProjectBranchRequest
to :: forall x.
Rep CreateProjectBranchRequest x -> CreateProjectBranchRequest
Generic)

instance FromJSON CreateProjectBranchRequest where
  parseJSON :: Value -> Parser CreateProjectBranchRequest
parseJSON =
    String
-> (Object -> Parser CreateProjectBranchRequest)
-> Value
-> Parser CreateProjectBranchRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateProjectBranchRequest" \Object
o -> do
      Text
projectId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-id"
      Text
branchName <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-name"
      Hash32
branchCausalHash <- Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-head"
      Maybe ProjectBranchIds
branchMergeTarget <- Object -> Key -> Parser (Maybe ProjectBranchIds)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseFieldMaybe' Object
o Key
"branch-merge-target"
      CreateProjectBranchRequest -> Parser CreateProjectBranchRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CreateProjectBranchRequest {Maybe ProjectBranchIds
Text
Hash32
$sel:projectId:CreateProjectBranchRequest :: Text
$sel:branchName:CreateProjectBranchRequest :: Text
$sel:branchCausalHash:CreateProjectBranchRequest :: Hash32
$sel:branchMergeTarget:CreateProjectBranchRequest :: Maybe ProjectBranchIds
projectId :: Text
branchName :: Text
branchCausalHash :: Hash32
branchMergeTarget :: Maybe ProjectBranchIds
..}

instance ToJSON CreateProjectBranchRequest where
  toJSON :: CreateProjectBranchRequest -> Value
toJSON (CreateProjectBranchRequest Text
projectId Text
branchName Hash32
branchCausalHash Maybe ProjectBranchIds
branchMergeTarget) =
    [Pair] -> [Endo Object] -> Value
objectWithMaybes
      [ Key
"project-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectId,
        Key
"branch-name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
branchName,
        Key
"branch-head" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
branchCausalHash
      ]
      [ Text
"branch-merge-target" Text -> Maybe ProjectBranchIds -> Endo Object
forall a. ToJSON a => Text -> Maybe a -> Endo Object
.=? Maybe ProjectBranchIds
branchMergeTarget
      ]

-- | @POST /create-project-branch@ response.
data CreateProjectBranchResponse
  = CreateProjectBranchResponseUnauthorized Unauthorized
  | CreateProjectBranchResponseNotFound NotFound
  | CreateProjectBranchResponseMissingCausalHash !Hash32
  | CreateProjectBranchResponseSuccess !ProjectBranch
  deriving stock (CreateProjectBranchResponse -> CreateProjectBranchResponse -> Bool
(CreateProjectBranchResponse
 -> CreateProjectBranchResponse -> Bool)
-> (CreateProjectBranchResponse
    -> CreateProjectBranchResponse -> Bool)
-> Eq CreateProjectBranchResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateProjectBranchResponse -> CreateProjectBranchResponse -> Bool
== :: CreateProjectBranchResponse -> CreateProjectBranchResponse -> Bool
$c/= :: CreateProjectBranchResponse -> CreateProjectBranchResponse -> Bool
/= :: CreateProjectBranchResponse -> CreateProjectBranchResponse -> Bool
Eq, Int -> CreateProjectBranchResponse -> ShowS
[CreateProjectBranchResponse] -> ShowS
CreateProjectBranchResponse -> String
(Int -> CreateProjectBranchResponse -> ShowS)
-> (CreateProjectBranchResponse -> String)
-> ([CreateProjectBranchResponse] -> ShowS)
-> Show CreateProjectBranchResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateProjectBranchResponse -> ShowS
showsPrec :: Int -> CreateProjectBranchResponse -> ShowS
$cshow :: CreateProjectBranchResponse -> String
show :: CreateProjectBranchResponse -> String
$cshowList :: [CreateProjectBranchResponse] -> ShowS
showList :: [CreateProjectBranchResponse] -> ShowS
Show, (forall x.
 CreateProjectBranchResponse -> Rep CreateProjectBranchResponse x)
-> (forall x.
    Rep CreateProjectBranchResponse x -> CreateProjectBranchResponse)
-> Generic CreateProjectBranchResponse
forall x.
Rep CreateProjectBranchResponse x -> CreateProjectBranchResponse
forall x.
CreateProjectBranchResponse -> Rep CreateProjectBranchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CreateProjectBranchResponse -> Rep CreateProjectBranchResponse x
from :: forall x.
CreateProjectBranchResponse -> Rep CreateProjectBranchResponse x
$cto :: forall x.
Rep CreateProjectBranchResponse x -> CreateProjectBranchResponse
to :: forall x.
Rep CreateProjectBranchResponse x -> CreateProjectBranchResponse
Generic)

instance FromJSON CreateProjectBranchResponse where
  parseJSON :: Value -> Parser CreateProjectBranchResponse
parseJSON =
    String
-> (Text -> Value -> Parser CreateProjectBranchResponse)
-> Value
-> Parser CreateProjectBranchResponse
forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
"CreateProjectBranchResponse" \Text
typ Value
val ->
      case Text
typ of
        Text
"unauthorized" -> Unauthorized -> CreateProjectBranchResponse
CreateProjectBranchResponseUnauthorized (Unauthorized -> CreateProjectBranchResponse)
-> Parser Unauthorized -> Parser CreateProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Unauthorized
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"missing-causal-hash" ->
          Value
val Value
-> (Value -> Parser CreateProjectBranchResponse)
-> Parser CreateProjectBranchResponse
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser CreateProjectBranchResponse)
-> Value
-> Parser CreateProjectBranchResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"CreateProjectBranchResponseMissingCausalHash" \Object
obj ->
            Hash32 -> CreateProjectBranchResponse
CreateProjectBranchResponseMissingCausalHash (Hash32 -> CreateProjectBranchResponse)
-> Parser Hash32 -> Parser CreateProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"causalHash"
        Text
"not-found" -> NotFound -> CreateProjectBranchResponse
CreateProjectBranchResponseNotFound (NotFound -> CreateProjectBranchResponse)
-> Parser NotFound -> Parser CreateProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"success" -> ProjectBranch -> CreateProjectBranchResponse
CreateProjectBranchResponseSuccess (ProjectBranch -> CreateProjectBranchResponse)
-> Parser ProjectBranch -> Parser CreateProjectBranchResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ProjectBranch
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
_ -> String -> Parser CreateProjectBranchResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack (Text
"unknown CreateProjectBranchResponse type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ))

instance ToJSON CreateProjectBranchResponse where
  toJSON :: CreateProjectBranchResponse -> Value
toJSON = \case
    CreateProjectBranchResponseUnauthorized Unauthorized
unauthorized -> Text -> Value -> Value
toSumType Text
"unauthorized" (Unauthorized -> Value
forall a. ToJSON a => a -> Value
toJSON Unauthorized
unauthorized)
    CreateProjectBranchResponseNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    CreateProjectBranchResponseMissingCausalHash Hash32
hash -> Text -> Value -> Value
toSumType Text
"missing-causal-hash" ([Pair] -> Value
object [Key
"causalHash" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
hash])
    CreateProjectBranchResponseSuccess ProjectBranch
branch -> Text -> Value -> Value
toSumType Text
"success" (ProjectBranch -> Value
forall a. ToJSON a => a -> Value
toJSON ProjectBranch
branch)

------------------------------------------------------------------------------------------------------------------------
-- Set project branch head

-- | [@POST /set-project-branch-head@]: Make a project branch point at an already-uploaded causal
type SetProjectBranchHeadAPI =
  "set-project-branch-head"
    :> ReqBody '[JSON] SetProjectBranchHeadRequest
    :> Verb 'POST 200 '[JSON] SetProjectBranchHeadResponse

-- | @POST /set-project-branch-head@ request.
data SetProjectBranchHeadRequest = SetProjectBranchHeadRequest
  { SetProjectBranchHeadRequest -> Text
projectId :: Text,
    SetProjectBranchHeadRequest -> Text
branchId :: Text,
    -- | If @Nothing@, just set (force-push semantics). If @Just@, check-and-set (push-with-lease).
    SetProjectBranchHeadRequest -> Maybe Hash32
branchOldCausalHash :: Maybe Hash32,
    SetProjectBranchHeadRequest -> Hash32
branchNewCausalHash :: Hash32
  }
  deriving stock (SetProjectBranchHeadRequest -> SetProjectBranchHeadRequest -> Bool
(SetProjectBranchHeadRequest
 -> SetProjectBranchHeadRequest -> Bool)
-> (SetProjectBranchHeadRequest
    -> SetProjectBranchHeadRequest -> Bool)
-> Eq SetProjectBranchHeadRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetProjectBranchHeadRequest -> SetProjectBranchHeadRequest -> Bool
== :: SetProjectBranchHeadRequest -> SetProjectBranchHeadRequest -> Bool
$c/= :: SetProjectBranchHeadRequest -> SetProjectBranchHeadRequest -> Bool
/= :: SetProjectBranchHeadRequest -> SetProjectBranchHeadRequest -> Bool
Eq, Int -> SetProjectBranchHeadRequest -> ShowS
[SetProjectBranchHeadRequest] -> ShowS
SetProjectBranchHeadRequest -> String
(Int -> SetProjectBranchHeadRequest -> ShowS)
-> (SetProjectBranchHeadRequest -> String)
-> ([SetProjectBranchHeadRequest] -> ShowS)
-> Show SetProjectBranchHeadRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetProjectBranchHeadRequest -> ShowS
showsPrec :: Int -> SetProjectBranchHeadRequest -> ShowS
$cshow :: SetProjectBranchHeadRequest -> String
show :: SetProjectBranchHeadRequest -> String
$cshowList :: [SetProjectBranchHeadRequest] -> ShowS
showList :: [SetProjectBranchHeadRequest] -> ShowS
Show, (forall x.
 SetProjectBranchHeadRequest -> Rep SetProjectBranchHeadRequest x)
-> (forall x.
    Rep SetProjectBranchHeadRequest x -> SetProjectBranchHeadRequest)
-> Generic SetProjectBranchHeadRequest
forall x.
Rep SetProjectBranchHeadRequest x -> SetProjectBranchHeadRequest
forall x.
SetProjectBranchHeadRequest -> Rep SetProjectBranchHeadRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SetProjectBranchHeadRequest -> Rep SetProjectBranchHeadRequest x
from :: forall x.
SetProjectBranchHeadRequest -> Rep SetProjectBranchHeadRequest x
$cto :: forall x.
Rep SetProjectBranchHeadRequest x -> SetProjectBranchHeadRequest
to :: forall x.
Rep SetProjectBranchHeadRequest x -> SetProjectBranchHeadRequest
Generic)

instance FromJSON SetProjectBranchHeadRequest where
  parseJSON :: Value -> Parser SetProjectBranchHeadRequest
parseJSON =
    String
-> (Object -> Parser SetProjectBranchHeadRequest)
-> Value
-> Parser SetProjectBranchHeadRequest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetProjectBranchHeadRequest" \Object
o -> do
      Text
projectId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-id"
      Text
branchId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-id"
      Maybe Hash32
branchOldCausalHash <- Object -> Key -> Parser (Maybe Hash32)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
parseFieldMaybe' Object
o Key
"branch-old-head"
      Hash32
branchNewCausalHash <- Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-new-head"
      SetProjectBranchHeadRequest -> Parser SetProjectBranchHeadRequest
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SetProjectBranchHeadRequest {Maybe Hash32
Text
Hash32
$sel:projectId:SetProjectBranchHeadRequest :: Text
$sel:branchId:SetProjectBranchHeadRequest :: Text
$sel:branchOldCausalHash:SetProjectBranchHeadRequest :: Maybe Hash32
$sel:branchNewCausalHash:SetProjectBranchHeadRequest :: Hash32
projectId :: Text
branchId :: Text
branchOldCausalHash :: Maybe Hash32
branchNewCausalHash :: Hash32
..}

instance ToJSON SetProjectBranchHeadRequest where
  toJSON :: SetProjectBranchHeadRequest -> Value
toJSON (SetProjectBranchHeadRequest Text
projectId Text
branchId Maybe Hash32
branchOldCausalHash Hash32
branchNewCausalHash) =
    [Pair] -> [Endo Object] -> Value
objectWithMaybes
      [ Key
"project-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectId,
        Key
"branch-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
branchId,
        Key
"branch-new-head" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
branchNewCausalHash
      ]
      [Text
"branch-old-head" Text -> Maybe Hash32 -> Endo Object
forall a. ToJSON a => Text -> Maybe a -> Endo Object
.=? Maybe Hash32
branchOldCausalHash]

-- | @POST /set-project-branch-hash@ response.
data SetProjectBranchHeadResponse
  = SetProjectBranchHeadResponseUnauthorized Unauthorized
  | SetProjectBranchHeadResponseNotFound NotFound
  | SetProjectBranchHeadResponseMissingCausalHash !Hash32
  | -- | (expected, actual)
    SetProjectBranchHeadResponseExpectedCausalHashMismatch !Hash32 !Hash32
  | SetProjectBranchHeadResponsePublishedReleaseIsImmutable
  | SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable
  | SetProjectBranchHeadResponseSuccess
  deriving stock (SetProjectBranchHeadResponse
-> SetProjectBranchHeadResponse -> Bool
(SetProjectBranchHeadResponse
 -> SetProjectBranchHeadResponse -> Bool)
-> (SetProjectBranchHeadResponse
    -> SetProjectBranchHeadResponse -> Bool)
-> Eq SetProjectBranchHeadResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetProjectBranchHeadResponse
-> SetProjectBranchHeadResponse -> Bool
== :: SetProjectBranchHeadResponse
-> SetProjectBranchHeadResponse -> Bool
$c/= :: SetProjectBranchHeadResponse
-> SetProjectBranchHeadResponse -> Bool
/= :: SetProjectBranchHeadResponse
-> SetProjectBranchHeadResponse -> Bool
Eq, Int -> SetProjectBranchHeadResponse -> ShowS
[SetProjectBranchHeadResponse] -> ShowS
SetProjectBranchHeadResponse -> String
(Int -> SetProjectBranchHeadResponse -> ShowS)
-> (SetProjectBranchHeadResponse -> String)
-> ([SetProjectBranchHeadResponse] -> ShowS)
-> Show SetProjectBranchHeadResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetProjectBranchHeadResponse -> ShowS
showsPrec :: Int -> SetProjectBranchHeadResponse -> ShowS
$cshow :: SetProjectBranchHeadResponse -> String
show :: SetProjectBranchHeadResponse -> String
$cshowList :: [SetProjectBranchHeadResponse] -> ShowS
showList :: [SetProjectBranchHeadResponse] -> ShowS
Show, (forall x.
 SetProjectBranchHeadResponse -> Rep SetProjectBranchHeadResponse x)
-> (forall x.
    Rep SetProjectBranchHeadResponse x -> SetProjectBranchHeadResponse)
-> Generic SetProjectBranchHeadResponse
forall x.
Rep SetProjectBranchHeadResponse x -> SetProjectBranchHeadResponse
forall x.
SetProjectBranchHeadResponse -> Rep SetProjectBranchHeadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
SetProjectBranchHeadResponse -> Rep SetProjectBranchHeadResponse x
from :: forall x.
SetProjectBranchHeadResponse -> Rep SetProjectBranchHeadResponse x
$cto :: forall x.
Rep SetProjectBranchHeadResponse x -> SetProjectBranchHeadResponse
to :: forall x.
Rep SetProjectBranchHeadResponse x -> SetProjectBranchHeadResponse
Generic)

instance FromJSON SetProjectBranchHeadResponse where
  parseJSON :: Value -> Parser SetProjectBranchHeadResponse
parseJSON =
    String
-> (Text -> Value -> Parser SetProjectBranchHeadResponse)
-> Value
-> Parser SetProjectBranchHeadResponse
forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
"SetProjectBranchHeadResponse" \Text
typ Value
val ->
      case Text
typ of
        Text
"unauthorized" -> Unauthorized -> SetProjectBranchHeadResponse
SetProjectBranchHeadResponseUnauthorized (Unauthorized -> SetProjectBranchHeadResponse)
-> Parser Unauthorized -> Parser SetProjectBranchHeadResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Unauthorized
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"not-found" -> NotFound -> SetProjectBranchHeadResponse
SetProjectBranchHeadResponseNotFound (NotFound -> SetProjectBranchHeadResponse)
-> Parser NotFound -> Parser SetProjectBranchHeadResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotFound
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
        Text
"missing-causal-hash" ->
          Value
val Value
-> (Value -> Parser SetProjectBranchHeadResponse)
-> Parser SetProjectBranchHeadResponse
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser SetProjectBranchHeadResponse)
-> Value
-> Parser SetProjectBranchHeadResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetProjectBranchHeadResponseMissingCausalHash" \Object
obj -> do
            Hash32 -> SetProjectBranchHeadResponse
SetProjectBranchHeadResponseMissingCausalHash (Hash32 -> SetProjectBranchHeadResponse)
-> Parser Hash32 -> Parser SetProjectBranchHeadResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"causalHash")
        Text
"expected-causal-hash-mismatch" ->
          Value
val Value
-> (Value -> Parser SetProjectBranchHeadResponse)
-> Parser SetProjectBranchHeadResponse
forall a b. a -> (a -> b) -> b
& String
-> (Object -> Parser SetProjectBranchHeadResponse)
-> Value
-> Parser SetProjectBranchHeadResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SetProjectBranchHeadResponseExpectedCausalHashMismatch" \Object
obj -> do
            Hash32
expected <- Object
obj Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expected"
            Hash32
actual <- Object
obj Object -> Key -> Parser Hash32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"actual"
            SetProjectBranchHeadResponse -> Parser SetProjectBranchHeadResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash32 -> Hash32 -> SetProjectBranchHeadResponse
SetProjectBranchHeadResponseExpectedCausalHashMismatch Hash32
expected Hash32
actual)
        Text
"success" -> SetProjectBranchHeadResponse -> Parser SetProjectBranchHeadResponse
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SetProjectBranchHeadResponse
SetProjectBranchHeadResponseSuccess
        Text
_ -> String -> Parser SetProjectBranchHeadResponse
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack (Text
"unknown SetProjectBranchHeadResponse type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
typ))

instance ToJSON SetProjectBranchHeadResponse where
  toJSON :: SetProjectBranchHeadResponse -> Value
toJSON = \case
    SetProjectBranchHeadResponseUnauthorized Unauthorized
unauthorized -> Text -> Value -> Value
toSumType Text
"unauthorized" (Unauthorized -> Value
forall a. ToJSON a => a -> Value
toJSON Unauthorized
unauthorized)
    SetProjectBranchHeadResponseMissingCausalHash Hash32
ch -> Text -> Value -> Value
toSumType Text
"missing-causal-hash" ([Pair] -> Value
object [Key
"causalHash" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
ch])
    SetProjectBranchHeadResponseExpectedCausalHashMismatch Hash32
expected Hash32
actual ->
      Text -> Value -> Value
toSumType Text
"expected-causal-hash-mismatch" ([Pair] -> Value
object [Key
"expected" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
expected, Key
"actual" Key -> Hash32 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Hash32
actual])
    SetProjectBranchHeadResponseNotFound NotFound
notFound -> Text -> Value -> Value
toSumType Text
"not-found" (NotFound -> Value
forall a. ToJSON a => a -> Value
toJSON NotFound
notFound)
    SetProjectBranchHeadResponse
SetProjectBranchHeadResponsePublishedReleaseIsImmutable -> Text -> Value -> Value
toSumType Text
"published-release-is-immutable" ([Pair] -> Value
object [])
    SetProjectBranchHeadResponse
SetProjectBranchHeadResponseDeprecatedReleaseIsImmutable -> Text -> Value -> Value
toSumType Text
"deprecated-release-is-immutable" ([Pair] -> Value
object [])
    SetProjectBranchHeadResponse
SetProjectBranchHeadResponseSuccess -> Text -> Value -> Value
toSumType Text
"success" ([Pair] -> Value
object [])

------------------------------------------------------------------------------------------------------------------------
-- Types

-- | A sem-ver release version without a user, project, or "releases/" prefix.
-- E.g. "1.2.3"
type ReleaseVersion = Text

-- | A project branch name segment.
-- Does not contain a project or contributor segment.
--
-- E.g. "main"
type BranchName = Text

-- | A project.
data Project = Project
  { Project -> Text
projectId :: Text,
    Project -> Text
projectName :: Text,
    Project -> Maybe Text
latestRelease :: Maybe ReleaseVersion,
    Project -> Maybe Text
defaultBranch :: Maybe BranchName
  }
  deriving stock (Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
/= :: Project -> Project -> Bool
Eq, Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Project -> ShowS
showsPrec :: Int -> Project -> ShowS
$cshow :: Project -> String
show :: Project -> String
$cshowList :: [Project] -> ShowS
showList :: [Project] -> ShowS
Show, (forall x. Project -> Rep Project x)
-> (forall x. Rep Project x -> Project) -> Generic Project
forall x. Rep Project x -> Project
forall x. Project -> Rep Project x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Project -> Rep Project x
from :: forall x. Project -> Rep Project x
$cto :: forall x. Rep Project x -> Project
to :: forall x. Rep Project x -> Project
Generic)

instance FromJSON Project where
  parseJSON :: Value -> Parser Project
parseJSON =
    String -> (Object -> Parser Project) -> Value -> Parser Project
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Project" \Object
o -> do
      Text
projectId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-id"
      Text
projectName <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-name"
      Maybe Text
latestRelease <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"latest-release"
      Maybe Text
defaultBranch <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default-branch"
      Project -> Parser Project
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Project {Maybe Text
Text
$sel:projectId:Project :: Text
$sel:projectName:Project :: Text
$sel:latestRelease:Project :: Maybe Text
$sel:defaultBranch:Project :: Maybe Text
projectId :: Text
projectName :: Text
latestRelease :: Maybe Text
defaultBranch :: Maybe Text
..}

instance ToJSON Project where
  toJSON :: Project -> Value
toJSON (Project Text
projectId Text
projectName Maybe Text
latestRelease Maybe Text
defaultBranch) =
    [Pair] -> Value
object
      [ Key
"project-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectId,
        Key
"project-name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectName,
        Key
"latest-release" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
latestRelease,
        Key
"default-branch" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
defaultBranch
      ]

-- | A project branch.
data ProjectBranch = ProjectBranch
  { ProjectBranch -> Text
projectId :: Text,
    ProjectBranch -> Text
projectName :: Text,
    ProjectBranch -> Text
branchId :: Text,
    ProjectBranch -> Text
branchName :: Text,
    ProjectBranch -> HashJWT
branchHead :: HashJWT,
    ProjectBranch -> Maybe HashJWT
squashedBranchHead :: Maybe HashJWT
  }
  deriving stock (ProjectBranch -> ProjectBranch -> Bool
(ProjectBranch -> ProjectBranch -> Bool)
-> (ProjectBranch -> ProjectBranch -> Bool) -> Eq ProjectBranch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectBranch -> ProjectBranch -> Bool
== :: ProjectBranch -> ProjectBranch -> Bool
$c/= :: ProjectBranch -> ProjectBranch -> Bool
/= :: ProjectBranch -> ProjectBranch -> Bool
Eq, Int -> ProjectBranch -> ShowS
[ProjectBranch] -> ShowS
ProjectBranch -> String
(Int -> ProjectBranch -> ShowS)
-> (ProjectBranch -> String)
-> ([ProjectBranch] -> ShowS)
-> Show ProjectBranch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectBranch -> ShowS
showsPrec :: Int -> ProjectBranch -> ShowS
$cshow :: ProjectBranch -> String
show :: ProjectBranch -> String
$cshowList :: [ProjectBranch] -> ShowS
showList :: [ProjectBranch] -> ShowS
Show, (forall x. ProjectBranch -> Rep ProjectBranch x)
-> (forall x. Rep ProjectBranch x -> ProjectBranch)
-> Generic ProjectBranch
forall x. Rep ProjectBranch x -> ProjectBranch
forall x. ProjectBranch -> Rep ProjectBranch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectBranch -> Rep ProjectBranch x
from :: forall x. ProjectBranch -> Rep ProjectBranch x
$cto :: forall x. Rep ProjectBranch x -> ProjectBranch
to :: forall x. Rep ProjectBranch x -> ProjectBranch
Generic)

instance FromJSON ProjectBranch where
  parseJSON :: Value -> Parser ProjectBranch
parseJSON =
    String
-> (Object -> Parser ProjectBranch)
-> Value
-> Parser ProjectBranch
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectBranch" \Object
o -> do
      Text
projectId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-id"
      Text
projectName <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-name"
      Text
branchId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-id"
      Text
branchName <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-name"
      HashJWT
branchHead <- Object -> Key -> Parser HashJWT
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-head"
      Maybe HashJWT
squashedBranchHead <- Object
o Object -> Key -> Parser (Maybe HashJWT)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"squashed-branch-head"
      ProjectBranch -> Parser ProjectBranch
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranch {Maybe HashJWT
Text
HashJWT
$sel:projectId:ProjectBranch :: Text
$sel:projectName:ProjectBranch :: Text
$sel:branchId:ProjectBranch :: Text
$sel:branchName:ProjectBranch :: Text
$sel:branchHead:ProjectBranch :: HashJWT
$sel:squashedBranchHead:ProjectBranch :: Maybe HashJWT
projectId :: Text
projectName :: Text
branchId :: Text
branchName :: Text
branchHead :: HashJWT
squashedBranchHead :: Maybe HashJWT
..}

instance ToJSON ProjectBranch where
  toJSON :: ProjectBranch -> Value
toJSON (ProjectBranch Text
projectId Text
projectName Text
branchId Text
branchName HashJWT
branchHead Maybe HashJWT
squashedBranchHead) =
    [Pair] -> Value
object
      [ Key
"project-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectId,
        Key
"project-name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectName,
        Key
"branch-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
branchId,
        Key
"branch-name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
branchName,
        Key
"branch-head" Key -> HashJWT -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= HashJWT
branchHead,
        Key
"squashed-branch-head" Key -> Maybe HashJWT -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe HashJWT
squashedBranchHead
      ]

-- | A project id and branch id.
data ProjectBranchIds = ProjectBranchIds
  { ProjectBranchIds -> Text
projectId :: Text,
    ProjectBranchIds -> Text
branchId :: Text
  }
  deriving stock (ProjectBranchIds -> ProjectBranchIds -> Bool
(ProjectBranchIds -> ProjectBranchIds -> Bool)
-> (ProjectBranchIds -> ProjectBranchIds -> Bool)
-> Eq ProjectBranchIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectBranchIds -> ProjectBranchIds -> Bool
== :: ProjectBranchIds -> ProjectBranchIds -> Bool
$c/= :: ProjectBranchIds -> ProjectBranchIds -> Bool
/= :: ProjectBranchIds -> ProjectBranchIds -> Bool
Eq, Int -> ProjectBranchIds -> ShowS
[ProjectBranchIds] -> ShowS
ProjectBranchIds -> String
(Int -> ProjectBranchIds -> ShowS)
-> (ProjectBranchIds -> String)
-> ([ProjectBranchIds] -> ShowS)
-> Show ProjectBranchIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectBranchIds -> ShowS
showsPrec :: Int -> ProjectBranchIds -> ShowS
$cshow :: ProjectBranchIds -> String
show :: ProjectBranchIds -> String
$cshowList :: [ProjectBranchIds] -> ShowS
showList :: [ProjectBranchIds] -> ShowS
Show, (forall x. ProjectBranchIds -> Rep ProjectBranchIds x)
-> (forall x. Rep ProjectBranchIds x -> ProjectBranchIds)
-> Generic ProjectBranchIds
forall x. Rep ProjectBranchIds x -> ProjectBranchIds
forall x. ProjectBranchIds -> Rep ProjectBranchIds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectBranchIds -> Rep ProjectBranchIds x
from :: forall x. ProjectBranchIds -> Rep ProjectBranchIds x
$cto :: forall x. Rep ProjectBranchIds x -> ProjectBranchIds
to :: forall x. Rep ProjectBranchIds x -> ProjectBranchIds
Generic)

instance FromJSON ProjectBranchIds where
  parseJSON :: Value -> Parser ProjectBranchIds
parseJSON =
    String
-> (Object -> Parser ProjectBranchIds)
-> Value
-> Parser ProjectBranchIds
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProjectBranchIds" \Object
o -> do
      Text
projectId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"project-id"
      Text
branchId <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"branch-id"
      ProjectBranchIds -> Parser ProjectBranchIds
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectBranchIds {Text
$sel:projectId:ProjectBranchIds :: Text
$sel:branchId:ProjectBranchIds :: Text
projectId :: Text
branchId :: Text
..}

instance ToJSON ProjectBranchIds where
  toJSON :: ProjectBranchIds -> Value
toJSON (ProjectBranchIds Text
projectId Text
branchId) =
    [Pair] -> Value
object
      [ Key
"project-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
projectId,
        Key
"branch-id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
branchId
      ]

data NotFound = NotFound {NotFound -> Text
message :: Text}
  deriving stock (NotFound -> NotFound -> Bool
(NotFound -> NotFound -> Bool)
-> (NotFound -> NotFound -> Bool) -> Eq NotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotFound -> NotFound -> Bool
== :: NotFound -> NotFound -> Bool
$c/= :: NotFound -> NotFound -> Bool
/= :: NotFound -> NotFound -> Bool
Eq, Int -> NotFound -> ShowS
[NotFound] -> ShowS
NotFound -> String
(Int -> NotFound -> ShowS)
-> (NotFound -> String) -> ([NotFound] -> ShowS) -> Show NotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotFound -> ShowS
showsPrec :: Int -> NotFound -> ShowS
$cshow :: NotFound -> String
show :: NotFound -> String
$cshowList :: [NotFound] -> ShowS
showList :: [NotFound] -> ShowS
Show, (forall x. NotFound -> Rep NotFound x)
-> (forall x. Rep NotFound x -> NotFound) -> Generic NotFound
forall x. Rep NotFound x -> NotFound
forall x. NotFound -> Rep NotFound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NotFound -> Rep NotFound x
from :: forall x. NotFound -> Rep NotFound x
$cto :: forall x. Rep NotFound x -> NotFound
to :: forall x. Rep NotFound x -> NotFound
Generic)

instance ToJSON NotFound where
  toJSON :: NotFound -> Value
toJSON (NotFound Text
message) = [Pair] -> Value
object [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
message]

instance FromJSON NotFound where
  parseJSON :: Value -> Parser NotFound
parseJSON =
    String -> (Object -> Parser NotFound) -> Value -> Parser NotFound
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NotFound" \Object
o -> do
      Text
message <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"message"
      NotFound -> Parser NotFound
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NotFound {Text
$sel:message:NotFound :: Text
message :: Text
..}

data Unauthorized = Unauthorized {Unauthorized -> Text
message :: Text}
  deriving stock (Unauthorized -> Unauthorized -> Bool
(Unauthorized -> Unauthorized -> Bool)
-> (Unauthorized -> Unauthorized -> Bool) -> Eq Unauthorized
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unauthorized -> Unauthorized -> Bool
== :: Unauthorized -> Unauthorized -> Bool
$c/= :: Unauthorized -> Unauthorized -> Bool
/= :: Unauthorized -> Unauthorized -> Bool
Eq, Int -> Unauthorized -> ShowS
[Unauthorized] -> ShowS
Unauthorized -> String
(Int -> Unauthorized -> ShowS)
-> (Unauthorized -> String)
-> ([Unauthorized] -> ShowS)
-> Show Unauthorized
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unauthorized -> ShowS
showsPrec :: Int -> Unauthorized -> ShowS
$cshow :: Unauthorized -> String
show :: Unauthorized -> String
$cshowList :: [Unauthorized] -> ShowS
showList :: [Unauthorized] -> ShowS
Show, (forall x. Unauthorized -> Rep Unauthorized x)
-> (forall x. Rep Unauthorized x -> Unauthorized)
-> Generic Unauthorized
forall x. Rep Unauthorized x -> Unauthorized
forall x. Unauthorized -> Rep Unauthorized x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Unauthorized -> Rep Unauthorized x
from :: forall x. Unauthorized -> Rep Unauthorized x
$cto :: forall x. Rep Unauthorized x -> Unauthorized
to :: forall x. Rep Unauthorized x -> Unauthorized
Generic)

instance ToJSON Unauthorized where
  toJSON :: Unauthorized -> Value
toJSON (Unauthorized Text
message) = [Pair] -> Value
object [Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
message]

instance FromJSON Unauthorized where
  parseJSON :: Value -> Parser Unauthorized
parseJSON =
    String
-> (Object -> Parser Unauthorized) -> Value -> Parser Unauthorized
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Unauthorized" \Object
o -> do
      Text
message <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"message"
      Unauthorized -> Parser Unauthorized
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Unauthorized {Text
$sel:message:Unauthorized :: Text
message :: Text
..}

------------------------------------------------------------------------------------------------------------------------
-- Aeson helpers. These could be extracted to a different module or package.

-- | Like 'object', but takes a second list of pairs whose values are Maybes; Nothing values' keys are not put into the
-- object at all.
--
-- For example, the Haskell value
--
-- @
-- Foo
--   { bar = 5
--   , qux = Nothing
--   }
-- @
--
-- would be serialized as the JSON
--
-- @
-- { "bar" = 5 }
-- @
--
-- using this combinator.
objectWithMaybes :: [Pair] -> [Endo Object] -> Value
objectWithMaybes :: [Pair] -> [Endo Object] -> Value
objectWithMaybes [Pair]
nonMaybeFields [Endo Object]
maybeFields =
  Object -> Value
Object (Endo Object -> Object -> Object
forall a. Endo a -> a -> a
appEndo ([Endo Object] -> Endo Object
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Endo Object]
maybeFields) ([Pair] -> Object
forall v. [(Key, v)] -> KeyMap v
Aeson.KeyMap.fromList [Pair]
nonMaybeFields))

-- | Like ('.='), but omits the key/value pair if the value is Nothing.
(.=?) :: (ToJSON a) => Text -> Maybe a -> Endo Object
Text
k .=? :: forall a. ToJSON a => Text -> Maybe a -> Endo Object
.=? Maybe a
mv =
  case Maybe a
mv of
    Maybe a
Nothing -> Endo Object
forall a. Monoid a => a
mempty
    Just a
v -> (Object -> Object) -> Endo Object
forall a. (a -> a) -> Endo a
Endo (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.KeyMap.insert (Text -> Key
Aeson.Key.fromText Text
k) (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v))

toSumType :: Text -> Value -> Value
toSumType :: Text -> Value -> Value
toSumType Text
typ Value
payload =
  [Pair] -> Value
object [Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
typ, Key
"payload" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Value
payload]

withSumType :: String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType :: forall a.
String -> (Text -> Value -> Parser a) -> Value -> Parser a
withSumType String
name Text -> Value -> Parser a
k =
  String -> (Object -> Parser a) -> Value -> Parser a
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
name \Object
o -> do
    Text
typ <- Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"type"
    Value
val <- Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
parseField Object
o Key
"payload"
    Text -> Value -> Parser a
k Text
typ Value
val