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

module Unison.Server.Types where

-- Types common to endpoints --
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson qualified as Aeson
import Data.Bifoldable (Bifoldable (..))
import Data.Bitraversable (Bitraversable (..))
import Data.ByteString.Lazy qualified as LZ
import Data.Map qualified as Map
import Data.OpenApi
  ( OpenApiType (..),
    ToParamSchema (..),
    ToSchema (..),
  )
import Data.OpenApi.Lens qualified as OpenApi
import Data.Text qualified as Text
import Data.Text.Lazy qualified as Text.Lazy
import Data.Text.Lazy.Encoding qualified as Text
import Servant qualified
import Servant.API
  ( Capture,
    FromHttpApiData (..),
    Get,
    Header,
    Headers,
    JSON,
    QueryParam,
    addHeader,
  )
import Servant.Docs (DocCapture (..), DocQueryParam (..), ParamKind (..), ToParam)
import Servant.Docs qualified as Docs
import U.Codebase.Branch qualified as V2Branch
import U.Codebase.Causal qualified as V2Causal
import U.Codebase.HashTags
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Editor.DisplayObject (DisplayObject)
import Unison.Codebase.Path qualified as Path
import Unison.Core.Project (ProjectBranchName)
import Unison.Hash qualified as Hash
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Prelude
import Unison.Project (ProjectAndBranch, ProjectName)
import Unison.Server.Doc (Doc)
import Unison.Server.Orphans ()
import Unison.Server.Syntax qualified as Syntax
import Unison.ShortHash (ShortHash)
import Unison.Syntax.HashQualified qualified as HQ (parseText)
import Unison.Syntax.Name qualified as Name
import Unison.Util.Pretty (Width (..))

type APIHeaders x =
  Headers
    '[ Header "Cache-Control" String
     ]
    x

type APIGet c = Get '[JSON] (APIHeaders c)

type HashQualifiedName = Text

type NamespaceFQN = Text

type Size = Int

type UnisonName = Text

type UnisonHash = Text

data NamespaceDetails = NamespaceDetails
  { NamespaceDetails -> Path
fqn :: Path.Path,
    NamespaceDetails -> UnisonHash
hash :: UnisonHash,
    NamespaceDetails -> Maybe Doc
readme :: Maybe Doc
  }
  deriving ((forall x. NamespaceDetails -> Rep NamespaceDetails x)
-> (forall x. Rep NamespaceDetails x -> NamespaceDetails)
-> Generic NamespaceDetails
forall x. Rep NamespaceDetails x -> NamespaceDetails
forall x. NamespaceDetails -> Rep NamespaceDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamespaceDetails -> Rep NamespaceDetails x
from :: forall x. NamespaceDetails -> Rep NamespaceDetails x
$cto :: forall x. Rep NamespaceDetails x -> NamespaceDetails
to :: forall x. Rep NamespaceDetails x -> NamespaceDetails
Generic, Int -> NamespaceDetails -> ShowS
[NamespaceDetails] -> ShowS
NamespaceDetails -> String
(Int -> NamespaceDetails -> ShowS)
-> (NamespaceDetails -> String)
-> ([NamespaceDetails] -> ShowS)
-> Show NamespaceDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamespaceDetails -> ShowS
showsPrec :: Int -> NamespaceDetails -> ShowS
$cshow :: NamespaceDetails -> String
show :: NamespaceDetails -> String
$cshowList :: [NamespaceDetails] -> ShowS
showList :: [NamespaceDetails] -> ShowS
Show)

instance Docs.ToSample NamespaceDetails where
  toSamples :: Proxy NamespaceDetails -> [(UnisonHash, NamespaceDetails)]
toSamples Proxy NamespaceDetails
_ =
    [ ( UnisonHash
"When no value is provided for `namespace`, the root namespace `.` is "
          UnisonHash -> UnisonHash -> UnisonHash
forall a. Semigroup a => a -> a -> a
<> UnisonHash
"listed by default",
        Path -> UnisonHash -> Maybe Doc -> NamespaceDetails
NamespaceDetails
          Path
Path.empty
          UnisonHash
"#gjlk0dna8dongct6lsd19d1o9hi5n642t8jttga5e81e91fviqjdffem0tlddj7ahodjo5"
          Maybe Doc
forall a. Maybe a
Nothing
      )
    ]

instance ToJSON NamespaceDetails where
  toJSON :: NamespaceDetails -> Value
toJSON NamespaceDetails {Maybe Doc
UnisonHash
Path
$sel:fqn:NamespaceDetails :: NamespaceDetails -> Path
$sel:hash:NamespaceDetails :: NamespaceDetails -> UnisonHash
$sel:readme:NamespaceDetails :: NamespaceDetails -> Maybe Doc
fqn :: Path
hash :: UnisonHash
readme :: Maybe Doc
..} =
    [Pair] -> Value
object
      [ Key
"fqn" Key -> Path -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Path
fqn,
        Key
"hash" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UnisonHash
hash,
        Key
"readme" Key -> Maybe Doc -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Doc
readme
      ]

deriving instance ToSchema NamespaceDetails

-- | A hash qualified name, unlike HashQualified, the hash is required
data ExactName name ref = ExactName
  { forall name ref. ExactName name ref -> name
name :: name,
    forall name ref. ExactName name ref -> ref
ref :: ref
  }
  deriving stock (Int -> ExactName name ref -> ShowS
[ExactName name ref] -> ShowS
ExactName name ref -> String
(Int -> ExactName name ref -> ShowS)
-> (ExactName name ref -> String)
-> ([ExactName name ref] -> ShowS)
-> Show (ExactName name ref)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name ref.
(Show name, Show ref) =>
Int -> ExactName name ref -> ShowS
forall name ref.
(Show name, Show ref) =>
[ExactName name ref] -> ShowS
forall name ref.
(Show name, Show ref) =>
ExactName name ref -> String
$cshowsPrec :: forall name ref.
(Show name, Show ref) =>
Int -> ExactName name ref -> ShowS
showsPrec :: Int -> ExactName name ref -> ShowS
$cshow :: forall name ref.
(Show name, Show ref) =>
ExactName name ref -> String
show :: ExactName name ref -> String
$cshowList :: forall name ref.
(Show name, Show ref) =>
[ExactName name ref] -> ShowS
showList :: [ExactName name ref] -> ShowS
Show, ExactName name ref -> ExactName name ref -> Bool
(ExactName name ref -> ExactName name ref -> Bool)
-> (ExactName name ref -> ExactName name ref -> Bool)
-> Eq (ExactName name ref)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall name ref.
(Eq name, Eq ref) =>
ExactName name ref -> ExactName name ref -> Bool
$c== :: forall name ref.
(Eq name, Eq ref) =>
ExactName name ref -> ExactName name ref -> Bool
== :: ExactName name ref -> ExactName name ref -> Bool
$c/= :: forall name ref.
(Eq name, Eq ref) =>
ExactName name ref -> ExactName name ref -> Bool
/= :: ExactName name ref -> ExactName name ref -> Bool
Eq, (forall a b. (a -> b) -> ExactName name a -> ExactName name b)
-> (forall a b. a -> ExactName name b -> ExactName name a)
-> Functor (ExactName name)
forall a b. a -> ExactName name b -> ExactName name a
forall a b. (a -> b) -> ExactName name a -> ExactName name b
forall name a b. a -> ExactName name b -> ExactName name a
forall name a b. (a -> b) -> ExactName name a -> ExactName name b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall name a b. (a -> b) -> ExactName name a -> ExactName name b
fmap :: forall a b. (a -> b) -> ExactName name a -> ExactName name b
$c<$ :: forall name a b. a -> ExactName name b -> ExactName name a
<$ :: forall a b. a -> ExactName name b -> ExactName name a
Functor, Eq (ExactName name ref)
Eq (ExactName name ref) =>
(ExactName name ref -> ExactName name ref -> Ordering)
-> (ExactName name ref -> ExactName name ref -> Bool)
-> (ExactName name ref -> ExactName name ref -> Bool)
-> (ExactName name ref -> ExactName name ref -> Bool)
-> (ExactName name ref -> ExactName name ref -> Bool)
-> (ExactName name ref -> ExactName name ref -> ExactName name ref)
-> (ExactName name ref -> ExactName name ref -> ExactName name ref)
-> Ord (ExactName name ref)
ExactName name ref -> ExactName name ref -> Bool
ExactName name ref -> ExactName name ref -> Ordering
ExactName name ref -> ExactName name ref -> ExactName name ref
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall name ref. (Ord name, Ord ref) => Eq (ExactName name ref)
forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Bool
forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Ordering
forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> ExactName name ref
$ccompare :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Ordering
compare :: ExactName name ref -> ExactName name ref -> Ordering
$c< :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Bool
< :: ExactName name ref -> ExactName name ref -> Bool
$c<= :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Bool
<= :: ExactName name ref -> ExactName name ref -> Bool
$c> :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Bool
> :: ExactName name ref -> ExactName name ref -> Bool
$c>= :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> Bool
>= :: ExactName name ref -> ExactName name ref -> Bool
$cmax :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> ExactName name ref
max :: ExactName name ref -> ExactName name ref -> ExactName name ref
$cmin :: forall name ref.
(Ord name, Ord ref) =>
ExactName name ref -> ExactName name ref -> ExactName name ref
min :: ExactName name ref -> ExactName name ref -> ExactName name ref
Ord)

instance ToParamSchema (ExactName Name ShortHash) where
  toParamSchema :: Proxy (ExactName Name ShortHash) -> Schema
toParamSchema Proxy (ExactName Name 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)
OpenApi.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)
OpenApi.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
?~ UnisonHash -> Value
Aeson.String UnisonHash
"base.List"

instance ToParam (QueryParam "exact-name" (ExactName Name ShortHash)) where
  toParam :: Proxy (QueryParam "exact-name" (ExactName Name ShortHash))
