diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 500fee238..efcb7a7c9 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -66,6 +66,7 @@ toTermName source term = case unwrap term of S.For exprs _ -> termNameFromChildren term exprs S.While expr _ -> toTermName' expr S.DoWhile _ expr -> toTermName' expr + S.Array _ -> toText $ Source.slice (characterRange $ extract term) source S.Class identifier _ _ -> toTermName' identifier S.Method identifier _ _ -> toTermName' identifier Comment a -> toCategoryName a @@ -192,6 +193,7 @@ diffSummaries sources = cata $ \case (Free (infos :< S.For exprs body)) -> annotateWithCategory infos <$> join exprs <> body (Free (infos :< S.While expr body)) -> annotateWithCategory infos <$> expr <> body (Free (infos :< S.DoWhile expr body)) -> annotateWithCategory infos <$> expr <> body + (Free (infos :< S.Array children)) -> annotateWithCategory infos <$> join children (Free (infos :< S.Class identifier superclass definitions)) -> annotateWithCategory infos <$> identifier <> fromMaybe [] superclass <> join definitions (Free (infos :< S.Method identifier params definitions)) -> annotateWithCategory infos <$> identifier <> join params <> join definitions (Pure (Insert term)) -> [ DiffSummary (Insert $ termToDiffInfo afterSource term) [] ] diff --git a/src/Parser.hs b/src/Parser.hs index 2dc79941a..6dd8f5d39 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -97,6 +97,8 @@ termConstructor source sourceSpan info = cofree . construct withDefaultInfo $ S.While expr body construct children | DoWhile == (category info), [expr, body] <- children = withDefaultInfo $ S.DoWhile expr body + construct children | ArrayLiteral == category info = + withDefaultInfo $ S.Array children construct children | Method == category info = case children of [identifier, params, exprs] | Params == category (extract params), diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 85f298859..3408c1ad7 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -7,7 +7,7 @@ module Renderer.JSON ( import Prologue hiding (toList) import Alignment import Category -import Data.Aeson hiding (json) +import Data.Aeson as A hiding (json) import Data.Bifunctor.Join import Data.ByteString.Builder import Data.Record @@ -35,13 +35,13 @@ instance ToJSON Category where toJSON (Other s) = String s toJSON s = String . T.pack $ show s instance ToJSON Range where - toJSON (Range start end) = Array . fromList $ toJSON <$> [ start, end ] + toJSON (Range start end) = A.Array . fromList $ toJSON <$> [ start, end ] toEncoding (Range start end) = foldable [ start, end ] instance ToJSON a => ToJSON (Join These a) where - toJSON (Join vs) = Array . fromList $ toJSON <$> these pure pure (\ a b -> [ a, b ]) vs + toJSON (Join vs) = A.Array . fromList $ toJSON <$> these pure pure (\ a b -> [ a, b ]) vs toEncoding = foldable instance ToJSON a => ToJSON (Join (,) a) where - toJSON (Join (a, b)) = Array . fromList $ toJSON <$> [ a, b ] + toJSON (Join (a, b)) = A.Array . fromList $ toJSON <$> [ a, b ] toEncoding = foldable instance (HasField fields Category, HasField fields Range) => ToJSON (SplitDiff leaf (Record fields)) where toJSON splitDiff = case runFree splitDiff of @@ -89,6 +89,7 @@ termFields info syntax = "range" .= characterRange info : "category" .= category S.Comment _ -> [] S.Commented comments child -> childrenFields (comments <> maybeToList child) S.Error sourceSpan c -> [ "sourceSpan" .= sourceSpan ] <> childrenFields c + S.Array c -> childrenFields c S.Class identifier superclass definitions -> [ "classIdentifier" .= identifier ] <> [ "superclass" .= superclass ] <> [ "definitions" .= definitions ] S.Method identifier params definitions -> [ "methodIdentifier" .= identifier ] <> [ "params" .= params ] <> [ "definitions" .= definitions ] where childrenFields c = [ "children" .= c ] diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index c973d9f82..ceb5e0dc1 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -40,7 +40,6 @@ styleName category = "category-" <> case category of StringLiteral -> "string" SymbolLiteral -> "symbol" IntegerLiteral -> "integer" - ArrayLiteral -> "array" C.FunctionCall -> "function_call" C.Function -> "function" C.MethodCall -> "method_call" @@ -65,6 +64,7 @@ styleName category = "category-" <> case category of C.While -> "while" C.DoWhile -> "do_while" C.Return -> "return_statement" + ArrayLiteral -> "array" C.Class -> "class_statement" Other string -> string diff --git a/src/Syntax.hs b/src/Syntax.hs index 0ab0a7cfc..75ea904ff 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -60,6 +60,8 @@ data Syntax | DoWhile { doWhileBody :: f, doWhileExpr :: f } | While { whileExpr :: f, whileBody :: f } | Return (Maybe f) + -- | An array literal with list of children. + | Array [f] -- | A class with an identifier, superclass, and a list of definitions. | Class f (Maybe f) [f] -- | A method definition with an identifier, params, and a list of expressions.