{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Server.Orphans where

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Codec.Serialise (Serialise (..))
import Codec.Serialise qualified as CBOR
import Codec.Serialise.Class qualified as CBOR
import Control.Lens
import Data.Aeson
import Data.Aeson qualified as Aeson
import Data.Binary
import Data.ByteString.Short (ShortByteString)
import Data.List.NonEmpty (NonEmpty (..))
import Data.OpenApi
import Data.Proxy
import Data.Text qualified as Text
import Data.Vector (Vector)
import Data.Vector qualified as Vector
import Servant
import Servant.Docs (DocCapture (DocCapture), DocQueryParam (..), ParamKind (..), ToCapture (..), ToParam (..))
import U.Codebase.HashTags
import U.Codebase.Sqlite.Branch.Format qualified as BranchFormat
import U.Codebase.Sqlite.Causal qualified as SqliteCausal
import U.Codebase.Sqlite.Decl.Format qualified as DeclFormat
import U.Codebase.Sqlite.Entity qualified as Entity
import U.Codebase.Sqlite.LocalIds qualified as LocalIds
import U.Codebase.Sqlite.Patch.Format qualified as PatchFormat
import U.Codebase.Sqlite.TempEntity (TempEntity)
import U.Codebase.Sqlite.Term.Format qualified as TermFormat
import U.Util.Base32Hex (Base32Hex (..))
import Unison.Codebase.Editor.DisplayObject
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.ShortCausalHash (ShortCausalHash (..))
import Unison.Codebase.ShortCausalHash qualified as SCH
import Unison.ConstructorType (ConstructorType)
import Unison.ConstructorType qualified as CT
import Unison.Core.Project (ProjectBranchName (..), ProjectName (..))
import Unison.Hash (Hash (..))
import Unison.Hash qualified as Hash
import Unison.Hash32 (Hash32 (..))
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.Prelude
import Unison.Project
import Unison.Reference qualified as Reference
import Unison.Referent qualified as Referent
import Unison.Share.API.Hash (HashJWT (..))
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as SH
import Unison.Sqlite qualified as Sqlite
import Unison.Syntax.HashQualified qualified as HQ (parseText)
import Unison.Syntax.HashQualifiedPrime qualified as HQ' (parseText)
import Unison.Syntax.Name qualified as Name (parseTextEither, toText)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Util.Pretty (Width (..))

instance ToJSON Hash where
  toJSON :: Hash -> Value
toJSON Hash
h = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Hash -> Text
Hash.toBase32HexText Hash
h

instance FromJSON Hash where
  parseJSON :: Value -> Parser Hash
parseJSON = String -> (Text -> Parser Hash) -> Value -> Parser Hash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Hash" ((Text -> Parser Hash) -> Value -> Parser Hash)
-> (Text -> Parser Hash) -> Value -> Parser Hash
forall a b. (a -> b) -> a -> b
$ Hash -> Parser Hash
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Hash -> Parser Hash) -> (Text -> Hash) -> Text -> Parser Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Hash
Hash.unsafeFromBase32HexText

deriving via Hash instance ToJSON CausalHash

deriving via Hash instance FromJSON CausalHash

instance ToJSON ShortHash where
  toJSON :: ShortHash -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (ShortHash -> Text) -> ShortHash -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Text
SH.toText

instance ToJSONKey ShortHash where
  toJSONKey :: ToJSONKeyFunction ShortHash
toJSONKey = (ShortHash -> Text)
-> ToJSONKeyFunction Text -> ToJSONKeyFunction ShortHash
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap ShortHash -> Text
SH.toText (forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey @Text)

instance FromJSON ShortHash where
  parseJSON :: Value -> Parser ShortHash
parseJSON = String -> (Text -> Parser ShortHash) -> Value -> Parser ShortHash
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"ShortHash" \Text
txt ->
    case Text -> Maybe ShortHash
SH.fromText Text
txt of
      Maybe ShortHash
Nothing -> String -> Parser ShortHash
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ShortHash) -> String -> Parser ShortHash
forall a b. (a -> b) -> a -> b
$ String
"Invalid Shorthash" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt
      Just ShortHash
sh -> ShortHash -> Parser ShortHash
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortHash
sh

instance FromJSONKey ShortHash where
  fromJSONKey :: FromJSONKeyFunction ShortHash
fromJSONKey =
    (Text -> Parser ShortHash) -> FromJSONKeyFunction ShortHash
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
Aeson.FromJSONKeyTextParser \Text
txt ->
      case Text -> Maybe ShortHash
SH.fromText Text
txt of
        Maybe ShortHash
Nothing -> String -> Parser ShortHash
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ShortHash) -> String -> Parser ShortHash
forall a b. (a -> b) -> a -> b
$ String
"Invalid Shorthash" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt
        Just ShortHash
sh -> ShortHash -> Parser ShortHash
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortHash
sh

instance FromHttpApiData ShortCausalHash where
  parseUrlPiece :: Text -> Either Text ShortCausalHash
parseUrlPiece = Either Text ShortCausalHash
-> (ShortCausalHash -> Either Text ShortCausalHash)
-> Maybe ShortCausalHash
-> Either Text ShortCausalHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text ShortCausalHash
forall a b. a -> Either a b
Left Text
"Invalid ShortCausalHash") ShortCausalHash -> Either Text ShortCausalHash
forall a b. b -> Either a b
Right (Maybe ShortCausalHash -> Either Text ShortCausalHash)
-> (Text -> Maybe ShortCausalHash)
-> Text
-> Either Text ShortCausalHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe ShortCausalHash
SCH.fromText

-- | Always renders to the form: #abcdef
instance ToHttpApiData ShortHash where
  toQueryParam :: ShortHash -> Text
toQueryParam = ShortHash -> Text
SH.toText

-- | Accepts shorthashes of any of the following forms:
-- @abcdef
-- @@builtin
-- #abcdef
-- ##builtin
-- abcdef
instance FromHttpApiData ShortHash where
  parseUrlPiece :: Text -> Either Text ShortHash
parseUrlPiece Text
txt =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"@" Text
"#" Text
txt
      Text -> (Text -> Either Text ShortHash) -> Either Text ShortHash