-> DocQueryParam
toParam Proxy (QueryParam "exact-name" (ExactName Name ShortHash))
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"exact-name"
      []
      String
"The fully qualified name of a namespace with a hash, denoted by a '@'. E.g. base.List.map@abc"
      ParamKind
Normal

instance Docs.ToCapture (Capture "fqn" (ExactName Name ShortHash)) where
  toCapture :: Proxy (Capture "fqn" (ExactName Name ShortHash)) -> DocCapture
toCapture Proxy (Capture "fqn" (ExactName Name ShortHash))
_ =
    String -> String -> DocCapture
DocCapture
      String
"fqn"
      String
"The fully qualified name of a namespace with a hash, denoted by a '@'. E.g. base.List.map@abc"

exactToHQ :: ExactName name ShortHash -> HQ.HashQualified name
exactToHQ :: forall name. ExactName name ShortHash -> HashQualified name
exactToHQ (ExactName {name
$sel:name:ExactName :: forall name ref. ExactName name ref -> name
name :: name
name, ShortHash
$sel:ref:ExactName :: forall name ref. ExactName name ref -> ref
ref :: ShortHash
ref}) = name -> ShortHash -> HashQualified name
forall n. n -> ShortHash -> HashQualified n
HQ.HashQualified name
name ShortHash
ref

exactToHQ' :: ExactName name ShortHash -> HQ'.HashQualified name
exactToHQ' :: forall name. ExactName name ShortHash -> HashQualified name
exactToHQ' (ExactName {name
$sel:name:ExactName :: forall name ref. ExactName name ref -> name
name :: name
name, ShortHash
$sel:ref:ExactName :: forall name ref. ExactName name ref -> ref
ref :: ShortHash
ref}) = name -> ShortHash -> HashQualified name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified name
name ShortHash
ref

instance Bifunctor ExactName where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> ExactName a c -> ExactName b d
bimap a -> b
l c -> d
r (ExactName a
a c
b) = b -> d -> ExactName b d
forall name ref. name -> ref -> ExactName name ref
ExactName (a -> b
l a
a) (c -> d
r c
b)

instance Bifoldable ExactName where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> ExactName a b -> m
bifoldMap a -> m
l b -> m
r (ExactName a
a b
b) = a -> m
l a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
r b
b

