From 563652355d381b0b8761972aaed4796e0669ff71 Mon Sep 17 00:00:00 2001
From: joshvera <josh@joshvera.com>
Date: Tue, 6 Dec 2016 16:09:04 -0500
Subject: [PATCH] Add ArrayTy, DictionaryTy, StructTy, Struct

---
 src/Category.hs            |  6 ++++++
 src/DiffSummary.hs         |  9 +++++++--
 src/Interpreter.hs         |  8 ++++++--
 src/Language/Go.hs         | 18 ++++++++++++++++++
 src/Language/JavaScript.hs |  4 ++--
 src/Language/Ruby.hs       |  4 ++--
 src/Renderer/JSON.hs       |  5 +++--
 src/Syntax.hs              |  6 ++++--
 8 files changed, 48 insertions(+), 12 deletions(-)

diff --git a/src/Category.hs b/src/Category.hs
index 94cf4812b..f4ef7afcc 100644
--- a/src/Category.hs
+++ b/src/Category.hs
@@ -161,6 +161,10 @@ data Category
   | BlockParameter
   -- | A float literal.
   | FloatLiteral
+  | ArrayTy
+  | DictionaryTy
+  | StructTy
+  | Struct
   deriving (Eq, Generic, Ord, Show)
 
 -- Instances
@@ -247,6 +251,8 @@ instance Arbitrary Category where
     , pure SplatParameter
     , pure HashSplatParameter
     , pure BlockParameter
+    , pure ArrayTy
+    , pure DictionaryTy
     , Other <$> arbitrary
     ]
 
diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs
index dee7d6086..f9cbfb0b2 100644
--- a/src/DiffSummary.hs
+++ b/src/DiffSummary.hs
@@ -224,7 +224,7 @@ toTermName source term = case unwrap term of
   S.Ternary expr _ -> toTermName' expr
   S.MathAssignment id _ -> toTermName' id
   S.Operator _ -> termNameFromSource term