forall a b. a -> (a -> b) -> b
& \Text
t ->
        ( if Text -> Text -> Bool
Text.isPrefixOf Text
"#" Text
t
            then Text
t
            else (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
        )
          Text -> (Text -> Maybe ShortHash) -> Maybe ShortHash
forall a b. a -> (a -> b) -> b
& Text -> Maybe ShortHash
SH.fromText
          Maybe ShortHash
-> (Maybe ShortHash -> Either Text ShortHash)
-> Either Text ShortHash
forall a b. a -> (a -> b) -> b
& Either Text ShortHash
-> (ShortHash -> Either Text ShortHash)
-> Maybe ShortHash
-> Either Text ShortHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text ShortHash
forall a b. a -> Either a b
Left Text
"Invalid ShortCausalHash") ShortHash -> Either Text ShortHash
forall a b. b -> Either a b
Right

instance ToSchema ShortHash where
  declareNamedSchema :: Proxy ShortHash -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ShortHash
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

-- | Always renders to the form: #abcdef
instance ToHttpApiData Reference.Reference where
  toQueryParam :: Reference -> Text
toQueryParam = Reference -> Text
Reference.toText

-- | Always renders to the form: #abcdef
instance ToHttpApiData Referent.Referent where
  toQueryParam :: Referent -> Text
toQueryParam = Referent -> Text
Referent.toText

-- | Accepts shorthashes of any of the following forms:
-- @abcdef
-- @@builtin
-- #abcdef
-- ##builtin
-- abcdef
instance FromHttpApiData Reference.Reference where
  parseUrlPiece :: Text -> Either Text Reference
parseUrlPiece Text
txt =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"@" Text
"#" Text
txt
      Text -> (Text -> Either Text Reference) -> Either Text Reference
forall a b. a -> (a -> b) -> b
& \Text
t ->
        ( if Text -> Text -> Bool
Text.isPrefixOf Text
"#" Text
t
            then Text
t
            else (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
        )
          Text
-> (Text -> Either String Reference) -> Either String Reference
forall a b. a -> (a -> b) -> b
& Text -> Either String Reference
Reference.fromText
          Either String Reference
-> (Either String Reference -> Either Text Reference)
-> Either Text Reference
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String Reference -> Either Text Reference
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Text
Text.pack

-- | Accepts shorthashes of any of the following forms:
-- @abcdef
-- @@builtin
-- #abcdef
-- ##builtin
-- abcdef
instance FromHttpApiData Referent.Referent where
  parseUrlPiece :: Text -> Either Text Referent
parseUrlPiece Text
txt =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"@" Text
"#" Text
txt
      Text -> (Text -> Either Text Referent) -> Either Text Referent
forall a b. a -> (a -> b) -> b
& \Text
t ->
        ( if Text -> Text -> Bool
Text.isPrefixOf Text
"#" Text
t
            then Text
t
            else (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
        )
          Text -> (Text -> Maybe Referent) -> Maybe Referent
forall a b. a -> (a -> b) -> b
& Text -> Maybe Referent
Referent.fromText
          Maybe Referent
-> (Maybe Referent -> Either Text Referent) -> Either Text Referent
forall a b. a -> (a -> b) -> b
& Either Text Referent
-> (Referent -> Either Text Referent)
-> Maybe Referent
-> Either Text Referent
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Referent
forall a b. a -> Either a b
Left Text
"Invalid Referent") Referent -> Either Text Referent
forall a b. b -> Either a b
Right

instance ToSchema Reference where
  declareNamedSchema :: Proxy Reference -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Reference
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

deriving via ShortByteString instance Binary Hash

deriving via Hash instance Binary CausalHash

deriving via Text instance ToHttpApiData ShortCausalHash

instance (ToJSON b, ToJSON a) => ToJSON (DisplayObject b a) where
  toJSON :: DisplayObject b a -> Value
toJSON = \case
    BuiltinObject b
b -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Text -> Value
String Text
"BuiltinObject", Key
"contents" Key -> b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= b
b]
    MissingObject ShortHash
sh -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Text -> Value
String Text
"MissingObject", Key
"contents" Key -> ShortHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= ShortHash
sh]
    UserObject a
a -> [Pair] -> Value
object [Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= Text -> Value
String Text
"UserObject", Key
"contents" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
Aeson..= a
a]

instance (FromJSON a, FromJSON b) => FromJSON (DisplayObject b a) where
  parseJSON :: Value -> Parser (DisplayObject b a)