instance Bitraversable ExactName where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> ExactName a b -> f (ExactName c d)
bitraverse a -> f c
l b -> f d
r (ExactName a
a b
b) = c -> d -> ExactName c d
forall name ref. name -> ref -> ExactName name ref
ExactName (c -> d -> ExactName c d) -> f c -> f (d -> ExactName c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c
l a
a) f (d -> ExactName c d) -> f d -> f (ExactName c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (b -> f d
r b
b)

instance FromHttpApiData (ExactName Name ShortHash) where
  parseQueryParam :: UnisonHash -> Either UnisonHash (ExactName Name ShortHash)
parseQueryParam UnisonHash
txt =
    -- # is special in URLs, so we use @ for hash qualification instead;
    -- e.g. ".base.List.map@abc"
    -- e.g. ".base.Nat@@Nat"
    case UnisonHash -> Maybe (HashQualified Name)
HQ.parseText (HasCallStack =>
UnisonHash -> UnisonHash -> UnisonHash -> UnisonHash
UnisonHash -> UnisonHash -> UnisonHash -> UnisonHash
Text.replace UnisonHash
"@" UnisonHash
"#" UnisonHash
txt) of
      Maybe (HashQualified Name)
Nothing -> UnisonHash -> Either UnisonHash (ExactName Name ShortHash)
forall a b. a -> Either a b
Left UnisonHash
"Invalid absolute name with Hash"
      Just HashQualified Name
hq' -> case HashQualified Name
hq' of
        HQ.NameOnly Name
_ -> UnisonHash -> Either UnisonHash (ExactName Name ShortHash)
forall a b. a -> Either a b
Left UnisonHash
"A name and hash are required, but only a name was provided"
        HQ.HashOnly ShortHash
_ -> UnisonHash -> Either UnisonHash (ExactName Name ShortHash)
forall a b. a -> Either a b
Left UnisonHash
"A name and hash are required, but only a hash was provided"
        HQ.HashQualified Name
name ShortHash
ref -> ExactName Name ShortHash
-> Either UnisonHash (ExactName Name ShortHash)
forall a b. b -> Either a b
Right (ExactName Name ShortHash
 -> Either UnisonHash (ExactName Name ShortHash))
-> ExactName Name ShortHash
-> Either UnisonHash (ExactName Name ShortHash)
forall a b. (a -> b) -> a -> b
$ ExactName {Name
$sel:name:ExactName :: Name
name :: Name
name, ShortHash
$sel:ref:ExactName :: ShortHash
ref :: ShortHash
ref}

deriving via Bool instance FromHttpApiData Suffixify

deriving anyclass instance ToParamSchema Suffixify

instance ToJSON TypeDefinition where
  toJSON :: TypeDefinition -> Value
toJSON TypeDefinition {[(UnisonHash, UnisonHash, Doc)]
[UnisonHash]
UnisonHash
DisplayObject SyntaxText SyntaxText
TypeTag
typeNames :: [UnisonHash]
bestTypeName :: UnisonHash
defnTypeTag :: TypeTag
typeDefinition :: DisplayObject SyntaxText SyntaxText
typeDocs :: [(UnisonHash, UnisonHash, Doc)]
$sel:typeNames:TypeDefinition :: TypeDefinition -> [UnisonHash]
$sel:bestTypeName:TypeDefinition :: TypeDefinition -> UnisonHash
$sel:defnTypeTag:TypeDefinition :: TypeDefinition -> TypeTag
$sel:typeDefinition:TypeDefinition :: TypeDefinition -> DisplayObject SyntaxText SyntaxText
$sel:typeDocs:TypeDefinition :: TypeDefinition -> [(UnisonHash, UnisonHash, Doc)]
..} =
    [Pair] -> Value
object
      [ Key
"typeNames" Key -> [UnisonHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [UnisonHash]
typeNames,
        Key
"bestTypeName" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UnisonHash
bestTypeName,
        Key
"defnTypeTag" Key -> TypeTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeTag
defnTypeTag,
        Key
"typeDefinition" Key -> DisplayObject SyntaxText SyntaxText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DisplayObject SyntaxText SyntaxText
typeDefinition,
        Key
"typeDocs" Key -> [(UnisonHash, UnisonHash, Doc)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [(UnisonHash, UnisonHash, Doc)]
typeDocs
      ]

deriving instance ToSchema TypeDefinition

instance ToJSON TermDefinition where
  toJSON :: TermDefinition -> Value
toJSON TermDefinition {[(UnisonHash, UnisonHash, Doc)]
[UnisonHash]
UnisonHash
DisplayObject SyntaxText SyntaxText
SyntaxText
TermTag
termNames :: [UnisonHash]
bestTermName :: UnisonHash
defnTermTag :: TermTag
termDefinition :: DisplayObject SyntaxText SyntaxText
signature :: SyntaxText
termDocs :: [(UnisonHash, UnisonHash, Doc)]
$sel:termNames:TermDefinition :: TermDefinition -> [UnisonHash]
$sel:bestTermName:TermDefinition :: TermDefinition -> UnisonHash
$sel:defnTermTag:TermDefinition :: TermDefinition -> TermTag
$sel:termDefinition:TermDefinition :: TermDefinition -> DisplayObject SyntaxText SyntaxText
$sel:signature:TermDefinition :: TermDefinition -> SyntaxText
$sel:termDocs:TermDefinition :: TermDefinition -> [(UnisonHash, UnisonHash, Doc)]
..} =
    [Pair] -> Value
object
      [ Key
"termNames" Key -> [UnisonHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [UnisonHash]
termNames,
        Key
"bestTermName" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= UnisonHash
bestTermName,
        Key
"defnTermTag" Key -> TermTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermTag
defnTermTag,
        Key
"termDefinition" Key -> DisplayObject SyntaxText SyntaxText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DisplayObject SyntaxText SyntaxText
termDefinition,
        Key
"signature" Key -> SyntaxText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SyntaxText
signature,
        Key
"termDocs" Key -> [(UnisonHash, UnisonHash, Doc)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [(UnisonHash, UnisonHash, Doc)]
termDocs
      ]

deriving instance ToSchema TermDefinition

instance ToJSON DefinitionDisplayResults where
  toJSON :: DefinitionDisplayResults -> Value
toJSON DefinitionDisplayResults {[UnisonHash]
Map UnisonHash TypeDefinition
Map UnisonHash TermDefinition
termDefinitions :: Map UnisonHash TermDefinition
typeDefinitions :: Map UnisonHash TypeDefinition
missingDefinitions :: [UnisonHash]
$sel:termDefinitions:DefinitionDisplayResults :: DefinitionDisplayResults -> Map UnisonHash TermDefinition
$sel:typeDefinitions:DefinitionDisplayResults :: DefinitionDisplayResults -> Map UnisonHash TypeDefinition
$sel:missingDefinitions:DefinitionDisplayResults :: DefinitionDisplayResults -> [UnisonHash]
..} =
    [Pair] -> Value
object
      [ Key
"termDefinitions" Key -> Map UnisonHash TermDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Map UnisonHash TermDefinition
termDefinitions,
        Key
"typeDefinitions" Key -> Map UnisonHash TypeDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Map UnisonHash TypeDefinition
typeDefinitions,
        Key
"missingDefinitions" Key -> [UnisonHash] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [UnisonHash]
missingDefinitions
      ]

deriving instance ToSchema DefinitionDisplayResults

data TermDefinitionDiff = TermDefinitionDiff
  { TermDefinitionDiff -> TermDefinition
left :: TermDefinition,
    TermDefinitionDiff -> TermDefinition
right :: TermDefinition,
    TermDefinitionDiff -> DisplayObjectDiff
diff :: DisplayObjectDiff
  }
  deriving (TermDefinitionDiff -> TermDefinitionDiff -> Bool
(TermDefinitionDiff -> TermDefinitionDiff -> Bool)
-> (TermDefinitionDiff -> TermDefinitionDiff -> Bool)
-> Eq TermDefinitionDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermDefinitionDiff -> TermDefinitionDiff -> Bool
== :: TermDefinitionDiff -> TermDefinitionDiff -> Bool
$c/= :: TermDefinitionDiff -> TermDefinitionDiff -> Bool
/= :: TermDefinitionDiff -> TermDefinitionDiff -> Bool
Eq, Int -> TermDefinitionDiff -> ShowS
[TermDefinitionDiff] -> ShowS
TermDefinitionDiff -> String
(Int -> TermDefinitionDiff -> ShowS)
-> (TermDefinitionDiff -> String)
-> ([TermDefinitionDiff] -> ShowS)
-> Show TermDefinitionDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermDefinitionDiff -> ShowS
showsPrec :: Int -> TermDefinitionDiff -> ShowS
$cshow :: TermDefinitionDiff -> String
show :: TermDefinitionDiff -> String
$cshowList :: [TermDefinitionDiff] -> ShowS
showList :: [TermDefinitionDiff] -> ShowS
Show, (forall x. TermDefinitionDiff -> Rep TermDefinitionDiff x)
-> (forall x. Rep TermDefinitionDiff x -> TermDefinitionDiff)
-> Generic TermDefinitionDiff
forall x. Rep TermDefinitionDiff x -> TermDefinitionDiff
forall x. TermDefinitionDiff -> Rep TermDefinitionDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TermDefinitionDiff -> Rep TermDefinitionDiff x
from :: forall x. TermDefinitionDiff -> Rep TermDefinitionDiff x
$cto :: forall x. Rep TermDefinitionDiff x -> TermDefinitionDiff
to :: forall x. Rep TermDefinitionDiff x -> TermDefinitionDiff
Generic)

data TypeDefinitionDiff = TypeDefinitionDiff
  { TypeDefinitionDiff -> TypeDefinition
left :: TypeDefinition,
    TypeDefinitionDiff -> TypeDefinition
right :: TypeDefinition,
    TypeDefinitionDiff -> DisplayObjectDiff
diff :: DisplayObjectDiff
  }
  deriving (TypeDefinitionDiff -> TypeDefinitionDiff -> Bool
(TypeDefinitionDiff -> TypeDefinitionDiff -> Bool)
-> (TypeDefinitionDiff -> TypeDefinitionDiff -> Bool)
-> Eq TypeDefinitionDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDefinitionDiff -> TypeDefinitionDiff -> Bool
== :: TypeDefinitionDiff -> TypeDefinitionDiff -> Bool
$c/= :: TypeDefinitionDiff -> TypeDefinitionDiff -> Bool
/= :: TypeDefinitionDiff -> TypeDefinitionDiff -> Bool
Eq, Int -> TypeDefinitionDiff -> ShowS
[TypeDefinitionDiff] -> ShowS
TypeDefinitionDiff -> String
(Int -> TypeDefinitionDiff -> ShowS)
-> (TypeDefinitionDiff -> String)
-> ([TypeDefinitionDiff] -> ShowS)
-> Show TypeDefinitionDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDefinitionDiff -> ShowS
showsPrec :: Int -> TypeDefinitionDiff -> ShowS
$cshow :: TypeDefinitionDiff -> String
show :: TypeDefinitionDiff -> String
$cshowList :: [TypeDefinitionDiff] -> ShowS
showList :: [TypeDefinitionDiff] -> ShowS
Show, (forall x. TypeDefinitionDiff -> Rep TypeDefinitionDiff x)
-> (forall x. Rep TypeDefinitionDiff x -> TypeDefinitionDiff)
-> Generic TypeDefinitionDiff
forall x. Rep TypeDefinitionDiff x -> TypeDefinitionDiff
forall x. TypeDefinitionDiff -> Rep TypeDefinitionDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeDefinitionDiff -> Rep TypeDefinitionDiff x
from :: forall x. TypeDefinitionDiff -> Rep TypeDefinitionDiff x
$cto :: forall x. Rep TypeDefinitionDiff x -> TypeDefinitionDiff
to :: forall x. Rep TypeDefinitionDiff x -> TypeDefinitionDiff
Generic)

newtype Suffixify = Suffixify {Suffixify -> Bool
suffixified :: Bool}
  deriving (Suffixify -> Suffixify -> Bool
(Suffixify -> Suffixify -> Bool)
-> (Suffixify -> Suffixify -> Bool) -> Eq Suffixify
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Suffixify -> Suffixify -> Bool
== :: Suffixify -> Suffixify -> Bool
$c/= :: Suffixify -> Suffixify -> Bool
/= :: Suffixify -> Suffixify -> Bool
Eq, Eq Suffixify
Eq Suffixify =>
(Suffixify -> Suffixify -> Ordering)
-> (Suffixify -> Suffixify -> Bool)
-> (Suffixify -> Suffixify -> Bool)
-> (Suffixify -> Suffixify -> Bool)
-> (Suffixify -> Suffixify -> Bool)
-> (Suffixify -> Suffixify -> Suffixify)
-> (Suffixify -> Suffixify -> Suffixify)
-> Ord Suffixify
Suffixify -> Suffixify -> Bool
Suffixify -> Suffixify -> Ordering
Suffixify -> Suffixify -> Suffixify
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Suffixify -> Suffixify -> Ordering
compare :: Suffixify -> Suffixify -> Ordering
$c< :: Suffixify -> Suffixify -> Bool
< :: Suffixify -> Suffixify -> Bool
$c<= :: Suffixify -> Suffixify -> Bool
<= :: Suffixify -> Suffixify -> Bool
$c> :: Suffixify -> Suffixify -> Bool
> :: Suffixify -> Suffixify -> Bool
$c>= :: Suffixify -> Suffixify -> Bool
>= :: Suffixify -> Suffixify -> Bool
$cmax :: Suffixify -> Suffixify -> Suffixify
max :: Suffixify -> Suffixify -> Suffixify
$cmin :: Suffixify -> Suffixify -> Suffixify
min :: Suffixify -> Suffixify -> Suffixify
Ord, Int -> Suffixify -> ShowS
[Suffixify] -> ShowS
Suffixify -> String
(Int -> Suffixify -> ShowS)
-> (Suffixify -> String)
-> ([Suffixify] -> ShowS)
-> Show Suffixify
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Suffixify -> ShowS
showsPrec :: Int -> Suffixify -> ShowS
$cshow :: Suffixify -> String
show :: Suffixify -> String
$cshowList :: [Suffixify] -> ShowS
showList :: [Suffixify] -> ShowS
Show, (forall x. Suffixify -> Rep Suffixify x)
-> (forall x. Rep Suffixify x -> Suffixify) -> Generic Suffixify
forall x. Rep Suffixify x -> Suffixify
forall x. Suffixify -> Rep Suffixify x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Suffixify -> Rep Suffixify x
from :: forall x. Suffixify -> Rep Suffixify x
$cto :: forall x. Rep Suffixify x -> Suffixify
to :: forall x. Rep Suffixify x -> Suffixify
Generic)

data TermDefinition = TermDefinition
  { TermDefinition -> [UnisonHash]
termNames :: [HashQualifiedName],
    TermDefinition -> UnisonHash
bestTermName :: HashQualifiedName,
    TermDefinition -> TermTag
defnTermTag :: TermTag,
    TermDefinition -> DisplayObject SyntaxText SyntaxText
termDefinition :: DisplayObject Syntax.SyntaxText Syntax.SyntaxText,
    TermDefinition -> SyntaxText
signature :: Syntax.SyntaxText,
    TermDefinition -> [(UnisonHash, UnisonHash, Doc)]
termDocs :: [(HashQualifiedName, UnisonHash, Doc)]
  }
  deriving (TermDefinition -> TermDefinition -> Bool
(TermDefinition -> TermDefinition -> Bool)
-> (TermDefinition -> TermDefinition -> Bool) -> Eq TermDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermDefinition -> TermDefinition -> Bool
== :: TermDefinition -> TermDefinition -> Bool
$c/= :: TermDefinition -> TermDefinition -> Bool
/= :: TermDefinition -> TermDefinition -> Bool
Eq, Int -> TermDefinition -> ShowS
[TermDefinition] -> ShowS
TermDefinition -> String
(Int -> TermDefinition -> ShowS)
-> (TermDefinition -> String)
-> ([TermDefinition] -> ShowS)
-> Show TermDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermDefinition -> ShowS
showsPrec :: Int -> TermDefinition -> ShowS
$cshow :: TermDefinition -> String
show :: TermDefinition -> String
$cshowList :: [TermDefinition] -> ShowS
showList :: [TermDefinition] -> ShowS
Show, (forall x. TermDefinition -> Rep TermDefinition x)
-> (forall x. Rep TermDefinition x -> TermDefinition)
-> Generic TermDefinition
forall x. Rep TermDefinition x -> TermDefinition
forall x. TermDefinition -> Rep TermDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TermDefinition -> Rep TermDefinition x
from :: forall x. TermDefinition -> Rep TermDefinition x
$cto :: forall x. Rep TermDefinition x -> TermDefinition
to :: forall x. Rep TermDefinition x -> TermDefinition
Generic)

data TypeDefinition = TypeDefinition
  { TypeDefinition -> [UnisonHash]
typeNames :: [HashQualifiedName],
    TypeDefinition -> UnisonHash
bestTypeName :: HashQualifiedName,
    TypeDefinition -> TypeTag
defnTypeTag :: TypeTag,
    TypeDefinition -> DisplayObject SyntaxText SyntaxText
typeDefinition :: DisplayObject Syntax.SyntaxText Syntax.SyntaxText,
    TypeDefinition -> [(UnisonHash, UnisonHash, Doc)]
typeDocs :: [(HashQualifiedName, UnisonHash, Doc)]
  }
  deriving (TypeDefinition -> TypeDefinition -> Bool
(TypeDefinition -> TypeDefinition -> Bool)
-> (TypeDefinition -> TypeDefinition -> Bool) -> Eq TypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDefinition -> TypeDefinition -> Bool
== :: TypeDefinition -> TypeDefinition -> Bool
$c/= :: TypeDefinition -> TypeDefinition -> Bool
/= :: TypeDefinition -> TypeDefinition -> Bool
Eq, Int -> TypeDefinition -> ShowS
[TypeDefinition] -> ShowS
TypeDefinition -> String
(Int -> TypeDefinition -> ShowS)
-> (TypeDefinition -> String)
-> ([TypeDefinition] -> ShowS)
-> Show TypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDefinition -> ShowS
showsPrec :: Int -> TypeDefinition -> ShowS
$cshow :: TypeDefinition -> String
show :: TypeDefinition -> String
$cshowList :: [TypeDefinition] -> ShowS
showList :: [TypeDefinition] -> ShowS
Show, (forall x. TypeDefinition -> Rep TypeDefinition x)
-> (forall x. Rep TypeDefinition x -> TypeDefinition)
-> Generic TypeDefinition
forall x. Rep TypeDefinition x -> TypeDefinition
forall x. TypeDefinition -> Rep TypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeDefinition -> Rep TypeDefinition x
from :: forall x. TypeDefinition -> Rep TypeDefinition x
$cto :: forall x. Rep TypeDefinition x -> TypeDefinition
to :: forall x. Rep TypeDefinition x -> TypeDefinition
Generic)

data DefinitionDisplayResults = DefinitionDisplayResults
  { DefinitionDisplayResults -> Map UnisonHash TermDefinition
termDefinitions :: Map UnisonHash TermDefinition,
    DefinitionDisplayResults -> Map UnisonHash TypeDefinition
typeDefinitions :: Map UnisonHash TypeDefinition,
    DefinitionDisplayResults -> [UnisonHash]
missingDefinitions :: [HashQualifiedName]
  }
  deriving (DefinitionDisplayResults -> DefinitionDisplayResults -> Bool
(DefinitionDisplayResults -> DefinitionDisplayResults -> Bool)
-> (DefinitionDisplayResults -> DefinitionDisplayResults -> Bool)
-> Eq DefinitionDisplayResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefinitionDisplayResults -> DefinitionDisplayResults -> Bool
== :: DefinitionDisplayResults -> DefinitionDisplayResults -> Bool
$c/= :: DefinitionDisplayResults -> DefinitionDisplayResults -> Bool
/= :: DefinitionDisplayResults -> DefinitionDisplayResults -> Bool
Eq, Int -> DefinitionDisplayResults -> ShowS
[DefinitionDisplayResults] -> ShowS
DefinitionDisplayResults -> String
(Int -> DefinitionDisplayResults -> ShowS)
-> (DefinitionDisplayResults -> String)
-> ([DefinitionDisplayResults] -> ShowS)
-> Show DefinitionDisplayResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefinitionDisplayResults -> ShowS
showsPrec :: Int -> DefinitionDisplayResults -> ShowS
$cshow :: DefinitionDisplayResults -> String
show :: DefinitionDisplayResults -> String
$cshowList :: [DefinitionDisplayResults] -> ShowS
showList :: [DefinitionDisplayResults] -> ShowS
Show, (forall x.
 DefinitionDisplayResults -> Rep DefinitionDisplayResults x)
-> (forall x.
    Rep DefinitionDisplayResults x -> DefinitionDisplayResults)
-> Generic DefinitionDisplayResults
forall x.
Rep DefinitionDisplayResults x -> DefinitionDisplayResults
forall x.
DefinitionDisplayResults -> Rep DefinitionDisplayResults x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
DefinitionDisplayResults -> Rep DefinitionDisplayResults x
from :: forall x.
DefinitionDisplayResults -> Rep DefinitionDisplayResults x
$cto :: forall x.
Rep DefinitionDisplayResults x -> DefinitionDisplayResults
to :: forall x.
Rep DefinitionDisplayResults x -> DefinitionDisplayResults
Generic)

instance Semigroup DefinitionDisplayResults where
  DefinitionDisplayResults Map UnisonHash TermDefinition
terms1 Map UnisonHash TypeDefinition
types1 [UnisonHash]
missing1 <> :: DefinitionDisplayResults
-> DefinitionDisplayResults -> DefinitionDisplayResults
<> DefinitionDisplayResults Map UnisonHash TermDefinition
terms2 Map UnisonHash TypeDefinition
types2 [UnisonHash]
missing2 =
    Map UnisonHash TermDefinition
-> Map UnisonHash TypeDefinition
-> [UnisonHash]
-> DefinitionDisplayResults
DefinitionDisplayResults (Map UnisonHash TermDefinition
terms1 Map UnisonHash TermDefinition
-> Map UnisonHash TermDefinition -> Map UnisonHash TermDefinition
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map UnisonHash TermDefinition
terms2) (Map UnisonHash TypeDefinition
types1 Map UnisonHash TypeDefinition
-> Map UnisonHash TypeDefinition -> Map UnisonHash TypeDefinition
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map UnisonHash TypeDefinition
types2) ([UnisonHash]
missing1 [UnisonHash] -> [UnisonHash] -> [UnisonHash]
forall a. [a] -> [a] -> [a]
++ [UnisonHash]
missing2)

instance Monoid DefinitionDisplayResults where
  mempty :: DefinitionDisplayResults
mempty = Map UnisonHash TermDefinition
-> Map UnisonHash TypeDefinition
-> [UnisonHash]
-> DefinitionDisplayResults
DefinitionDisplayResults Map UnisonHash TermDefinition
forall a. Monoid a => a
mempty Map UnisonHash TypeDefinition
forall a. Monoid a => a
mempty [UnisonHash]
forall a. Monoid a => a
mempty

data TermTag = Doc | Test | Plain | Constructor TypeTag
  deriving (TermTag -> TermTag -> Bool
(TermTag -> TermTag -> Bool)
-> (TermTag -> TermTag -> Bool) -> Eq TermTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermTag -> TermTag -> Bool
== :: TermTag -> TermTag -> Bool
$c/= :: TermTag -> TermTag -> Bool
/= :: TermTag -> TermTag -> Bool
Eq, Eq TermTag
Eq TermTag =>
(TermTag -> TermTag -> Ordering)
-> (TermTag -> TermTag -> Bool)
-> (TermTag -> TermTag -> Bool)
-> (TermTag -> TermTag -> Bool)
-> (TermTag -> TermTag -> Bool)
-> (TermTag -> TermTag -> TermTag)
-> (TermTag -> TermTag -> TermTag)
-> Ord TermTag
TermTag -> TermTag -> Bool
TermTag -> TermTag -> Ordering
TermTag -> TermTag -> TermTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TermTag -> TermTag -> Ordering
compare :: TermTag -> TermTag -> Ordering
$c< :: TermTag -> TermTag -> Bool
< :: TermTag -> TermTag -> Bool
$c<= :: TermTag -> TermTag -> Bool
<= :: TermTag -> TermTag -> Bool
$c> :: TermTag -> TermTag -> Bool
> :: TermTag -> TermTag -> Bool
$c>= :: TermTag -> TermTag -> Bool
>= :: TermTag -> TermTag -> Bool
$cmax :: TermTag -> TermTag -> TermTag
max :: TermTag -> TermTag -> TermTag
$cmin :: TermTag -> TermTag -> TermTag
min :: TermTag -> TermTag -> TermTag
Ord, Int -> TermTag -> ShowS
[TermTag] -> ShowS
TermTag -> String
(Int -> TermTag -> ShowS)
-> (TermTag -> String) -> ([TermTag] -> ShowS) -> Show TermTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermTag -> ShowS
showsPrec :: Int -> TermTag -> ShowS
$cshow :: TermTag -> String
show :: TermTag -> String
$cshowList :: [TermTag] -> ShowS
showList :: [TermTag] -> ShowS
Show, (forall x. TermTag -> Rep TermTag x)
-> (forall x. Rep TermTag x -> TermTag) -> Generic TermTag
forall x. Rep TermTag x -> TermTag
forall x. TermTag -> Rep TermTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TermTag -> Rep TermTag x
from :: forall x. TermTag -> Rep TermTag x
$cto :: forall x. Rep TermTag x -> TermTag
to :: forall x. Rep TermTag x -> TermTag
Generic)

data TypeTag = Ability | Data
  deriving (TypeTag -> TypeTag -> Bool
(TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool) -> Eq TypeTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeTag -> TypeTag -> Bool
== :: TypeTag -> TypeTag -> Bool
$c/= :: TypeTag -> TypeTag -> Bool
/= :: TypeTag -> TypeTag -> Bool
Eq, Eq TypeTag
Eq TypeTag =>
(TypeTag -> TypeTag -> Ordering)
-> (TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> Bool)
-> (TypeTag -> TypeTag -> TypeTag)
-> (TypeTag -> TypeTag -> TypeTag)
-> Ord TypeTag
TypeTag -> TypeTag -> Bool
TypeTag -> TypeTag -> Ordering
TypeTag -> TypeTag -> TypeTag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeTag -> TypeTag -> Ordering
compare :: TypeTag -> TypeTag -> Ordering
$c< :: TypeTag -> TypeTag -> Bool
< :: TypeTag -> TypeTag -> Bool
$c<= :: TypeTag -> TypeTag -> Bool
<= :: TypeTag -> TypeTag -> Bool
$c> :: TypeTag -> TypeTag -> Bool
> :: TypeTag -> TypeTag -> Bool
$c>= :: TypeTag -> TypeTag -> Bool
>= :: TypeTag -> TypeTag -> Bool
$cmax :: TypeTag -> TypeTag -> TypeTag
max :: TypeTag -> TypeTag -> TypeTag
$cmin :: TypeTag -> TypeTag -> TypeTag
min :: TypeTag -> TypeTag -> TypeTag
Ord, Int -> TypeTag -> ShowS
[TypeTag] -> ShowS
TypeTag -> String
(Int -> TypeTag -> ShowS)
-> (TypeTag -> String) -> ([TypeTag] -> ShowS) -> Show TypeTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeTag -> ShowS
showsPrec :: Int -> TypeTag -> ShowS
$cshow :: TypeTag -> String
show :: TypeTag -> String
$cshowList :: [TypeTag] -> ShowS
showList :: [TypeTag] -> ShowS
Show, (forall x. TypeTag -> Rep TypeTag x)
-> (forall x. Rep TypeTag x -> TypeTag) -> Generic TypeTag
forall x. Rep TypeTag x -> TypeTag
forall x. TypeTag -> Rep TypeTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeTag -> Rep TypeTag x
from :: forall x. TypeTag -> Rep TypeTag x
$cto :: forall x. Rep TypeTag x -> TypeTag
to :: forall x. Rep TypeTag x -> TypeTag
Generic)

-- | A type for semantic diffing of definitions.
-- Includes special-cases for when the name in a definition has changed but the hash hasn't
-- (rename/alias), and when the hash has changed but the name hasn't (update propagation).
data SemanticSyntaxDiff
  = Old [Syntax.SyntaxSegment]
  | New [Syntax.SyntaxSegment]
  | Both [Syntax.SyntaxSegment]
  | --  (fromSegment, toSegment) (shared annotation)
    SegmentChange (String, String) (Maybe Syntax.Element)
  | -- (shared segment) (fromAnnotation, toAnnotation)
    AnnotationChange String (Maybe Syntax.Element, Maybe Syntax.Element)
  deriving (SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool
(SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool)
-> (SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool)
-> Eq SemanticSyntaxDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool
== :: SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool
$c/= :: SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool
/= :: SemanticSyntaxDiff -> SemanticSyntaxDiff -> Bool
Eq, Int -> SemanticSyntaxDiff -> ShowS
[SemanticSyntaxDiff] -> ShowS
SemanticSyntaxDiff -> String
(Int -> SemanticSyntaxDiff -> ShowS)
-> (SemanticSyntaxDiff -> String)
-> ([SemanticSyntaxDiff] -> ShowS)
-> Show SemanticSyntaxDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SemanticSyntaxDiff -> ShowS
showsPrec :: Int -> SemanticSyntaxDiff -> ShowS
$cshow :: SemanticSyntaxDiff -> String
show :: SemanticSyntaxDiff -> String
$cshowList :: [SemanticSyntaxDiff] -> ShowS
showList :: [SemanticSyntaxDiff] -> ShowS
Show, (forall x. SemanticSyntaxDiff -> Rep SemanticSyntaxDiff x)
-> (forall x. Rep SemanticSyntaxDiff x -> SemanticSyntaxDiff)
-> Generic SemanticSyntaxDiff
forall x. Rep SemanticSyntaxDiff x -> SemanticSyntaxDiff
forall x. SemanticSyntaxDiff -> Rep SemanticSyntaxDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SemanticSyntaxDiff -> Rep SemanticSyntaxDiff x
from :: forall x. SemanticSyntaxDiff -> Rep SemanticSyntaxDiff x
$cto :: forall x. Rep SemanticSyntaxDiff x -> SemanticSyntaxDiff
to :: forall x. Rep SemanticSyntaxDiff x -> SemanticSyntaxDiff
Generic)

deriving instance ToSchema SemanticSyntaxDiff

instance ToJSON SemanticSyntaxDiff where
  toJSON :: SemanticSyntaxDiff -> Value
toJSON = \case
    Old [SyntaxSegment]
segments ->
      [Pair] -> Value
object
        [ Key
"diffTag" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"old" :: Text),
          Key
"elements" Key -> [SyntaxSegment] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [SyntaxSegment]
segments
        ]
    New [SyntaxSegment]
segments ->
      [Pair] -> Value
object
        [ Key
"diffTag" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"new" :: Text),
          Key
"elements" Key -> [SyntaxSegment] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [SyntaxSegment]
segments
        ]
    Both [SyntaxSegment]
segments ->
      [Pair] -> Value
object
        [ Key
"diffTag" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"both" :: Text),
          Key
"elements" Key -> [SyntaxSegment] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [SyntaxSegment]
segments
        ]
    SegmentChange (String
fromSegment, String
toSegment) Maybe Element
annotation ->
      [Pair] -> Value
object
        [ Key
"diffTag" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"segmentChange" :: Text),
          Key
"fromSegment" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
fromSegment,
          Key
"toSegment" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
toSegment,
          Key
"annotation" Key -> Maybe Element -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Element
annotation
        ]
    AnnotationChange String
segment (Maybe Element
fromAnnotation, Maybe Element
toAnnotation) ->
      [Pair] -> Value
object
        [ Key
"diffTag" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"annotationChange" :: Text),
          Key
"segment" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= String
segment,
          Key
"fromAnnotation" Key -> Maybe Element -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Element
fromAnnotation,
          Key
"toAnnotation" Key -> Maybe Element -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Element
toAnnotation
        ]

