From 7f96a4dff9b6e812540ee17b31cb58f972e76be6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 19 Nov 2024 15:16:07 -0800 Subject: [PATCH 1/2] Add Ord to *DefinitionDiffs --- .../src/Unison/Util/AnnotatedText.hs | 5 ++--- unison-share-api/src/Unison/Server/Types.hs | 22 +++++++++---------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs b/lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs index 47bb6d9ca7..7061ece97f 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs @@ -21,13 +21,13 @@ import Unison.Util.Monoid (intercalateMap) import Unison.Util.Range (Range (..), inRange) data Segment a = Segment {segment :: String, annotation :: Maybe a} - deriving (Eq, Show, Functor, Foldable, Generic) + deriving (Eq, Show, Ord, Functor, Foldable, Generic) toPair :: Segment a -> (String, Maybe a) toPair (Segment s a) = (s, a) newtype AnnotatedText a = AnnotatedText (Seq (Segment a)) - deriving (Eq, Functor, Foldable, Show, Generic) + deriving (Eq, Functor, Foldable, Show, Ord, Generic) instance Semigroup (AnnotatedText a) where AnnotatedText (as :|> Segment "" _) <> bs = AnnotatedText as <> bs @@ -204,7 +204,6 @@ snipWithContext margin source = -- if all annotations so far can be joined without .. separations if null rest then -- if this one can be joined to the new region without .. separation - if withinMargin r0 r1 then -- add it to the first set and grow the compare region (Just $ r0 <> r1, Map.insert r1 a1 taken, mempty) diff --git a/unison-share-api/src/Unison/Server/Types.hs b/unison-share-api/src/Unison/Server/Types.hs index 6139c395af..21799f4337 100644 --- a/unison-share-api/src/Unison/Server/Types.hs +++ b/unison-share-api/src/Unison/Server/Types.hs @@ -198,14 +198,14 @@ data TermDefinitionDiff = TermDefinitionDiff right :: TermDefinition, diff :: DisplayObjectDiff } - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) data TypeDefinitionDiff = TypeDefinitionDiff { left :: TypeDefinition, right :: TypeDefinition, diff :: DisplayObjectDiff } - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) newtype Suffixify = Suffixify {suffixified :: Bool} deriving (Eq, Ord, Show, Generic) @@ -218,7 +218,7 @@ data TermDefinition = TermDefinition signature :: Syntax.SyntaxText, termDocs :: [(HashQualifiedName, UnisonHash, Doc)] } - deriving (Eq, Show, Generic) + deriving (Eq, Show, Ord, Generic) data TypeDefinition = TypeDefinition { typeNames :: [HashQualifiedName], @@ -227,14 +227,14 @@ data TypeDefinition = TypeDefinition typeDefinition :: DisplayObject Syntax.SyntaxText Syntax.SyntaxText, typeDocs :: [(HashQualifiedName, UnisonHash, Doc)] } - deriving (Eq, Show, Generic) + deriving (Eq, Show, Ord, Generic) data DefinitionDisplayResults = DefinitionDisplayResults { termDefinitions :: Map UnisonHash TermDefinition, typeDefinitions :: Map UnisonHash TypeDefinition, missingDefinitions :: [HashQualifiedName] } - deriving (Eq, Show, Generic) + deriving (Eq, Show, Ord, Generic) instance Semigroup DefinitionDisplayResults where DefinitionDisplayResults terms1 types1 missing1 <> DefinitionDisplayResults terms2 types2 missing2 = @@ -260,7 +260,7 @@ data SemanticSyntaxDiff SegmentChange (String, String) (Maybe Syntax.Element) | -- (shared segment) (fromAnnotation, toAnnotation) AnnotationChange String (Maybe Syntax.Element, Maybe Syntax.Element) - deriving (Eq, Show, Generic) + deriving (Eq, Show, Ord, Generic) deriving instance ToSchema SemanticSyntaxDiff @@ -303,7 +303,7 @@ instance ToJSON SemanticSyntaxDiff where data DisplayObjectDiff = DisplayObjectDiff (DisplayObject [SemanticSyntaxDiff] [SemanticSyntaxDiff]) | MismatchedDisplayObjects (DisplayObject Syntax.SyntaxText Syntax.SyntaxText) (DisplayObject Syntax.SyntaxText Syntax.SyntaxText) - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) deriving instance ToSchema DisplayObjectDiff @@ -324,7 +324,7 @@ data NamedTerm = NamedTerm termType :: Maybe Syntax.SyntaxText, termTag :: TermTag } - deriving (Eq, Generic, Show) + deriving (Eq, Ord, Generic, Show) instance ToJSON NamedTerm where toJSON (NamedTerm n h typ tag) = @@ -350,7 +350,7 @@ data NamedType = NamedType typeHash :: ShortHash, typeTag :: TypeTag } - deriving (Eq, Generic, Show) + deriving (Eq, Ord, Generic, Show) instance ToJSON NamedType where toJSON (NamedType n h tag) = @@ -474,7 +474,7 @@ data TermDiffResponse = TermDiffResponse newTerm :: TermDefinition, diff :: DisplayObjectDiff } - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving instance ToSchema TermDiffResponse @@ -512,7 +512,7 @@ data TypeDiffResponse = TypeDiffResponse newType :: TypeDefinition, diff :: DisplayObjectDiff } - deriving (Eq, Show, Generic) + deriving (Eq, Ord, Show, Generic) deriving instance ToSchema TypeDiffResponse From 40eac6a121a5edb8e083523b769aa656df0fa54e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 20 Nov 2024 09:12:28 -0800 Subject: [PATCH 2/2] Add instances --- unison-share-api/src/Unison/Server/Doc.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/unison-share-api/src/Unison/Server/Doc.hs b/unison-share-api/src/Unison/Server/Doc.hs index ec2ee1cd1d..7a9ad22ab0 100644 --- a/unison-share-api/src/Unison/Server/Doc.hs +++ b/unison-share-api/src/Unison/Server/Doc.hs @@ -90,7 +90,7 @@ data DocG specialForm | UntitledSection [(DocG specialForm)] | Column [(DocG specialForm)] | Group (DocG specialForm) - deriving stock (Eq, Show, Generic, Functor, Foldable, Traversable) + deriving stock (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) deriving anyclass (ToJSON) deriving instance (ToSchema specialForm) => ToSchema (DocG specialForm) @@ -98,13 +98,13 @@ deriving instance (ToSchema specialForm) => ToSchema (DocG specialForm) type UnisonHash = Text data Ref a = Term a | Type a - deriving stock (Eq, Show, Generic, Functor, Foldable, Traversable) + deriving stock (Eq, Ord, Show, Generic, Functor, Foldable, Traversable) deriving anyclass (ToJSON) instance (ToSchema a) => ToSchema (Ref a) data MediaSource = MediaSource {mediaSourceUrl :: Text, mediaSourceMimeType :: Maybe Text} - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, ToSchema) data RenderedSpecialForm @@ -124,7 +124,7 @@ data RenderedSpecialForm | LaTeXInline Text | Svg Text | RenderError (RenderError SyntaxText) - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, ToSchema) data EvaluatedSpecialForm v @@ -146,11 +146,11 @@ data EvaluatedSpecialForm v | ELaTeXInline Text | ESvg Text | ERenderError (RenderError (Term v ())) - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) -- `Src folded unfolded` data Src = Src SyntaxText SyntaxText - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON, ToSchema) -- | Evaluate the doc, then render it. @@ -447,7 +447,7 @@ evalDoc terms typeOf eval types tm = data RenderError trm = InvalidTerm trm - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Ord, Show, Generic) deriving anyclass (ToJSON) deriving anyclass instance (ToSchema trm) => ToSchema (RenderError trm) @@ -455,20 +455,20 @@ deriving anyclass instance (ToSchema trm) => ToSchema (RenderError trm) data EvaluatedSrc v = EvaluatedSrcDecl (EvaluatedDecl v) | EvaluatedSrcTerm (EvaluatedTerm v) - deriving stock (Show, Eq, Generic) + deriving stock (Show, Ord, Eq, Generic) data EvaluatedDecl v = MissingDecl Reference | BuiltinDecl Reference | FoundDecl Reference (DD.Decl v ()) - deriving stock (Show, Eq, Generic) + deriving stock (Show, Ord, Eq, Generic) data EvaluatedTerm v = MissingTerm Reference | BuiltinTypeSig Reference (Type v ()) | MissingBuiltinTypeSig Reference | FoundTerm Reference (Type v ()) (Term v ()) - deriving stock (Show, Eq, Generic) + deriving stock (Show, Eq, Ord, Generic) -- Determines all dependencies which will be required to render a doc. dependencies :: (Ord v) => EvaluatedDoc v -> Set LD.LabeledDependency