parseJSON = String
-> (Object -> Parser (DisplayObject b a))
-> Value
-> Parser (DisplayObject b a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"DisplayObject" \Object
o -> do
    Text
tag <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag"
    case Text
tag of
      Text
"BuiltinObject" -> b -> DisplayObject b a
forall b a. b -> DisplayObject b a
BuiltinObject (b -> DisplayObject b a) -> Parser b -> Parser (DisplayObject b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser b
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
      Text
"MissingObject" -> ShortHash -> DisplayObject b a
forall b a. ShortHash -> DisplayObject b a
MissingObject (ShortHash -> DisplayObject b a)
-> Parser ShortHash -> Parser (DisplayObject b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ShortHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
      Text
"UserObject" -> a -> DisplayObject b a
forall b a. a -> DisplayObject b a
UserObject (a -> DisplayObject b a) -> Parser a -> Parser (DisplayObject b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents"
      Text
_ -> String -> Parser (DisplayObject b a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (DisplayObject b a))
-> String -> Parser (DisplayObject b a)
forall a b. (a -> b) -> a -> b
$ String
"Invalid tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
tag

deriving instance (ToSchema b, ToSchema a) => ToSchema (DisplayObject b a)

-- [21/10/07] Hello, this is Mitchell. Name refactor in progress. Changing internal representation from a flat text to a
-- list of segments (in reverse order) plus an "is absolute?" bit.
--
-- To preserve backwards compatibility (for now, anyway -- is this even important long term?), the ToJSON and ToSchema
-- instances below treat Name as before.

instance ToJSON Name where
  toEncoding :: Name -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (Name -> Text) -> Name -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText
  toJSON :: Name -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Name -> Text) -> Name -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText

instance ToJSONKey Name where
  toJSONKey :: ToJSONKeyFunction Name
toJSONKey = (Name -> Text) -> ToJSONKeyFunction Text -> ToJSONKeyFunction Name
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap Name -> Text
Name.toText (forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey @Text)

instance ToSchema Name where
  declareNamedSchema :: Proxy Name -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Name
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToJSON NameSegment where
  toJSON :: NameSegment -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (NameSegment -> Text) -> NameSegment -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toEscapedText

instance ToJSONKey NameSegment where
  toJSONKey :: ToJSONKeyFunction NameSegment
toJSONKey = (NameSegment -> Text)
-> ToJSONKeyFunction Text -> ToJSONKeyFunction NameSegment
forall a' a.
(a' -> a) -> ToJSONKeyFunction a -> ToJSONKeyFunction a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap NameSegment -> Text
NameSegment.toEscapedText (forall a. ToJSONKey a => ToJSONKeyFunction a
toJSONKey @Text)

deriving anyclass instance ToParamSchema ShortCausalHash

instance ToParamSchema ShortHash where
  toParamSchema :: Proxy ShortHash -> Schema
toParamSchema Proxy ShortHash
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"@abcdef"

instance ToParamSchema Reference.Reference where
  toParamSchema :: Proxy Reference -> Schema
toParamSchema Proxy Reference
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"@abcdef"

instance ToParamSchema Referent.Referent where
  toParamSchema :: Proxy Referent -> Schema
toParamSchema Proxy Referent
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"@abcdef"

instance ToParamSchema Name where
  toParamSchema :: Proxy Name -> Schema
toParamSchema Proxy Name
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"base.List.map"

instance ToParamSchema Path.Path where
  toParamSchema :: Proxy Path -> Schema
toParamSchema Proxy Path
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"base.List"

instance ToParamSchema Path.Relative where
  toParamSchema :: Proxy Relative -> Schema
toParamSchema Proxy Relative
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"base.List"

instance ToParam (QueryParam "name" Name) where
  toParam :: Proxy (QueryParam "name" Name) -> DocQueryParam
toParam Proxy (QueryParam "name" Name)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"name"
      []
      String
"A definition name. See API documentation to determine how it should be qualified."
      ParamKind
Normal

instance FromHttpApiData Name where
  parseQueryParam :: Text -> Either Text Name
parseQueryParam = Text -> Either Text Name
Name.parseTextEither

deriving via Int instance FromHttpApiData Width

deriving via Int instance ToHttpApiData Width

deriving anyclass instance ToParamSchema Width

instance ToJSON ConstructorType where
  toJSON :: ConstructorType -> Value
toJSON = \case
    ConstructorType
CT.Data -> Text -> Value
String Text
"Data"
    ConstructorType
CT.Effect -> Text -> Value
String Text
"Effect"

instance FromHttpApiData Path.Relative where
  parseUrlPiece :: Text -> Either Text Relative
parseUrlPiece Text
txt = case String -> Either Text Path'
Path.parsePath' (Text -> String
Text.unpack Text
txt) of
    Left Text
s -> Text -> Either Text Relative
forall a b. a -> Either a b
Left Text
s
    Right (Path.RelativePath' Relative
p) -> Relative -> Either Text Relative
forall a b. b -> Either a b
Right Relative
p
    Right (Path.AbsolutePath' Absolute
_) -> Text -> Either Text Relative
forall a b. a -> Either a b
Left (Text -> Either Text Relative) -> Text -> Either Text Relative
forall a b. (a -> b) -> a -> b
$ Text
"Expected relative path, but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was absolute."

instance ToHttpApiData Path.Relative where
  toUrlPiece :: Relative -> Text
toUrlPiece = Relative -> Text
forall a. Show a => a -> Text
tShow

instance FromHttpApiData Path.Absolute where
  parseUrlPiece :: Text -> Either Text Absolute
parseUrlPiece Text
txt = case String -> Either Text Path'
Path.parsePath' (Text -> String
Text.unpack Text
txt) of
    Left Text
s -> Text -> Either Text Absolute
forall a b. a -> Either a b
Left Text
s
    Right (Path.RelativePath' Relative
_) -> Text -> Either Text Absolute
forall a b. a -> Either a b
Left (Text -> Either Text Absolute) -> Text -> Either Text Absolute
forall a b. (a -> b) -> a -> b
$ Text
"Expected absolute path, but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was relative."
    Right (Path.AbsolutePath' Absolute
p) -> Absolute -> Either Text Absolute
forall a b. b -> Either a b
Right Absolute
p

instance ToHttpApiData Path.Absolute where
  toUrlPiece :: Absolute -> Text
toUrlPiece = Absolute -> Text
forall a. Show a => a -> Text
tShow

instance FromHttpApiData Path.Path' where
  parseUrlPiece :: Text -> Either Text Path'
parseUrlPiece Text
txt = String -> Either Text Path'
Path.parsePath' (Text -> String
Text.unpack Text
txt)

instance ToHttpApiData Path.Path' where
  toUrlPiece :: Path' -> Text
toUrlPiece = Path' -> Text
forall a. Show a => a -> Text
tShow

instance FromHttpApiData Path.Path where
  parseUrlPiece :: Text -> Either Text Path
parseUrlPiece Text
txt = case String -> Either Text Path'
Path.parsePath' (Text -> String
Text.unpack Text
txt) of
    Left Text
s -> Text -> Either Text Path
forall a b. a -> Either a b
Left Text
s
    Right (Path.RelativePath' Relative
p) -> Path -> Either Text Path
forall a b. b -> Either a b
Right (Relative -> Path
Path.unrelative Relative
p)
    Right (Path.AbsolutePath' Absolute
_) -> Text -> Either Text Path
forall a b. a -> Either a b
Left (Text -> Either Text Path) -> Text -> Either Text Path
forall a b. (a -> b) -> a -> b
$ Text
"Expected relative path, but " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" was absolute."

instance ToCapture (Capture "hash" ShortHash) where
  toCapture :: Proxy (Capture "hash" ShortHash) -> DocCapture