-- | A diff of the syntax of a term or type
--
-- It doesn't make sense to diff builtins with ABTs, so in that case we just provide the
-- undiffed syntax.
data DisplayObjectDiff
  = DisplayObjectDiff (DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff])
  | MismatchedDisplayObjects (DisplayObject Syntax.SyntaxText Syntax.SyntaxText) (DisplayObject Syntax.SyntaxText Syntax.SyntaxText)
  deriving stock (Int -> DisplayObjectDiff -> ShowS
[DisplayObjectDiff] -> ShowS
DisplayObjectDiff -> String
(Int -> DisplayObjectDiff -> ShowS)
-> (DisplayObjectDiff -> String)
-> ([DisplayObjectDiff] -> ShowS)
-> Show DisplayObjectDiff
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayObjectDiff -> ShowS
showsPrec :: Int -> DisplayObjectDiff -> ShowS
$cshow :: DisplayObjectDiff -> String
show :: DisplayObjectDiff -> String
$cshowList :: [DisplayObjectDiff] -> ShowS
showList :: [DisplayObjectDiff] -> ShowS
Show, DisplayObjectDiff -> DisplayObjectDiff -> Bool
(DisplayObjectDiff -> DisplayObjectDiff -> Bool)
-> (DisplayObjectDiff -> DisplayObjectDiff -> Bool)
-> Eq DisplayObjectDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplayObjectDiff -> DisplayObjectDiff -> Bool
== :: DisplayObjectDiff -> DisplayObjectDiff -> Bool
$c/= :: DisplayObjectDiff -> DisplayObjectDiff -> Bool
/= :: DisplayObjectDiff -> DisplayObjectDiff -> Bool
Eq, (forall x. DisplayObjectDiff -> Rep DisplayObjectDiff x)
-> (forall x. Rep DisplayObjectDiff x -> DisplayObjectDiff)
-> Generic DisplayObjectDiff
forall x. Rep DisplayObjectDiff x -> DisplayObjectDiff
forall x. DisplayObjectDiff -> Rep DisplayObjectDiff x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DisplayObjectDiff -> Rep DisplayObjectDiff x
from :: forall x. DisplayObjectDiff -> Rep DisplayObjectDiff x
$cto :: forall x. Rep DisplayObjectDiff x -> DisplayObjectDiff
to :: forall x. Rep DisplayObjectDiff x -> DisplayObjectDiff
Generic)

