diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 2e4277df5..ca18156d6 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -110,7 +110,7 @@ library , clock , yaml default-language: Haskell2010 - default-extensions: DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards, LambdaCase, StrictData + default-extensions: DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, NoImplicitPrelude, RecordWildCards, StrictData ghc-options: -Wall -fno-warn-name-shadowing -O2 -j ghc-prof-options: -fprof-auto diff --git a/src/Interpreter.hs b/src/Interpreter.hs index 599f1cfe8..832f4db7a 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -40,7 +40,7 @@ runSteps algorithm = case runStep algorithm of runStep :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector)) => Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -> Either result (Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result) -runStep = \case +runStep step = case step of Return a -> Left a algorithm `Then` cont -> Right $ decompose algorithm >>= cont @@ -49,7 +49,7 @@ runStep = \case decompose :: (Eq leaf, HasField fields Category, HasField fields (Maybe FeatureVector)) => AlgorithmF (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The step in an algorithm to decompose into its next steps. -> Algorithm (SyntaxTerm leaf fields) (SyntaxDiff leaf fields) result -- ^ The sequence of next steps to undertake to continue the algorithm. -decompose = \case +decompose step = case step of Diff t1 t2 -> algorithmWithTerms t1 t2 Linear t1 t2 -> case galignWith diffThese (unwrap t1) (unwrap t2) of Just result -> wrap . (both (extract t1) (extract t2) :<) <$> sequenceA result diff --git a/src/Language/Go.hs b/src/Language/Go.hs index f5bb3064c..7c42ad497 100644 --- a/src/Language/Go.hs +++ b/src/Language/Go.hs @@ -66,7 +66,7 @@ termAssignment source category children = case (category, children) of _ -> Nothing categoryForGoName :: Text -> Category -categoryForGoName = \case +categoryForGoName name = case name of "identifier" -> Identifier "int_literal" -> NumberLiteral "float_literal" -> FloatLiteral diff --git a/src/Language/Ruby.hs b/src/Language/Ruby.hs index 0a7960047..5752ad48e 100644 --- a/src/Language/Ruby.hs +++ b/src/Language/Ruby.hs @@ -96,7 +96,7 @@ termAssignment _ category children withRecord record syntax = cofree (record :< syntax) categoryForRubyName :: Text -> Category -categoryForRubyName = \case +categoryForRubyName name = case name of "argument_list_with_parens" -> Args "argument_list" -> Args "argument_pair" -> ArgumentPair diff --git a/src/Patch.hs b/src/Patch.hs index b574ad3ec..8f42e1ee6 100644 --- a/src/Patch.hs +++ b/src/Patch.hs @@ -81,7 +81,7 @@ maybeSnd :: These a b -> Maybe b maybeSnd = these (const Nothing) Just ((Just .) . flip const) patchType :: Patch a -> Text -patchType = \case +patchType patch = case patch of Replace{} -> "modified" Insert{} -> "added" Delete{} -> "removed" diff --git a/src/Renderer/Summary.hs b/src/Renderer/Summary.hs index 90a25193f..d5605c4de 100644 --- a/src/Renderer/Summary.hs +++ b/src/Renderer/Summary.hs @@ -33,7 +33,7 @@ data Annotatable a = Annotatable a | Unannotatable a annotatable :: SyntaxTerm leaf fields -> Annotatable (SyntaxTerm leaf fields) annotatable term = isAnnotatable (unwrap term) term - where isAnnotatable = \case + where isAnnotatable syntax = case syntax of S.Class{} -> Annotatable S.Method{} -> Annotatable S.Function{} -> Annotatable @@ -46,7 +46,7 @@ data Identifiable a = Identifiable a | Unidentifiable a identifiable :: SyntaxTerm leaf fields -> Identifiable (SyntaxTerm leaf fields) identifiable term = isIdentifiable (unwrap term) term - where isIdentifiable = \case + where isIdentifiable syntax = case syntax of S.FunctionCall{} -> Identifiable S.MethodCall{} -> Identifiable S.Function{} -> Identifiable @@ -142,15 +142,15 @@ diffToDiffSummaries sources = para $ \diff -> -- Flattens a patch of diff infos into a list of docs, one for every 'LeafInfo' or `ErrorInfo` it contains. jsonDocSummaries :: Patch DiffInfo -> [JSONSummary Doc SourceSpans] -jsonDocSummaries = \case - p@(Replace i1 i2) -> zipWith (\a b -> +jsonDocSummaries patch = case patch of + Replace i1 i2 -> zipWith (\a b -> JSONSummary { - info = info (prefixWithPatch p This a) <+> "with" <+> info b + info = info (prefixWithPatch patch This a) <+> "with" <+> info b , span = SourceSpans $ These (span a) (span b) }) (toLeafInfos i1) (toLeafInfos i2) - p@(Insert info) -> prefixWithPatch p That <$> toLeafInfos info - p@(Delete info) -> prefixWithPatch p This <$> toLeafInfos info + Insert info -> prefixWithPatch patch That <$> toLeafInfos info + Delete info -> prefixWithPatch patch This <$> toLeafInfos info -- Prefixes a given doc with the type of patch it represents. prefixWithPatch :: Patch DiffInfo -> (SourceSpan -> These SourceSpan SourceSpan) -> JSONSummary Doc SourceSpan -> JSONSummary Doc SourceSpans @@ -161,7 +161,7 @@ prefixWithPatch patch constructor = prefixWithThe (patchToPrefix patch) info = prefix <+> info jsonSummary , span = SourceSpans $ constructor (span jsonSummary) } - patchToPrefix = \case + patchToPrefix patch = case patch of (Replace _ _) -> "Replaced" (Insert _) -> "Added" (Delete _) -> "Deleted" @@ -386,7 +386,7 @@ instance HasCategory Text where toCategoryName = identity instance HasCategory Category where - toCategoryName = \case + toCategoryName category = case category of C.Ty -> "type" ArrayLiteral -> "array" BooleanOperator -> "boolean operator" diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index f5692d502..e196eddaa 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -109,7 +109,7 @@ toTOCSummaries patch = case afterOrBefore patch of _ -> NotSummarizable flattenPatch :: Patch DiffInfo -> [Patch DiffInfo] -flattenPatch = \case +flattenPatch patch = case patch of Replace i1 i2 -> zipWith Replace (toLeafInfos' i1) (toLeafInfos' i2) Insert info -> Insert <$> toLeafInfos' info Delete info -> Delete <$> toLeafInfos' info @@ -133,7 +133,7 @@ mapToInSummarizable sources diff children = case (beforeTerm diff, afterTerm dif summarizable :: ComonadCofree (Syntax t) w => w a -> SummarizableTerm (w a) summarizable term = go (unwrap term) term - where go = \case + where go syntax = case syntax of S.Method{} -> SummarizableTerm S.Function{} -> SummarizableTerm _ -> NotSummarizableTerm @@ -143,7 +143,7 @@ toJSONSummaries TOCSummary{..} = case afterOrBefore summaryPatch of Just diffInfo -> toJSONSummaries' diffInfo Nothing -> panic "No diff" where - toJSONSummaries' = \case + toJSONSummaries' diffInfo = case diffInfo of ErrorInfo{..} -> pure $ ErrorSummary termName infoSpan BranchInfo{..} -> branches >>= toJSONSummaries' LeafInfo{..} -> case parentInfo of @@ -183,6 +183,6 @@ toTermName parentOffset parentSource term = case unwrap term of -- The user-facing category name toCategoryName :: Category -> Text -toCategoryName = \case +toCategoryName category = case category of C.SingletonMethod -> "Method" c -> show c diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs index c9be0eaaf..c5c3d69db 100644 --- a/src/TreeSitter.hs +++ b/src/TreeSitter.hs @@ -83,7 +83,7 @@ assignTerm language source annotation children allChildren = Just a -> pure a _ -> defaultTermAssignment source (category annotation) children allChildren where assignTermByLanguage :: Language -> Source -> Category -> [ SyntaxTerm Text '[ Range, Category, SourceSpan ] ] -> Maybe (S.Syntax Text (SyntaxTerm Text '[ Range, Category, SourceSpan ])) - assignTermByLanguage = \case + assignTermByLanguage language = case language of JavaScript -> JS.termAssignment C -> C.termAssignment Language.Go -> Go.termAssignment @@ -132,13 +132,16 @@ defaultTermAssignment source category children allChildren categoryForLanguageProductionName :: Language -> Text -> Category -categoryForLanguageProductionName = withDefaults . \case - JavaScript -> JS.categoryForJavaScriptProductionName - C -> C.categoryForCProductionName - Ruby -> Ruby.categoryForRubyName - Language.Go -> Go.categoryForGoName - TypeScript -> TS.categoryForTypeScriptName - _ -> Other - where withDefaults productionMap = \case - "ERROR" -> ParseError - s -> productionMap s +categoryForLanguageProductionName = withDefaults . byLanguage + where + withDefaults productionMap name = case name of + "ERROR" -> ParseError + s -> productionMap s + + byLanguage language = case language of + JavaScript -> JS.categoryForJavaScriptProductionName + C -> C.categoryForCProductionName + Ruby -> Ruby.categoryForRubyName + Language.Go -> Go.categoryForGoName + TypeScript -> TS.categoryForTypeScriptName + _ -> Other