toCapture Proxy (Capture "hash" ShortHash)
_ =
    String -> String -> DocCapture
DocCapture
      String
"hash"
      String
"A shorthash for a term or type. E.g. @abcdef, #abcdef, @@builtin, ##builtin, abcdef"

instance ToCapture (Capture "hash" Reference.Reference) where
  toCapture :: Proxy (Capture "hash" Reference) -> DocCapture
toCapture Proxy (Capture "hash" Reference)
_ =
    String -> String -> DocCapture
DocCapture
      String
"hash"
      String
"A hash reference for a type. E.g. @abcdef, #abcdef, @@builtin, ##builtin, abcdef"

instance ToCapture (Capture "hash" Referent.Referent) where
  toCapture :: Proxy (Capture "hash" Referent) -> DocCapture
toCapture Proxy (Capture "hash" Referent)
_ =
    String -> String -> DocCapture
DocCapture
      String
"hash"
      String
"A hash reference for a term. E.g. @abcdef, #abcdef, @@builtin, ##builtin, abcdef"

instance ToCapture (Capture "fqn" Name) where
  toCapture :: Proxy (Capture "fqn" Name) -> DocCapture
toCapture Proxy (Capture "fqn" Name)
_ =
    String -> String -> DocCapture
DocCapture
      String
"fqn"
      String
"The fully qualified name of a definition."

instance ToCapture (Capture "namespace" Path.Path) where
  toCapture :: Proxy (Capture "namespace" Path) -> DocCapture
toCapture Proxy (Capture "namespace" Path)
_ =
    String -> String -> DocCapture
DocCapture
      String
"namespace"
      String
"E.g. base.List"

instance ToJSON Path.Path where
  toJSON :: Path -> Value
toJSON Path
p = Text -> Value
Aeson.String (Path -> Text
forall path. Pathy path => path -> Text
Path.toText Path
p)

instance FromJSON Path.Path where
  parseJSON :: Value -> Parser Path
parseJSON = String -> (Text -> Parser Path) -> Value -> Parser Path
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Path" \Text
txt -> case String -> Either Text Path
Path.parsePath (Text -> String
Text.unpack Text
txt) of
    Left Text
s -> String -> Parser Path
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack Text
s)
    Right Path
p -> Path -> Parser Path
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
p

instance ToJSON Path.Absolute where
  toJSON :: Absolute -> Value
toJSON Absolute
p = Text -> Value
Aeson.String (Absolute -> Text
forall path. Pathy path => path -> Text
Path.toText Absolute
p)

instance FromJSON Path.Absolute where
  parseJSON :: Value -> Parser Absolute
parseJSON = String -> (Text -> Parser Absolute) -> Value -> Parser Absolute
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Path" \Text
txt -> case String -> Either Text Path'
Path.parsePath' (Text -> String
Text.unpack Text
txt) of
    Left Text
s -> String -> Parser Absolute
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Text -> String
Text.unpack Text
s)
    Right (Path.AbsolutePath' Absolute
p) -> Absolute -> Parser Absolute
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Absolute
p
    Right (Path.RelativePath' Relative
_) -> String -> Parser Absolute
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected an absolute path but received a relative path."

instance ToSchema Path.Path where
  declareNamedSchema :: Proxy Path -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Path
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToSchema Path.Absolute where
  declareNamedSchema :: Proxy Absolute -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Absolute
_ = Proxy Text -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
declareNamedSchema (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Text)

instance ToJSON (HQ.HashQualified Name) where
  toJSON :: HashQualified Name -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (HashQualified Name -> Text) -> HashQualified Name -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ.toTextWith Name -> Text
Name.toText

instance ToJSON (HQ.HashQualified NameSegment) where
  toJSON :: HashQualified NameSegment -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (HashQualified NameSegment -> Text)
-> HashQualified NameSegment
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> Text) -> HashQualified NameSegment -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ.toTextWith NameSegment -> Text
NameSegment.toEscapedText

instance ToJSON (HQ'.HashQualified Name) where
  toJSON :: HashQualified Name -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (HashQualified Name -> Text) -> HashQualified Name -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith Name -> Text
Name.toText

instance ToJSON (HQ'.HashQualified NameSegment) where
  toJSON :: HashQualified NameSegment -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value)
-> (HashQualified NameSegment -> Text)
-> HashQualified NameSegment
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameSegment -> Text) -> HashQualified NameSegment -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith NameSegment -> Text
NameSegment.toEscapedText