deriving instance ToSchema DisplayObjectDiff

data UnisonRef
  = TypeRef UnisonHash
  | TermRef UnisonHash
  deriving (UnisonRef -> UnisonRef -> Bool
(UnisonRef -> UnisonRef -> Bool)
-> (UnisonRef -> UnisonRef -> Bool) -> Eq UnisonRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnisonRef -> UnisonRef -> Bool
== :: UnisonRef -> UnisonRef -> Bool
$c/= :: UnisonRef -> UnisonRef -> Bool
/= :: UnisonRef -> UnisonRef -> Bool
Eq, Eq UnisonRef
Eq UnisonRef =>
(UnisonRef -> UnisonRef -> Ordering)
-> (UnisonRef -> UnisonRef -> Bool)
-> (UnisonRef -> UnisonRef -> Bool)
-> (UnisonRef -> UnisonRef -> Bool)
-> (UnisonRef -> UnisonRef -> Bool)
-> (UnisonRef -> UnisonRef -> UnisonRef)
-> (UnisonRef -> UnisonRef -> UnisonRef)
-> Ord UnisonRef
UnisonRef -> UnisonRef -> Bool
UnisonRef -> UnisonRef -> Ordering
UnisonRef -> UnisonRef -> UnisonRef
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnisonRef -> UnisonRef -> Ordering
compare :: UnisonRef -> UnisonRef -> Ordering
$c< :: UnisonRef -> UnisonRef -> Bool
< :: UnisonRef -> UnisonRef -> Bool
$c<= :: UnisonRef -> UnisonRef -> Bool
<= :: UnisonRef -> UnisonRef -> Bool
$c> :: UnisonRef -> UnisonRef -> Bool
> :: UnisonRef -> UnisonRef -> Bool
$c>= :: UnisonRef -> UnisonRef -> Bool
>= :: UnisonRef -> UnisonRef -> Bool
$cmax :: UnisonRef -> UnisonRef -> UnisonRef
max :: UnisonRef -> UnisonRef -> UnisonRef
$cmin :: UnisonRef -> UnisonRef -> UnisonRef
min :: UnisonRef -> UnisonRef -> UnisonRef
Ord, Int -> UnisonRef -> ShowS
[UnisonRef] -> ShowS
UnisonRef -> String
(Int -> UnisonRef -> ShowS)
-> (UnisonRef -> String)
-> ([UnisonRef] -> ShowS)
-> Show UnisonRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnisonRef -> ShowS
showsPrec :: Int -> UnisonRef -> ShowS
$cshow :: UnisonRef -> String
show :: UnisonRef -> String
$cshowList :: [UnisonRef] -> ShowS
showList :: [UnisonRef] -> ShowS
Show, (forall x. UnisonRef -> Rep UnisonRef x)
-> (forall x. Rep UnisonRef x -> UnisonRef) -> Generic UnisonRef
forall x. Rep UnisonRef x -> UnisonRef
forall x. UnisonRef -> Rep UnisonRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UnisonRef -> Rep UnisonRef x
from :: forall x. UnisonRef -> Rep UnisonRef x
$cto :: forall x. Rep UnisonRef x -> UnisonRef
to :: forall x. Rep UnisonRef x -> UnisonRef
Generic)