-  S.Object kvs -> "{ " <> intercalate ", " (toTermName' <$> kvs) <> " }"
+  S.Object _ kvs -> "{ " <> intercalate ", " (toTermName' <$> kvs) <> " }"
   S.Pair k v -> toKeyName k <> toArgName v
   S.Return expr -> maybe "empty" toTermName' expr
   S.Yield expr -> maybe "empty" toTermName' expr
@@ -237,7 +237,7 @@ toTermName source term = case unwrap term of
   S.Constructor expr -> toTermName' expr
   S.Try clauses _ _ _ -> termNameFromChildren term clauses
   S.Select clauses -> termNameFromChildren term clauses
-  S.Array _ -> termNameFromSource term
+  S.Array _ _ -> termNameFromSource term
   S.Class identifier _ _ -> toTermName' identifier
   S.Method identifier args _ -> toTermName' identifier <> paramsToArgNames args
   S.Comment a -> toCategoryName a
@@ -251,6 +251,7 @@ toTermName source term = case unwrap term of
   S.ConditionalAssignment id _ -> toTermName' id
   S.Negate expr -> toTermName' expr
   S.Rescue args _ -> intercalate ", " $ toTermName' <$> args
+  S.Struct _ _ -> termNameFromSource term
   where toTermName' = toTermName source
         termNameFromChildren term children = termNameFromRange (unionRangesFrom (range term) (range <$> children))
         termNameFromSource term = termNameFromRange (range term)
@@ -419,6 +420,10 @@ instance HasCategory Category where
     C.SplatParameter -> "parameter"
     C.HashSplatParameter -> "parameter"
     C.BlockParameter -> "parameter"
+    C.ArrayTy -> "array type"
+    C.DictionaryTy -> "dictionary type"
+    C.StructTy -> "struct type"
+    C.Struct -> "struct"
 
 instance HasField fields Category => HasCategory (SyntaxTerm leaf fields) where
   toCategoryName = toCategoryName . category . extract
diff --git a/src/Interpreter.hs b/src/Interpreter.hs
index 9fff0f5c9..c28e69303 100644
--- a/src/Interpreter.hs
+++ b/src/Interpreter.hs
@@ -64,11 +64,15 @@ algorithmWithTerms construct t1 t2 = maybe (recursively t1 t2) (fmap annotate) $
   (S.Switch exprA casesA, S.Switch exprB casesB) -> Just $
     S.Switch <$> recursively exprA exprB
              <*> bySimilarity casesA casesB
-  (S.Object a, S.Object b) -> Just $ S.Object <$> bySimilarity a b
+  (S.Object tyA a, S.Object tyB b) -> Just $
+    S.Object <$> sequenceA (recursively <$> tyA <*> tyB) 
+             <*> bySimilarity a b
   (Commented commentsA a, Commented commentsB b) -> Just $
     Commented <$> bySimilarity commentsA commentsB
               <*> sequenceA (recursively <$> a <*> b)
-  (Array a, Array b) -> Just $ Array <$> bySimilarity a b
+  (Array tyA a, Array tyB b) -> Just $
+    Array <$> sequenceA (recursively <$> tyA <*> tyB)
+          <*> bySimilarity a b
   (S.Class identifierA paramsA expressionsA, S.Class identifierB paramsB expressionsB) -> Just $
     S.Class <$> recursively identifierA identifierB
             <*> sequenceA (recursively <$> paramsA <*> paramsB)
diff --git a/src/Language/Go.hs b/src/Language/Go.hs
index e3956514f..e31326dfd 100644
--- a/src/Language/Go.hs
+++ b/src/Language/Go.hs
@@ -59,6 +59,7 @@ termConstructor source sourceSpan name range children = case name of
   "selector_expression" -> withDefaultInfo $ toSubscriptAccess children
   "index_expression" -> withDefaultInfo $ toSubscriptAccess children
   "slice_expression" -> sliceToSubscriptAccess children
+  "composite_literal" -> toLiteral children
   "type_assertion_expression" -> withDefaultInfo $ case children of
     [a, b] -> S.TypeAssertion a b
     rest -> S.Error rest
@@ -82,6 +83,23 @@ termConstructor source sourceSpan name range children = case name of
     [] -> S.Leaf . toText $ slice range source
     _ -> S.Indexed children
   where
+    toLiteral = \case
+      children@[ty, _] -> case category (extract ty) of
+        ArrayTy -> toImplicitArray children
+        DictionaryTy -> toMap children
+        _ -> toStruct children
+      rest -> withRanges range Error rest $ S.Error rest
+    toImplicitArray = \case
+      [ty, values] -> withCategory ArrayLiteral (S.Array (Just ty) (toList $ unwrap values))
+      rest -> withRanges range Error rest $ S.Error rest
+    toMap = \case
+      [ty, values] -> withCategory DictionaryLiteral (S.Object (Just ty) (toList $ unwrap values))
+      rest -> withRanges range Error rest $ S.Error rest
+    toStruct = \case
+      [ty, values] -> withCategory Struct (S.Struct (Just ty) (toList $ unwrap values))
+      rest -> withRanges range Error rest $ S.Error rest
+
+
     toExpression f = \case
       [expr] -> f expr
       rest -> S.Error rest
diff --git a/src/Language/JavaScript.hs b/src/Language/JavaScript.hs
index 970750e7a..8bb61712c 100644
--- a/src/Language/JavaScript.hs
+++ b/src/Language/JavaScript.hs
@@ -56,7 +56,7 @@ termConstructor source sourceSpan name range children
     ("switch_statement", _ ) -> S.Error children
     ("case", [ expr, body ]) -> S.Case expr [body]
     ("case", _ ) -> S.Error children
-    ("object", _) -> S.Object $ foldMap toTuple children
+    ("object", _) -> S.Object Nothing $ foldMap toTuple children
     ("pair", _) -> S.Fixed children
     ("comment", _) -> S.Comment . toText $ slice range source
     ("if_statement", expr : rest ) -> S.If expr rest
@@ -77,7 +77,7 @@ termConstructor source sourceSpan name range children
         | Catch <- category (extract catch)
         , Finally <- category (extract finally) -> S.Try [body] [catch] Nothing (Just finally)
       _ -> S.Error children
-    ("array", _) -> S.Array children
+    ("array", _) -> S.Array Nothing children
     ("method_definition", [ identifier, params, exprs ]) -> S.Method identifier (toList (unwrap params)) (toList (unwrap exprs))
     ("method_definition", [ identifier, exprs ]) -> S.Method identifier [] (toList (unwrap exprs))
     ("method_definition", _ ) -> S.Error children
diff --git a/src/Language/Ruby.hs b/src/Language/Ruby.hs
index 223a76dcb..1d94b701b 100644
--- a/src/Language/Ruby.hs
+++ b/src/Language/Ruby.hs
@@ -54,7 +54,7 @@ termConstructor source sourceSpan name range children
     -- Let it fall through to generate an Indexed syntax.
     ("optional_parameter", [ k, v ] ) -> S.Pair k v
     ("optional_parameter", _ ) -> S.Error children
-    ("array", _ ) -> S.Array children
+    ("array", _ ) -> S.Array Nothing children
     ("assignment", [ identifier, value ]) -> S.Assignment identifier value
     ("assignment", _ ) -> S.Error children
     ("begin_statement", _ ) -> case partition (\x -> category (extract x) == Rescue) children of
@@ -87,7 +87,7 @@ termConstructor source sourceSpan name range children
         _ -> S.Error children
       function : args -> S.FunctionCall function (toList . unwrap =<< args)
       _ -> S.Error children
-    ("hash", _ ) -> S.Object $ foldMap toTuple children
+    ("hash", _ ) -> S.Object Nothing $ foldMap toTuple children
     ("if_modifier", [ lhs, condition ]) -> S.If condition [lhs]
     ("if_modifier", _ ) -> S.Error children
     ("if_statement", condition : body ) -> S.If condition body
diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs
index c57e4420a..409fcc6da 100644
--- a/src/Renderer/JSON.hs
+++ b/src/Renderer/JSON.hs
@@ -107,7 +107,7 @@ syntaxToTermField syntax = case syntax of
   S.SubscriptAccess identifier property -> [ "identifier" .= identifier ] <> [ "property" .= property ]
   S.Switch expression cases -> [ "expression" .= expression ] <> [ "cases" .= cases ]
   S.Case expression statements -> [ "expression" .= expression ] <> [ "statements" .= statements ]
-  S.Object keyValuePairs -> childrenFields keyValuePairs
+  S.Object ty keyValuePairs -> [ "type" .= ty ] <> childrenFields keyValuePairs
   S.Pair a b -> childrenFields [a, b]
   S.Comment _ -> []
   S.Commented comments child -> childrenFields (comments <> maybeToList child)
@@ -119,7 +119,7 @@ syntaxToTermField syntax = case syntax of
   S.Throw c -> [ "expression" .= c ]
   S.Constructor expression -> [ "expression" .= expression ]
   S.Try body catchExpression elseExpression finallyExpression -> [ "body" .= body ] <> [ "catchExpression" .= catchExpression ] <> [ "elseExpression" .= elseExpression ] <> [ "finallyExpression" .= finallyExpression ]
-  S.Array c -> childrenFields c
+  S.Array ty c -> [ "type" .= ty ] <> childrenFields c
   S.Class identifier superclass definitions -> [ "identifier" .= identifier ] <> [ "superclass" .= superclass ] <> [ "definitions" .= definitions ]
   S.Method identifier parameters definitions -> [ "identifier" .= identifier ] <> [ "parameters" .= parameters ] <> [ "definitions" .= definitions ]
   S.If expression clauses -> [ "expression" .= expression ] <> childrenFields clauses
@@ -135,4 +135,5 @@ syntaxToTermField syntax = case syntax of
   S.Defer cases -> childrenFields cases
   S.TypeAssertion a b -> childrenFields [a, b]
   S.TypeConversion a b -> childrenFields [a, b]
+  S.Struct ty fields -> [ "type" .= ty ] <> childrenFields fields
   where childrenFields c = [ "children" .= c ]
diff --git a/src/Syntax.hs b/src/Syntax.hs
index 3e77ac1be..81487d4a8 100644
--- a/src/Syntax.hs
+++ b/src/Syntax.hs
@@ -48,7 +48,7 @@ data Syntax a f
   | Switch { switchExpr :: f, cases :: [f] }
   | Case { caseExpr :: f, caseStatements :: [f] }
   | Select { cases :: [f] }
-  | Object { keyValues :: [f] }
+  | Object { objectTy :: Maybe f, keyValues :: [f] }
   -- | A pair in an Object. e.g. foo: bar or foo => bar
   | Pair f f
   -- | A comment.
@@ -66,7 +66,7 @@ data Syntax a f
   -- | TODO: Is it a problem that in Ruby, this pattern can work for method def too?
   | Try { tryBegin :: [f], catchRescue :: [f], beginElse :: Maybe f, finallyEnsure :: Maybe f }
   -- | An array literal with list of children.
-  | Array [f]
+  | Array (Maybe f) [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.
@@ -88,6 +88,8 @@ data Syntax a f
   | Defer f
   | TypeAssertion f f
   | TypeConversion f f
+  -- | A struct with an optional type
+  | Struct (Maybe f) [f]
   deriving (Eq, Foldable, Functor, Generic, Generic1, Mergeable, Ord, Show, Traversable, ToJSON)