instance FromJSON (HQ'.HashQualified Name) where
  parseJSON :: Value -> Parser (HashQualified Name)
parseJSON = String
-> (Text -> Parser (HashQualified Name))
-> Value
-> Parser (HashQualified Name)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HashQualified'" \Text
txt ->
    Parser (HashQualified Name)
-> (HashQualified Name -> Parser (HashQualified Name))
-> Maybe (HashQualified Name)
-> Parser (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (HashQualified Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid HashQualified' Name") HashQualified Name -> Parser (HashQualified Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> Parser (HashQualified Name))
-> Maybe (HashQualified Name) -> Parser (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (HashQualified Name)
HQ'.parseText Text
txt

instance FromJSON (HQ.HashQualified Name) where
  parseJSON :: Value -> Parser (HashQualified Name)
parseJSON = String
-> (Text -> Parser (HashQualified Name))
-> Value
-> Parser (HashQualified Name)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HashQualified" \Text
txt ->
    Parser (HashQualified Name)
-> (HashQualified Name -> Parser (HashQualified Name))
-> Maybe (HashQualified Name)
-> Parser (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (HashQualified Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid HashQualified Name") HashQualified Name -> Parser (HashQualified Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> Parser (HashQualified Name))
-> Maybe (HashQualified Name) -> Parser (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (HashQualified Name)
HQ.parseText Text
txt

instance FromJSON (HQ'.HashQualified NameSegment) where
  parseJSON :: Value -> Parser (HashQualified NameSegment)
parseJSON = String
-> (Text -> Parser (HashQualified NameSegment))
-> Value
-> Parser (HashQualified NameSegment)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HashQualified'" \Text
txt -> do
    HashQualified Name
hqName <- Parser (HashQualified Name)
-> (HashQualified Name -> Parser (HashQualified Name))
-> Maybe (HashQualified Name)
-> Parser (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (HashQualified Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid HashQualified' NameSegment") HashQualified Name -> Parser (HashQualified Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> Parser (HashQualified Name))
-> Maybe (HashQualified Name) -> Parser (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (HashQualified Name)
HQ'.parseText Text
txt
    HashQualified Name
-> (Name -> Parser NameSegment)
-> Parser (HashQualified NameSegment)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashQualified Name
hqName \Name
name -> case Name -> NonEmpty NameSegment
Name.segments Name
name of
      (NameSegment
ns :| []) -> NameSegment -> Parser NameSegment
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSegment
ns
      NonEmpty NameSegment
_ -> String -> Parser NameSegment
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NameSegment) -> String -> Parser NameSegment
forall a b. (a -> b) -> a -> b
$ String
"Expected a single name segment but received several: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt

instance FromJSON (HQ.HashQualified NameSegment) where
  parseJSON :: Value -> Parser (HashQualified NameSegment)
parseJSON = String
-> (Text -> Parser (HashQualified NameSegment))
-> Value
-> Parser (HashQualified NameSegment)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"HashQualified" \Text
txt -> do
    HashQualified Name
hqName <- Parser (HashQualified Name)
-> (HashQualified Name -> Parser (HashQualified Name))
-> Maybe (HashQualified Name)
-> Parser (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser (HashQualified Name)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid HashQualified' NameSegment") HashQualified Name -> Parser (HashQualified Name)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HashQualified Name) -> Parser (HashQualified Name))
-> Maybe (HashQualified Name) -> Parser (HashQualified Name)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (HashQualified Name)
HQ.parseText Text
txt
    HashQualified Name
-> (Name -> Parser NameSegment)
-> Parser (HashQualified NameSegment)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for HashQualified Name
hqName \Name
name -> case Name -> NonEmpty NameSegment
Name.segments Name
name of
      (NameSegment
ns :| []) -> NameSegment -> Parser NameSegment
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSegment
ns
      NonEmpty NameSegment
_ -> String -> Parser NameSegment
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser NameSegment) -> String -> Parser NameSegment
forall a b. (a -> b) -> a -> b
$ String
"Expected a single name segment but received several: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
txt

instance FromHttpApiData (HQ.HashQualified Name) where
  parseQueryParam :: Text -> Either Text (HashQualified Name)
parseQueryParam Text
txt =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"@" Text
"#" Text
txt
      Text
-> (Text -> Maybe (HashQualified Name))
-> Maybe (HashQualified Name)
forall a b. a -> (a -> b) -> b
& Text -> Maybe (HashQualified Name)
HQ.parseText
      Maybe (HashQualified Name)
-> (Maybe (HashQualified Name) -> Either Text (HashQualified Name))
-> Either Text (HashQualified Name)
forall a b. a -> (a -> b) -> b
& Either Text (HashQualified Name)
-> (HashQualified Name -> Either Text (HashQualified Name))
-> Maybe (HashQualified Name)
-> Either Text (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (HashQualified Name)
forall a b. a -> Either a b
Left Text
"Invalid Hash Qualified Name. Expected one of the following forms: name@hash, name, @hash") HashQualified Name -> Either Text (HashQualified Name)
forall a b. b -> Either a b
Right

instance FromHttpApiData (HQ'.HashQualified Name) where
  parseQueryParam :: Text -> Either Text (HashQualified Name)
parseQueryParam Text
txt =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"@" Text
"#" Text
txt
      Text
-> (Text -> Maybe (HashQualified Name))
-> Maybe (HashQualified Name)
forall a b. a -> (a -> b) -> b
& Text -> Maybe (HashQualified Name)
HQ'.parseText
      Maybe (HashQualified Name)
-> (Maybe (HashQualified Name) -> Either Text (HashQualified Name))
-> Either Text (HashQualified Name)
forall a b. a -> (a -> b) -> b
& Either Text (HashQualified Name)
-> (HashQualified Name -> Either Text (HashQualified Name))
-> Maybe (HashQualified Name)
-> Either Text (HashQualified Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text (HashQualified Name)
forall a b. a -> Either a b
Left Text
"Invalid Hash Qualified Name. Expected one of the following forms: name@hash, name") HashQualified Name -> Either Text (HashQualified Name)
forall a b. b -> Either a b
Right

instance ToParamSchema (HQ.HashQualified n) where
  toParamSchema :: Proxy (HashQualified n) -> Schema
toParamSchema Proxy (HashQualified n)
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"name@hash"

instance ToParamSchema (HQ'.HashQualified n) where
  toParamSchema :: Proxy (HashQualified n) -> Schema
toParamSchema Proxy (HashQualified n)
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"name@hash"

instance ToHttpApiData Name where
  toQueryParam :: Name -> Text
toQueryParam = Name -> Text
Name.toText

deriving newtype instance ToSchema NameSegment

deriving anyclass instance (ToSchema n) => ToSchema (HQ.HashQualified n)

deriving anyclass instance (ToSchema n) => ToSchema (HQ'.HashQualified n)

deriving via Text instance Sqlite.FromField ProjectName

instance FromHttpApiData ProjectName where
  parseQueryParam :: Text -> Either Text ProjectName
parseQueryParam = (TryFromException Text ProjectName -> Text)
-> Either (TryFromException Text ProjectName) ProjectName
-> Either Text ProjectName
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft TryFromException Text ProjectName -> Text
forall a. Show a => a -> Text
tShow (Either (TryFromException Text ProjectName) ProjectName
 -> Either Text ProjectName)
-> (Text -> Either (TryFromException Text ProjectName) ProjectName)
-> Text
-> Either Text ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @ProjectName

instance ToParamSchema ProjectName where
  toParamSchema :: Proxy ProjectName -> Schema
toParamSchema Proxy ProjectName
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"[@handle/]name"

instance ToCapture (Capture "project-name" ProjectName) where
  toCapture :: Proxy (Capture "project-name" ProjectName) -> DocCapture
toCapture Proxy (Capture "project-name" ProjectName)
_ =
    String -> String -> DocCapture
DocCapture
      String
"project-name"
      String
"The name of a project. E.g. @handle/slug"

instance ToSchema ProjectName

deriving via Text instance ToJSON ProjectName

deriving via Text instance FromJSON ProjectName

deriving via Text instance Sqlite.FromField ProjectBranchName

instance FromHttpApiData ProjectBranchName where
  parseQueryParam :: Text -> Either Text ProjectBranchName
parseQueryParam = (TryFromException Text ProjectBranchName -> Text)
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
-> Either Text ProjectBranchName
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft TryFromException Text ProjectBranchName -> Text
forall a. Show a => a -> Text
tShow (Either (TryFromException Text ProjectBranchName) ProjectBranchName
 -> Either Text ProjectBranchName)
-> (Text
    -> Either
         (TryFromException Text ProjectBranchName) ProjectBranchName)
-> Text
-> Either Text ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @ProjectBranchName

instance ToSchema ProjectBranchName

instance ToParamSchema ProjectBranchName where
  toParamSchema :: Proxy ProjectBranchName -> Schema
toParamSchema Proxy ProjectBranchName
_ =
    Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
Lens' Schema (Maybe OpenApiType)
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe Value -> Identity (Maybe Value))
-> Schema -> Identity Schema
forall s a. HasExample s a => Lens' s a
Lens' Schema (Maybe Value)
example ((Maybe Value -> Identity (Maybe Value))
 -> Schema -> Identity Schema)
-> Value -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text -> Value
Aeson.String Text
"[@handle/]name"

instance ToCapture (Capture "branch-name" ProjectBranchName) where
  toCapture :: Proxy (Capture "branch-name" ProjectBranchName) -> DocCapture
toCapture Proxy (Capture "branch-name" ProjectBranchName)
_ =
    String -> String -> DocCapture
DocCapture
      String
"branch-name"
      String
"The name of a branch in a project. E.g. @handle/name"

deriving via Text instance ToJSON ProjectBranchName

deriving via Text instance FromJSON ProjectBranchName

-- CBOR encodings

deriving via Text instance Serialise Hash32

deriving via Text instance Serialise HashJWT

data SyncTag
  = TermComponentTag
  | DeclComponentTag
  | PatchTag
  | NamespaceTag
  | CausalTag
  deriving (SyncTag -> SyncTag -> Bool
(SyncTag -> SyncTag -> Bool)
-> (SyncTag -> SyncTag -> Bool) -> Eq SyncTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncTag -> SyncTag -> Bool
== :: SyncTag -> SyncTag -> Bool
$c/= :: SyncTag -> SyncTag -> Bool
/= :: SyncTag -> SyncTag -> Bool
Eq, Int -> SyncTag -> String -> String
[SyncTag] -> String -> String
SyncTag -> String
(Int -> SyncTag -> String -> String)
-> (SyncTag -> String)
-> ([SyncTag] -> String -> String)
-> Show SyncTag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> SyncTag -> String -> String
showsPrec :: Int -> SyncTag -> String -> String
$cshow :: SyncTag -> String
show :: SyncTag -> String
$cshowList :: [SyncTag] -> String -> String
showList :: [SyncTag] -> String -> String
Show)

instance Serialise SyncTag where
  encode :: SyncTag -> Encoding
encode = \case
    SyncTag
TermComponentTag -> Word -> Encoding
CBOR.encodeWord Word
0
    SyncTag
DeclComponentTag -> Word -> Encoding
CBOR.encodeWord Word
1
    SyncTag
PatchTag -> Word -> Encoding
CBOR.encodeWord Word
2
    SyncTag
NamespaceTag -> Word -> Encoding
CBOR.encodeWord Word
3
    SyncTag
CausalTag -> Word -> Encoding
CBOR.encodeWord Word
4

  decode :: forall s. Decoder s SyncTag
decode = do
    Word
tag <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
    case Word
tag of
      Word
0 -> SyncTag -> Decoder s SyncTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncTag
TermComponentTag
      Word
1 -> SyncTag -> Decoder s SyncTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncTag
DeclComponentTag
      Word
2 -> SyncTag -> Decoder s SyncTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncTag
PatchTag
      Word
3 -> SyncTag -> Decoder s SyncTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncTag
NamespaceTag
      Word
4 -> SyncTag -> Decoder s SyncTag
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SyncTag
CausalTag
      Word
_ -> String -> Decoder s SyncTag
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s SyncTag) -> String -> Decoder s SyncTag
forall a b. (a -> b) -> a -> b
$ String
"Unknown tag: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
tag

newtype ComponentBody t d = ComponentBody {forall t d. ComponentBody t d -> (LocalIds' t d, ByteString)
unComponentBody :: (LocalIds.LocalIds' t d, ByteString)}

instance (Serialise t, Serialise d) => Serialise (ComponentBody t d) where
  encode :: ComponentBody t d -> Encoding
encode (ComponentBody (LocalIds.LocalIds {Vector t
textLookup :: Vector t
$sel:textLookup:LocalIds :: forall t h. LocalIds' t h -> Vector t
textLookup, Vector d
defnLookup :: Vector d
$sel:defnLookup:LocalIds :: forall t h. LocalIds' t h -> Vector h
defnLookup}, ByteString
bytes)) =
    Vector t -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector t
textLookup
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector d -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector d
defnLookup
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
bytes

  decode :: forall s. Decoder s (ComponentBody t d)
decode = do
    Vector t
textLookup <- Decoder s (Vector t)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
    Vector d
defnLookup <- Decoder s (Vector d)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
    ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
    ComponentBody t d -> Decoder s (ComponentBody t d)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentBody t d -> Decoder s (ComponentBody t d))
-> ComponentBody t d -> Decoder s (ComponentBody t d)
forall a b. (a -> b) -> a -> b
$ (LocalIds' t d, ByteString) -> ComponentBody t d
forall t d. (LocalIds' t d, ByteString) -> ComponentBody t d
ComponentBody (LocalIds.LocalIds {Vector t
$sel:textLookup:LocalIds :: Vector t
textLookup :: Vector t
textLookup, Vector d
$sel:defnLookup:LocalIds :: Vector d
defnLookup :: Vector d
defnLookup}, ByteString
bytes)

instance Serialise TempEntity where
  encode :: TempEntity -> Encoding
encode = \case
    Entity.TC (TermFormat.SyncTerm (TermFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
elements)) ->
      SyncTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode SyncTag
TermComponentTag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector (ComponentBody Text Hash32) -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Vector (LocalIds.LocalIds' Text Hash32, ByteString)) @(Vector (ComponentBody Text Hash32)) Vector (LocalIds' Text Hash32, ByteString)
elements)
    Entity.DC (DeclFormat.SyncDecl (DeclFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
elements)) ->
      SyncTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode SyncTag
DeclComponentTag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector (ComponentBody Text Hash32) -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector (forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Vector (LocalIds.LocalIds' Text Hash32, ByteString)) @(Vector (ComponentBody Text Hash32)) Vector (LocalIds' Text Hash32, ByteString)
elements)
    Entity.P (PatchFormat.SyncDiff {}) -> String -> Encoding
forall a. HasCallStack => String -> a
error String
"Serializing Diffs are not supported"
    Entity.P (PatchFormat.SyncFull (PatchFormat.LocalIds {Vector Text
patchTextLookup :: Vector Text
$sel:patchTextLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector t
patchTextLookup, Vector Hash32
patchHashLookup :: Vector Hash32
$sel:patchHashLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector h
patchHashLookup, Vector Hash32
patchDefnLookup :: Vector Hash32
$sel:patchDefnLookup:LocalIds :: forall t h d. PatchLocalIds' t h d -> Vector d
patchDefnLookup}) ByteString
bytes) ->
      SyncTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode SyncTag
PatchTag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Text -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Text
patchTextLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Hash32 -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Hash32
patchHashLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Hash32 -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Hash32
patchDefnLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
bytes
    Entity.N (BranchFormat.SyncDiff {}) -> String -> Encoding
forall a. HasCallStack => String -> a
error String
"Serializing Diffs are not supported"
    Entity.N (BranchFormat.SyncFull (BranchFormat.LocalIds {Vector Text
branchTextLookup :: Vector Text
$sel:branchTextLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector t
branchTextLookup, Vector Hash32
branchDefnLookup :: Vector Hash32
$sel:branchDefnLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector d
branchDefnLookup, Vector Hash32
branchPatchLookup :: Vector Hash32
$sel:branchPatchLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector p
branchPatchLookup, Vector (Hash32, Hash32)
branchChildLookup :: Vector (Hash32, Hash32)
$sel:branchChildLookup:LocalIds :: forall t d p c. BranchLocalIds' t d p c -> Vector c
branchChildLookup}) (BranchFormat.LocalBranchBytes ByteString
bytes)) ->
      SyncTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode SyncTag
NamespaceTag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Text -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Text
branchTextLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Hash32 -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Hash32
branchDefnLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Hash32 -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Hash32
branchPatchLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector (Hash32, Hash32) -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector (Hash32, Hash32)
branchChildLookup
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes ByteString
bytes
    Entity.C (SqliteCausal.SyncCausalFormat {Hash32
valueHash :: Hash32
$sel:valueHash:SyncCausalFormat :: forall causalHash valueHash.
SyncCausalFormat' causalHash valueHash -> valueHash
valueHash, Vector Hash32
parents :: Vector Hash32
$sel:parents:SyncCausalFormat :: forall causalHash valueHash.
SyncCausalFormat' causalHash valueHash -> Vector causalHash
parents}) ->
      SyncTag -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode SyncTag
CausalTag
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Hash32 -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode Hash32
valueHash
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Vector Hash32 -> Encoding
forall a (v :: * -> *).
(Serialise a, Vector v a) =>
v a -> Encoding
CBOR.encodeVector Vector Hash32
parents

  decode :: forall s. Decoder s TempEntity
decode = do
    Decoder s SyncTag
forall s. Decoder s SyncTag
forall a s. Serialise a => Decoder s a
CBOR.decode Decoder s SyncTag
-> (SyncTag -> Decoder s TempEntity) -> Decoder s TempEntity
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      SyncTag
TermComponentTag -> do
        Vector (LocalIds' Text Hash32, ByteString)
elements <- forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Vector (ComponentBody Text Hash32)) @(Vector (LocalIds.LocalIds' Text Hash32, ByteString)) (Vector (ComponentBody Text Hash32)
 -> Vector (LocalIds' Text Hash32, ByteString))
-> Decoder s (Vector (ComponentBody Text Hash32))
-> Decoder s (Vector (LocalIds' Text Hash32, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Vector (ComponentBody Text Hash32))
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        TempEntity -> Decoder s TempEntity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Decoder s TempEntity)
-> TempEntity -> Decoder s TempEntity
forall a b. (a -> b) -> a -> b
$ SyncTermFormat' Text Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncTermFormat' text defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.TC (SyncLocallyIndexedComponent' Text Hash32
-> SyncTermFormat' Text Hash32
forall t d. SyncLocallyIndexedComponent' t d -> SyncTermFormat' t d
TermFormat.SyncTerm (Vector (LocalIds' Text Hash32, ByteString)
-> SyncLocallyIndexedComponent' Text Hash32
forall t d.
Vector (LocalIds' t d, ByteString)
-> SyncLocallyIndexedComponent' t d
TermFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
elements))
      SyncTag
DeclComponentTag -> do
        Vector (LocalIds' Text Hash32, ByteString)
elements <- forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(Vector (ComponentBody Text Hash32)) @(Vector (LocalIds.LocalIds' Text Hash32, ByteString)) (Vector (ComponentBody Text Hash32)
 -> Vector (LocalIds' Text Hash32, ByteString))
-> Decoder s (Vector (ComponentBody Text Hash32))
-> Decoder s (Vector (LocalIds' Text Hash32, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Vector (ComponentBody Text Hash32))
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        TempEntity -> Decoder s TempEntity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Decoder s TempEntity)
-> TempEntity -> Decoder s TempEntity
forall a b. (a -> b) -> a -> b
$ SyncDeclFormat' Text Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncDeclFormat' text defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.DC (SyncLocallyIndexedComponent' Text Hash32
-> SyncDeclFormat' Text Hash32
forall t d. SyncLocallyIndexedComponent' t d -> SyncDeclFormat' t d
DeclFormat.SyncDecl (Vector (LocalIds' Text Hash32, ByteString)
-> SyncLocallyIndexedComponent' Text Hash32
forall t d.
Vector (LocalIds' t d, ByteString)
-> SyncLocallyIndexedComponent' t d
DeclFormat.SyncLocallyIndexedComponent Vector (LocalIds' Text Hash32, ByteString)
elements))
      SyncTag
PatchTag -> do
        Vector Text
patchTextLookup <- Decoder s (Vector Text)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        Vector Hash32
patchHashLookup <- Decoder s (Vector Hash32)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        Vector Hash32
patchDefnLookup <- Decoder s (Vector Hash32)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        TempEntity -> Decoder s TempEntity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Decoder s TempEntity)
-> TempEntity -> Decoder s TempEntity
forall a b. (a -> b) -> a -> b
$ SyncPatchFormat' Hash32 Text Hash32 Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncPatchFormat' patch text hash defn
-> SyncEntity' text hash defn patch branchh branch causal
Entity.P (PatchLocalIds' Text Hash32 Hash32
-> ByteString -> SyncPatchFormat' Hash32 Text Hash32 Hash32
forall parent text hash defn.
PatchLocalIds' text hash defn
-> ByteString -> SyncPatchFormat' parent text hash defn
PatchFormat.SyncFull (PatchFormat.LocalIds {Vector Text
$sel:patchTextLookup:LocalIds :: Vector Text
patchTextLookup :: Vector Text
patchTextLookup, Vector Hash32
$sel:patchHashLookup:LocalIds :: Vector Hash32
patchHashLookup :: Vector Hash32
patchHashLookup, Vector Hash32
$sel:patchDefnLookup:LocalIds :: Vector Hash32
patchDefnLookup :: Vector Hash32
patchDefnLookup}) ByteString
bytes)
      SyncTag
NamespaceTag -> do
        Vector Text
branchTextLookup <- Decoder s (Vector Text)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        Vector Hash32
branchDefnLookup <- Decoder s (Vector Hash32)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        Vector Hash32
branchPatchLookup <- Decoder s (Vector Hash32)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        Vector (Hash32, Hash32)
branchChildLookup <- Decoder s (Vector (Hash32, Hash32))
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        ByteString
bytes <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        TempEntity -> Decoder s TempEntity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Decoder s TempEntity)
-> TempEntity -> Decoder s TempEntity
forall a b. (a -> b) -> a -> b
$ SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
-> TempEntity
forall text hash defn patch branchh branch causal.
SyncBranchFormat' branch text defn patch (branch, causal)
-> SyncEntity' text hash defn patch branchh branch causal
Entity.N (BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
-> LocalBranchBytes
-> SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
forall parent text defn patch child.
BranchLocalIds' text defn patch child
-> LocalBranchBytes
-> SyncBranchFormat' parent text defn patch child
BranchFormat.SyncFull (BranchFormat.LocalIds {Vector Text
$sel:branchTextLookup:LocalIds :: Vector Text
branchTextLookup :: Vector Text
branchTextLookup, Vector Hash32
$sel:branchDefnLookup:LocalIds :: Vector Hash32
branchDefnLookup :: Vector Hash32
branchDefnLookup, Vector Hash32
$sel:branchPatchLookup:LocalIds :: Vector Hash32
branchPatchLookup :: Vector Hash32
branchPatchLookup, Vector (Hash32, Hash32)
$sel:branchChildLookup:LocalIds :: Vector (Hash32, Hash32)
branchChildLookup :: Vector (Hash32, Hash32)
branchChildLookup}) (ByteString -> LocalBranchBytes
BranchFormat.LocalBranchBytes ByteString
bytes))
      SyncTag
CausalTag -> do
        Hash32
valueHash <- Decoder s Hash32
forall s. Decoder s Hash32
forall a s. Serialise a => Decoder s a
CBOR.decode
        Vector Hash32
parents <- Decoder s (Vector Hash32)
forall a (v :: * -> *) s.
(Serialise a, Vector v a) =>
Decoder s (v a)
CBOR.decodeVector
        TempEntity -> Decoder s TempEntity
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TempEntity -> Decoder s TempEntity)
-> TempEntity -> Decoder s TempEntity
forall a b. (a -> b) -> a -> b
$ SyncCausalFormat' Hash32 Hash32 -> TempEntity
forall text hash defn patch branchh branch causal.
SyncCausalFormat' causal branchh
-> SyncEntity' text hash defn patch branchh branch causal
Entity.C (SqliteCausal.SyncCausalFormat {Hash32
$sel:valueHash:SyncCausalFormat :: Hash32
valueHash :: Hash32
valueHash, Vector Hash32
$sel:parents:SyncCausalFormat :: Vector Hash32
parents :: Vector Hash32
parents})

encodeVectorWith :: (a -> CBOR.Encoding) -> Vector.Vector a -> CBOR.Encoding
encodeVectorWith :: forall a. (a -> Encoding) -> Vector a -> Encoding
encodeVectorWith a -> Encoding
f Vector a
xs =
  Word -> Encoding
CBOR.encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
xs)
    Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ((a -> Encoding -> Encoding) -> Encoding -> Vector a -> Encoding
forall a b. (a -> b -> b) -> b -> Vector a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a Encoding
b -> a -> Encoding
f a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b) Encoding
forall a. Monoid a => a
mempty Vector a
xs)

instance Ord CBOR.DeserialiseFailure where
  compare :: DeserialiseFailure -> DeserialiseFailure -> Ordering
compare (CBOR.DeserialiseFailure ByteOffset
o String
s) (CBOR.DeserialiseFailure ByteOffset
o' String
s') = (ByteOffset, String) -> (ByteOffset, String) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteOffset
o, String
s) (ByteOffset
o', String
s')