unisonRefToText :: UnisonRef -> Text
unisonRefToText :: UnisonRef -> UnisonHash
unisonRefToText = \case
  TypeRef UnisonHash
r -> UnisonHash
r
  TermRef UnisonHash
r -> UnisonHash
r

data NamedTerm = NamedTerm
  { -- The name of the term, should be hash qualified if conflicted, otherwise name only.
    NamedTerm -> HashQualified Name
termName :: HQ'.HashQualified Name,
    NamedTerm -> ShortHash
termHash :: ShortHash,
    NamedTerm -> Maybe SyntaxText
termType :: Maybe Syntax.SyntaxText,
    NamedTerm -> TermTag
termTag :: TermTag
  }
  deriving (NamedTerm -> NamedTerm -> Bool
(NamedTerm -> NamedTerm -> Bool)
-> (NamedTerm -> NamedTerm -> Bool) -> Eq NamedTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedTerm -> NamedTerm -> Bool
== :: NamedTerm -> NamedTerm -> Bool
$c/= :: NamedTerm -> NamedTerm -> Bool
/= :: NamedTerm -> NamedTerm -> Bool
Eq, (forall x. NamedTerm -> Rep NamedTerm x)
-> (forall x. Rep NamedTerm x -> NamedTerm) -> Generic NamedTerm
forall x. Rep NamedTerm x -> NamedTerm
forall x. NamedTerm -> Rep NamedTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedTerm -> Rep NamedTerm x
from :: forall x. NamedTerm -> Rep NamedTerm x
$cto :: forall x. Rep NamedTerm x -> NamedTerm
to :: forall x. Rep NamedTerm x -> NamedTerm
Generic, Int -> NamedTerm -> ShowS
[NamedTerm] -> ShowS
NamedTerm -> String
(Int -> NamedTerm -> ShowS)
-> (NamedTerm -> String)
-> ([NamedTerm] -> ShowS)
-> Show NamedTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedTerm -> ShowS
showsPrec :: Int -> NamedTerm -> ShowS
$cshow :: NamedTerm -> String
show :: NamedTerm -> String
$cshowList :: [NamedTerm] -> ShowS
showList :: [NamedTerm] -> ShowS
Show)

instance ToJSON NamedTerm where
  toJSON :: NamedTerm -> Value
toJSON (NamedTerm HashQualified Name
n ShortHash
h Maybe SyntaxText
typ TermTag
tag) =
    [Pair] -> Value
Aeson.object
      [ Key
"termName" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Name -> UnisonHash) -> HashQualified Name -> UnisonHash
forall n. (n -> UnisonHash) -> HashQualified n -> UnisonHash
HQ'.toTextWith Name -> UnisonHash
Name.toText HashQualified Name
n,
        Key
"termHash" Key -> ShortHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ShortHash
h,
        Key
"termType" Key -> Maybe SyntaxText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe SyntaxText
typ,
        Key
"termTag" Key -> TermTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermTag
tag
      ]

instance FromJSON NamedTerm where
  parseJSON :: Value -> Parser NamedTerm
parseJSON = String -> (Object -> Parser NamedTerm) -> Value -> Parser NamedTerm
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NamedTerm" \Object
obj -> do
    HashQualified Name
termName <- Object
obj Object -> Key -> Parser (HashQualified Name)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"termName"
    ShortHash
termHash <- Object
obj Object -> Key -> Parser ShortHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"termHash"
    Maybe SyntaxText
termType <- Object
obj Object -> Key -> Parser (Maybe SyntaxText)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"termType"
    TermTag
termTag <- Object
obj Object -> Key -> Parser TermTag
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"termTag"
    NamedTerm -> Parser NamedTerm
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedTerm -> Parser NamedTerm) -> NamedTerm -> Parser NamedTerm
forall a b. (a -> b) -> a -> b
$ NamedTerm {Maybe SyntaxText
ShortHash
HashQualified Name
TermTag
$sel:termName:NamedTerm :: HashQualified Name
$sel:termHash:NamedTerm :: ShortHash
$sel:termType:NamedTerm :: Maybe SyntaxText
$sel:termTag:NamedTerm :: TermTag
termName :: HashQualified Name
termHash :: ShortHash
termType :: Maybe SyntaxText
termTag :: TermTag
..}

deriving instance ToSchema NamedTerm

data NamedType = NamedType
  { NamedType -> HashQualified Name
typeName :: HQ'.HashQualified Name,
    NamedType -> ShortHash
typeHash :: ShortHash,
    NamedType -> TypeTag
typeTag :: TypeTag
  }
  deriving (NamedType -> NamedType -> Bool
(NamedType -> NamedType -> Bool)
-> (NamedType -> NamedType -> Bool) -> Eq NamedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedType -> NamedType -> Bool
== :: NamedType -> NamedType -> Bool
$c/= :: NamedType -> NamedType -> Bool
/= :: NamedType -> NamedType -> Bool
Eq, (forall x. NamedType -> Rep NamedType x)
-> (forall x. Rep NamedType x -> NamedType) -> Generic NamedType
forall x. Rep NamedType x -> NamedType
forall x. NamedType -> Rep NamedType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedType -> Rep NamedType x
from :: forall x. NamedType -> Rep NamedType x
$cto :: forall x. Rep NamedType x -> NamedType
to :: forall x. Rep NamedType x -> NamedType
Generic, Int -> NamedType -> ShowS
[NamedType] -> ShowS
NamedType -> String
(Int -> NamedType -> ShowS)
-> (NamedType -> String)
-> ([NamedType] -> ShowS)
-> Show NamedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedType -> ShowS
showsPrec :: Int -> NamedType -> ShowS
$cshow :: NamedType -> String
show :: NamedType -> String
$cshowList :: [NamedType] -> ShowS
showList :: [NamedType] -> ShowS
Show)

instance ToJSON NamedType where
  toJSON :: NamedType -> Value
toJSON (NamedType HashQualified Name
n ShortHash
h TypeTag
tag) =
    [Pair] -> Value
Aeson.object
      [ Key
"typeName" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Name -> UnisonHash) -> HashQualified Name -> UnisonHash
forall n. (n -> UnisonHash) -> HashQualified n -> UnisonHash
HQ'.toTextWith Name -> UnisonHash
Name.toText HashQualified Name
n,
        Key
"typeHash" Key -> ShortHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ShortHash
h,
        Key
"typeTag" Key -> TypeTag -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeTag
tag
      ]

instance FromJSON NamedType where
  parseJSON :: Value -> Parser NamedType
parseJSON = String -> (Object -> Parser NamedType) -> Value -> Parser NamedType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NamedType" \Object
obj -> do
    HashQualified Name
typeName <- Object
obj Object -> Key -> Parser (HashQualified Name)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeName"
    ShortHash
typeHash <- Object
obj Object -> Key -> Parser ShortHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeHash"
    TypeTag
typeTag <- Object
obj Object -> Key -> Parser TypeTag
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeTag"
    NamedType -> Parser NamedType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedType -> Parser NamedType) -> NamedType -> Parser NamedType
forall a b. (a -> b) -> a -> b
$ NamedType {ShortHash
HashQualified Name
TypeTag
$sel:typeName:NamedType :: HashQualified Name
$sel:typeHash:NamedType :: ShortHash
$sel:typeTag:NamedType :: TypeTag
typeName :: HashQualified Name
typeHash :: ShortHash
typeTag :: TypeTag
..}

deriving instance ToSchema NamedType

instance ToJSON TermTag where
  toJSON :: TermTag -> Value
toJSON = \case
    TermTag
Doc -> Value
"Doc"
    TermTag
Test -> Value
"Test"
    TermTag
Plain -> Value
"Plain"
    Constructor TypeTag
tt -> case TypeTag
tt of
      TypeTag
Ability -> Value
"AbilityConstructor"
      TypeTag
Data -> Value
"DataConstructor"

instance FromJSON TermTag where
  parseJSON :: Value -> Parser TermTag
parseJSON Value
Null = TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermTag
Plain
  parseJSON Value
v =
    Value
v
      Value -> (Value -> Parser TermTag) -> Parser TermTag
forall a b. a -> (a -> b) -> b
& String -> (UnisonHash -> Parser TermTag) -> Value -> Parser TermTag
forall a. String -> (UnisonHash -> Parser a) -> Value -> Parser a
Aeson.withText String
"TermTag" \case
        UnisonHash
"Doc" -> TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermTag
Doc
        UnisonHash
"Test" -> TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermTag
Test
        UnisonHash
"Plain" -> TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TermTag
Plain
        UnisonHash
"AbilityConstructor" -> TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermTag -> Parser TermTag) -> TermTag -> Parser TermTag
forall a b. (a -> b) -> a -> b
$ TypeTag -> TermTag
Constructor TypeTag
Ability
        UnisonHash
"DataConstructor" -> TermTag -> Parser TermTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermTag -> Parser TermTag) -> TermTag -> Parser TermTag
forall a b. (a -> b) -> a -> b
$ TypeTag -> TermTag
Constructor TypeTag
Data
        UnisonHash
txt -> String -> Parser TermTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TermTag) -> String -> Parser TermTag
forall a b. (a -> b) -> a -> b
$ String
"Invalid TermTag" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnisonHash -> String
Text.unpack UnisonHash
txt

deriving instance ToSchema TermTag

instance ToJSON TypeTag where
  toJSON :: TypeTag -> Value
toJSON = \case
    TypeTag
Ability -> Value
"Ability"
    TypeTag
Data -> Value
"Data"

instance FromJSON TypeTag where
  parseJSON :: Value -> Parser TypeTag
parseJSON = String -> (UnisonHash -> Parser TypeTag) -> Value -> Parser TypeTag
forall a. String -> (UnisonHash -> Parser a) -> Value -> Parser a
Aeson.withText String
"TypeTag" \case
    UnisonHash
"Ability" -> TypeTag -> Parser TypeTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeTag
Ability
    UnisonHash
"Data" -> TypeTag -> Parser TypeTag
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeTag
Data
    UnisonHash
txt -> String -> Parser TypeTag
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TypeTag) -> String -> Parser TypeTag
forall a b. (a -> b) -> a -> b
$ String
"Invalid TypeTag" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnisonHash -> String
Text.unpack UnisonHash
txt

deriving instance ToSchema TypeTag

-- Helpers

munge :: Text -> LZ.ByteString
munge :: UnisonHash -> ByteString
munge = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString)
-> (UnisonHash -> Text) -> UnisonHash -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnisonHash -> Text
Text.Lazy.fromStrict

mungeShow :: (Show s) => s -> LZ.ByteString
mungeShow :: forall s. Show s => s -> ByteString
mungeShow = String -> ByteString
mungeString (String -> ByteString) -> (s -> String) -> s -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> String
forall a. Show a => a -> String
show

mungeString :: String -> LZ.ByteString
mungeString :: String -> ByteString
mungeString = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.Lazy.pack

defaultWidth :: Width
defaultWidth :: Width
defaultWidth = Width
80

discard :: (Applicative m) => a -> m ()
discard :: forall (m :: * -> *) a. Applicative m => a -> m ()
discard = m () -> a -> m ()
forall a b. a -> b -> a
const (m () -> a -> m ()) -> m () -> a -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

mayDefaultWidth :: Maybe Width -> Width
mayDefaultWidth :: Maybe Width -> Width
mayDefaultWidth = Width -> Maybe Width -> Width
forall a. a -> Maybe a -> a
fromMaybe Width
defaultWidth

setCacheControl :: v -> APIHeaders v
setCacheControl :: forall v. v -> APIHeaders v
setCacheControl = forall (h :: Symbol) v orig new.
AddHeader h v orig new =>
v -> orig -> new
addHeader @"Cache-Control" String
"public"

branchToUnisonHash :: Branch.Branch m -> UnisonHash
branchToUnisonHash :: forall (m :: * -> *). Branch m -> UnisonHash
branchToUnisonHash Branch m
b =
  (UnisonHash
"#" UnisonHash -> UnisonHash -> UnisonHash
forall a. Semigroup a => a -> a -> a
<>) (UnisonHash -> UnisonHash)
-> (CausalHash -> UnisonHash) -> CausalHash -> UnisonHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> UnisonHash
Hash.toBase32HexText (Hash -> UnisonHash)
-> (CausalHash -> Hash) -> CausalHash -> UnisonHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash (CausalHash -> UnisonHash) -> CausalHash -> UnisonHash
forall a b. (a -> b) -> a -> b
$ Branch m -> CausalHash
forall (m :: * -> *). Branch m -> CausalHash
Branch.headHash Branch m
b

v2CausalBranchToUnisonHash :: V2Branch.CausalBranch m -> UnisonHash
v2CausalBranchToUnisonHash :: forall (m :: * -> *). CausalBranch m -> UnisonHash
v2CausalBranchToUnisonHash CausalBranch m
b =
  (UnisonHash
"#" UnisonHash -> UnisonHash -> UnisonHash
forall a. Semigroup a => a -> a -> a
<>) (UnisonHash -> UnisonHash)
-> (CausalHash -> UnisonHash) -> CausalHash -> UnisonHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash -> UnisonHash
Hash.toBase32HexText (Hash -> UnisonHash)
-> (CausalHash -> Hash) -> CausalHash -> UnisonHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CausalHash -> Hash
unCausalHash (CausalHash -> UnisonHash) -> CausalHash -> UnisonHash
forall a b. (a -> b) -> a -> b
$ CausalBranch m -> CausalHash
forall (m :: * -> *) hc he pe e. Causal m hc he pe e -> hc
V2Causal.causalHash CausalBranch m
b

newtype ProjectBranchNameParam = ProjectBranchNameParam {ProjectBranchNameParam
-> ProjectAndBranch ProjectName ProjectBranchName
unProjectBranchNameParam :: ProjectAndBranch ProjectName ProjectBranchName}
  deriving (ProjectBranchNameParam -> ProjectBranchNameParam -> Bool
(ProjectBranchNameParam -> ProjectBranchNameParam -> Bool)
-> (ProjectBranchNameParam -> ProjectBranchNameParam -> Bool)
-> Eq ProjectBranchNameParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectBranchNameParam -> ProjectBranchNameParam -> Bool
== :: ProjectBranchNameParam -> ProjectBranchNameParam -> Bool
$c/= :: ProjectBranchNameParam -> ProjectBranchNameParam -> Bool
/= :: ProjectBranchNameParam -> ProjectBranchNameParam -> Bool
Eq, Int -> ProjectBranchNameParam -> ShowS
[ProjectBranchNameParam] -> ShowS
ProjectBranchNameParam -> String
(Int -> ProjectBranchNameParam -> ShowS)
-> (ProjectBranchNameParam -> String)
-> ([ProjectBranchNameParam] -> ShowS)
-> Show ProjectBranchNameParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectBranchNameParam -> ShowS
showsPrec :: Int -> ProjectBranchNameParam -> ShowS
$cshow :: ProjectBranchNameParam -> String
show :: ProjectBranchNameParam -> String
$cshowList :: [ProjectBranchNameParam] -> ShowS
showList :: [ProjectBranchNameParam] -> ShowS
Show, (forall x. ProjectBranchNameParam -> Rep ProjectBranchNameParam x)
-> (forall x.
    Rep ProjectBranchNameParam x -> ProjectBranchNameParam)
-> Generic ProjectBranchNameParam
forall x. Rep ProjectBranchNameParam x -> ProjectBranchNameParam
forall x. ProjectBranchNameParam -> Rep ProjectBranchNameParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProjectBranchNameParam -> Rep ProjectBranchNameParam x
from :: forall x. ProjectBranchNameParam -> Rep ProjectBranchNameParam x
$cto :: forall x. Rep ProjectBranchNameParam x -> ProjectBranchNameParam
to :: forall x. Rep ProjectBranchNameParam x -> ProjectBranchNameParam
Generic)

instance ToParamSchema ProjectBranchNameParam where
  toParamSchema :: Proxy ProjectBranchNameParam -> Schema
toParamSchema Proxy ProjectBranchNameParam
_ =
    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)
OpenApi.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)
OpenApi.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
?~ UnisonHash -> Value
Aeson.String UnisonHash
"@unison%2Fbase%2Fmain"

-- | Parses URL escaped project and branch names, e.g. `@unison%2Fbase%2Fmain` or `@unison%2Fbase%2F@runarorama%2Fmain`
instance FromHttpApiData ProjectBranchNameParam where
  parseUrlPiece :: UnisonHash -> Either UnisonHash ProjectBranchNameParam
parseUrlPiece UnisonHash
t =
    case forall target source.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryInto @(ProjectAndBranch ProjectName ProjectBranchName) UnisonHash
t of
      Left TryFromException
  UnisonHash (ProjectAndBranch ProjectName ProjectBranchName)
_ -> UnisonHash -> Either UnisonHash ProjectBranchNameParam
forall a b. a -> Either a b
Left UnisonHash
"Invalid project and branch name"
      Right ProjectAndBranch ProjectName ProjectBranchName
pab -> ProjectBranchNameParam -> Either UnisonHash ProjectBranchNameParam
forall a b. b -> Either a b
Right (ProjectBranchNameParam
 -> Either UnisonHash ProjectBranchNameParam)
-> (ProjectAndBranch ProjectName ProjectBranchName
    -> ProjectBranchNameParam)
-> ProjectAndBranch ProjectName ProjectBranchName
-> Either UnisonHash ProjectBranchNameParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectAndBranch ProjectName ProjectBranchName
-> ProjectBranchNameParam
ProjectBranchNameParam (ProjectAndBranch ProjectName ProjectBranchName
 -> Either UnisonHash ProjectBranchNameParam)
-> ProjectAndBranch ProjectName ProjectBranchName
-> Either UnisonHash ProjectBranchNameParam
forall a b. (a -> b) -> a -> b
$ ProjectAndBranch ProjectName ProjectBranchName
pab

instance ToParam (QueryParam "project-and-branch" (ProjectBranchNameParam)) where
  toParam :: Proxy (QueryParam "project-and-branch" ProjectBranchNameParam)
-> DocQueryParam
toParam Proxy (QueryParam "project-and-branch" ProjectBranchNameParam)
_ =
    String -> [String] -> String -> ParamKind -> DocQueryParam
DocQueryParam
      String
"project_and_branch"
      []
      String
"The name of a project and branch e.g. `@unison%2Fbase%2Fmain` or `@unison%2Fbase%2F@runarorama%2Fmain`"
      ParamKind
Normal

instance Docs.ToCapture (Capture "project-and-branch" ProjectBranchNameParam) where
  toCapture :: Proxy (Capture "project-and-branch" ProjectBranchNameParam)
-> DocCapture
toCapture Proxy (Capture "project-and-branch" ProjectBranchNameParam)
_ =
    String -> String -> DocCapture
DocCapture
      String
"project-and-branch"
      String
"The name of a project and branch e.g. `@unison%2Fbase%2Fmain` or `@unison%2Fbase%2F@runarorama%2Fmain`"

data TermDiffResponse = TermDiffResponse
  { TermDiffResponse -> ProjectName
project :: ProjectName,
    TermDiffResponse -> ProjectBranchName
oldBranch :: ProjectBranchName,
    TermDiffResponse -> ProjectBranchName
newBranch :: ProjectBranchName,
    TermDiffResponse -> TermDefinition
oldTerm :: TermDefinition,
    TermDiffResponse -> TermDefinition
newTerm :: TermDefinition,
    TermDiffResponse -> DisplayObjectDiff
diff :: DisplayObjectDiff
  }
  deriving (TermDiffResponse -> TermDiffResponse -> Bool
(TermDiffResponse -> TermDiffResponse -> Bool)
-> (TermDiffResponse -> TermDiffResponse -> Bool)
-> Eq TermDiffResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TermDiffResponse -> TermDiffResponse -> Bool
== :: TermDiffResponse -> TermDiffResponse -> Bool
$c/= :: TermDiffResponse -> TermDiffResponse -> Bool
/= :: TermDiffResponse -> TermDiffResponse -> Bool
Eq, Int -> TermDiffResponse -> ShowS
[TermDiffResponse] -> ShowS
TermDiffResponse -> String
(Int -> TermDiffResponse -> ShowS)
-> (TermDiffResponse -> String)
-> ([TermDiffResponse] -> ShowS)
-> Show TermDiffResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TermDiffResponse -> ShowS
showsPrec :: Int -> TermDiffResponse -> ShowS
$cshow :: TermDiffResponse -> String
show :: TermDiffResponse -> String
$cshowList :: [TermDiffResponse] -> ShowS
showList :: [TermDiffResponse] -> ShowS
Show, (forall x. TermDiffResponse -> Rep TermDiffResponse x)
-> (forall x. Rep TermDiffResponse x -> TermDiffResponse)
-> Generic TermDiffResponse
forall x. Rep TermDiffResponse x -> TermDiffResponse
forall x. TermDiffResponse -> Rep TermDiffResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TermDiffResponse -> Rep TermDiffResponse x
from :: forall x. TermDiffResponse -> Rep TermDiffResponse x
$cto :: forall x. Rep TermDiffResponse x -> TermDiffResponse
to :: forall x. Rep TermDiffResponse x -> TermDiffResponse
Generic)

deriving instance ToSchema TermDiffResponse

instance Docs.ToSample TermDiffResponse where
  toSamples :: Proxy TermDiffResponse -> [(UnisonHash, TermDiffResponse)]
toSamples Proxy TermDiffResponse
_ = []

instance ToJSON TermDiffResponse where
  toJSON :: TermDiffResponse -> Value
toJSON (TermDiffResponse {DisplayObjectDiff
$sel:diff:TermDiffResponse :: TermDiffResponse -> DisplayObjectDiff
diff :: DisplayObjectDiff
diff, ProjectName
$sel:project:TermDiffResponse :: TermDiffResponse -> ProjectName
project :: ProjectName
project, ProjectBranchName
$sel:oldBranch:TermDiffResponse :: TermDiffResponse -> ProjectBranchName
oldBranch :: ProjectBranchName
oldBranch, ProjectBranchName
$sel:newBranch:TermDiffResponse :: TermDiffResponse -> ProjectBranchName
newBranch :: ProjectBranchName
newBranch, TermDefinition
$sel:oldTerm:TermDiffResponse :: TermDiffResponse -> TermDefinition
oldTerm :: TermDefinition
oldTerm, TermDefinition
$sel:newTerm:TermDiffResponse :: TermDiffResponse -> TermDefinition
newTerm :: TermDefinition
newTerm}) =
    case DisplayObjectDiff
diff of
      DisplayObjectDiff DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff]
dispDiff ->
        [Pair] -> Value
object
          [ Key
"diff" Key
-> DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff]
dispDiff,
            Key
"diffKind" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"diff" :: Text),
            Key
"project" Key -> ProjectName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectName
project,
            Key
"oldBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
oldBranch,
            Key
"newBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
newBranch,
            Key
"oldTerm" Key -> TermDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermDefinition
oldTerm,
            Key
"newTerm" Key -> TermDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermDefinition
newTerm
          ]
      MismatchedDisplayObjects {} ->
        [Pair] -> Value
object
          [ Key
"diffKind" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"mismatched" :: Text),
            Key
"project" Key -> ProjectName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectName
project,
            Key
"oldBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
oldBranch,
            Key
"newBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
newBranch,
            Key
"oldTerm" Key -> TermDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermDefinition
oldTerm,
            Key
"newTerm" Key -> TermDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TermDefinition
newTerm
          ]

data TypeDiffResponse = TypeDiffResponse
  { TypeDiffResponse -> ProjectName
project :: ProjectName,
    TypeDiffResponse -> ProjectBranchName
oldBranch :: ProjectBranchName,
    TypeDiffResponse -> ProjectBranchName
newBranch :: ProjectBranchName,
    TypeDiffResponse -> TypeDefinition
oldType :: TypeDefinition,
    TypeDiffResponse -> TypeDefinition
newType :: TypeDefinition,
    TypeDiffResponse -> DisplayObjectDiff
diff :: DisplayObjectDiff
  }
  deriving (TypeDiffResponse -> TypeDiffResponse -> Bool
(TypeDiffResponse -> TypeDiffResponse -> Bool)
-> (TypeDiffResponse -> TypeDiffResponse -> Bool)
-> Eq TypeDiffResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeDiffResponse -> TypeDiffResponse -> Bool
== :: TypeDiffResponse -> TypeDiffResponse -> Bool
$c/= :: TypeDiffResponse -> TypeDiffResponse -> Bool
/= :: TypeDiffResponse -> TypeDiffResponse -> Bool
Eq, Int -> TypeDiffResponse -> ShowS
[TypeDiffResponse] -> ShowS
TypeDiffResponse -> String
(Int -> TypeDiffResponse -> ShowS)
-> (TypeDiffResponse -> String)
-> ([TypeDiffResponse] -> ShowS)
-> Show TypeDiffResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeDiffResponse -> ShowS
showsPrec :: Int -> TypeDiffResponse -> ShowS
$cshow :: TypeDiffResponse -> String
show :: TypeDiffResponse -> String
$cshowList :: [TypeDiffResponse] -> ShowS
showList :: [TypeDiffResponse] -> ShowS
Show, (forall x. TypeDiffResponse -> Rep TypeDiffResponse x)
-> (forall x. Rep TypeDiffResponse x -> TypeDiffResponse)
-> Generic TypeDiffResponse
forall x. Rep TypeDiffResponse x -> TypeDiffResponse
forall x. TypeDiffResponse -> Rep TypeDiffResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TypeDiffResponse -> Rep TypeDiffResponse x
from :: forall x. TypeDiffResponse -> Rep TypeDiffResponse x
$cto :: forall x. Rep TypeDiffResponse x -> TypeDiffResponse
to :: forall x. Rep TypeDiffResponse x -> TypeDiffResponse
Generic)

deriving instance ToSchema TypeDiffResponse

instance Docs.ToSample TypeDiffResponse where
  toSamples :: Proxy TypeDiffResponse -> [(UnisonHash, TypeDiffResponse)]
toSamples Proxy TypeDiffResponse
_ = []

instance ToJSON TypeDiffResponse where
  toJSON :: TypeDiffResponse -> Value
toJSON (TypeDiffResponse {DisplayObjectDiff
$sel:diff:TypeDiffResponse :: TypeDiffResponse -> DisplayObjectDiff
diff :: DisplayObjectDiff
diff, ProjectName
$sel:project:TypeDiffResponse :: TypeDiffResponse -> ProjectName
project :: ProjectName
project, ProjectBranchName
$sel:oldBranch:TypeDiffResponse :: TypeDiffResponse -> ProjectBranchName
oldBranch :: ProjectBranchName
oldBranch, ProjectBranchName
$sel:newBranch:TypeDiffResponse :: TypeDiffResponse -> ProjectBranchName
newBranch :: ProjectBranchName
newBranch, TypeDefinition
$sel:oldType:TypeDiffResponse :: TypeDiffResponse -> TypeDefinition
oldType :: TypeDefinition
oldType, TypeDefinition
$sel:newType:TypeDiffResponse :: TypeDiffResponse -> TypeDefinition
newType :: TypeDefinition
newType}) =
    case DisplayObjectDiff
diff of
      DisplayObjectDiff DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff]
dispDiff ->
        [Pair] -> Value
object
          [ Key
"diff" Key
-> DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff]
dispDiff,
            Key
"diffKind" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"diff" :: Text),
            Key
"project" Key -> ProjectName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectName
project,
            Key
"oldBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
oldBranch,
            Key
"newBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
newBranch,
            Key
"oldType" Key -> TypeDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeDefinition
oldType,
            Key
"newType" Key -> TypeDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeDefinition
newType
          ]
      MismatchedDisplayObjects {} ->
        [Pair] -> Value
object
          [ Key
"diffKind" Key -> UnisonHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (UnisonHash
"mismatched" :: Text),
            Key
"project" Key -> ProjectName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectName
project,
            Key
"oldBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
oldBranch,
            Key
"newBranchRef" Key -> ProjectBranchName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ProjectBranchName
newBranch,
            Key
"oldType" Key -> TypeDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeDefinition
oldType,
            Key
"newType" Key -> TypeDefinition -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TypeDefinition
newType
          ]

-- | Servant utility for a query param that's required, providing a useful error message if it's missing.
type RequiredQueryParam = Servant.QueryParam' '[Servant.Required, Servant.Strict]