From e855ae6fdeb7806bbe9a313b315084d11ff4b0f6 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 24 Aug 2016 12:18:14 -0500 Subject: [PATCH 01/15] Extract the args of a function call when constructing FunctionCall syntaxes --- src/Parser.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Parser.hs b/src/Parser.hs index 2b471d0d5..d2a0c5ce1 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -73,8 +73,8 @@ termConstructor source sourceSpan info = fmap cofree . construct pure $! setCategory info MethodCall :< S.MethodCall memberId property args [ (_ :< S.MemberAccess{..}) ] -> pure $! setCategory info MethodCall :< S.MethodCall memberId property [] - (x:xs) -> - withDefaultInfo $ S.FunctionCall (cofree x) (cofree <$> xs) + [ x@(_ :< S.Leaf{}), (_ :< S.Args args) ] -> + withDefaultInfo $ S.FunctionCall (cofree x) args _ -> errorWith children construct children | Ternary == category info = case children of From a213a5844f9e9007ecf09d34c55caee40d74e0a4 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 24 Aug 2016 12:18:57 -0500 Subject: [PATCH 02/15] Show children term names for function calls when constructing diff summary statements --- src/DiffSummary.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 0172798d8..6ecacff31 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -76,7 +76,7 @@ toTermName source term = case unwrap term of (S.MemberAccess{}, S.AnonymousFunction{..}) -> toTermName' identifier (_, _) -> toTermName' identifier <> toTermName' value S.Function identifier _ _ -> toTermName' identifier - S.FunctionCall i _ -> toTermName' i + S.FunctionCall i args -> toTermName' i <> "(" <> (intercalate ", " (toTermName' <$> args)) <> ")" S.MemberAccess base property -> case (unwrap base, unwrap property) of (S.FunctionCall{}, S.FunctionCall{}) -> toTermName' base <> "()." <> toTermName' property <> "()" (S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' property From 0d389bdad4464baf1c0d95e341e01c6c9169d7dc Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 24 Aug 2016 12:20:08 -0500 Subject: [PATCH 03/15] Don't specially treat FunctionCall syntaxes when constructing DiffInfos. Allow them to be treated as default LeafInfo instances. --- src/DiffSummary.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 6ecacff31..171f6b466 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -138,7 +138,6 @@ termToDiffInfo blob term = case unwrap term of S.AnonymousFunction _ _ -> LeafInfo (toCategoryName term) ("anonymous") S.Indexed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BIndexed S.Fixed children -> BranchInfo (termToDiffInfo' <$> children) (toCategoryName term) BFixed - S.FunctionCall identifier _ -> LeafInfo (toCategoryName term) (toTermName' identifier) S.Ternary ternaryCondition _ -> LeafInfo (toCategoryName term) (toTermName' ternaryCondition) S.Function identifier _ _ -> LeafInfo (toCategoryName term) (toTermName' identifier) S.Assignment identifier _ -> LeafInfo (toCategoryName term) (toTermName' identifier) From 986d88e5402794d41e357fead9c11d20286da9bc Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Thu, 25 Aug 2016 17:48:00 -0500 Subject: [PATCH 04/15] Add toArgName for function call args --- src/DiffSummary.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index bf8778195..7af394770 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -85,7 +85,7 @@ toLeafInfos BranchInfo{..} = toLeafInfos =<< branches toLeafInfos err@ErrorInfo{} = pure (pretty err) -- Returns a text representing a specific term given a source and a term. -toTermName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> Text +toTermName :: forall leaf fields. (HasCategory leaf, HasField fields Category, HasField fields Range) => Source Char -> Term leaf (Record fields) -> Text toTermName source term = case unwrap term of S.AnonymousFunction _ _ -> "anonymous" S.Fixed children -> fromMaybe "branch" $ (toCategoryName . category) . extract <$> head children @@ -95,7 +95,7 @@ toTermName source term = case unwrap term of (S.MemberAccess{}, S.AnonymousFunction{..}) -> toTermName' identifier (_, _) -> toTermName' identifier <> toTermName' value S.Function identifier _ _ -> toTermName' identifier - S.FunctionCall i args -> toTermName' i <> "(" <> (intercalate ", " (toTermName' <$> args)) <> ")" + S.FunctionCall i args -> toTermName' i <> "(" <> (intercalate ", " (toArgName <$> args)) <> ")" S.MemberAccess base property -> case (unwrap base, unwrap property) of (S.FunctionCall{}, S.FunctionCall{}) -> toTermName' base <> "()." <> toTermName' property <> "()" (S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' property @@ -143,6 +143,10 @@ toTermName source term = case unwrap term of termNameFromSource term = termNameFromRange (range term) termNameFromRange range = toText $ Source.slice range source range = characterRange . extract + toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Text + toArgName arg = case unwrap arg of + S.AnonymousFunction _ _ -> "..." + _ -> toTermName' arg maybeParentContext :: Maybe (Category, Text) -> Doc maybeParentContext = maybe "" (\annotation -> From 8bda7645ee3b65d70b350102cae2a62d35abfef8 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 14:42:09 -0500 Subject: [PATCH 05/15] Add Identifiable data type --- src/DiffSummary.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 7af394770..8fac9ba46 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -22,6 +22,7 @@ import qualified Text.PrettyPrint.Leijen.Text as P import SourceSpan import Source +data Identifiable a = Identifiable a | Unidentifiable a data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text } | BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch } | ErrorInfo { errorSpan :: SourceSpan, termName :: Text } From e8d3132696a27eaa91dc98e6bc53f06a76cabf30 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 14:42:25 -0500 Subject: [PATCH 06/15] Add identifiable constructor function --- src/DiffSummary.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 8fac9ba46..e3381bb69 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -13,6 +13,7 @@ import Category as C import Data.Functor.Foldable as Foldable import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both +import qualified Data.Set as Set import Data.Text as Text (intercalate) import Test.QuickCheck hiding (Fixed) import Patch.Arbitrary() @@ -23,6 +24,23 @@ import SourceSpan import Source data Identifiable a = Identifiable a | Unidentifiable a + +hasIdentity = Set.fromList [ C.FunctionCall + , C.Function + , C.Assignment + , C.MathAssignment + , C.MemberAccess + , C.MethodCall + , C.VarAssignment + , C.SubscriptAccess + , C.Class + , C.Method + , C.Identifier + ] + +identifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Identifiable (Term leaf (Record fields)) +identifiable term = if Set.member (category . extract $ term) hasIdentity then Identifiable term else Unidentifiable term + data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text } | BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch } | ErrorInfo { errorSpan :: SourceSpan, termName :: Text } From 4f2ec3c00d054b1904be6e7af2c2ba8b8da22bf7 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 14:43:31 -0500 Subject: [PATCH 07/15] Update method call syntax terms to use `toArgName` when determining term names --- src/DiffSummary.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index e3381bb69..b138aca9c 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -120,7 +120,7 @@ toTermName source term = case unwrap term of (S.FunctionCall{}, _) -> toTermName' base <> "()." <> toTermName' property (_, S.FunctionCall{}) -> toTermName' base <> "." <> toTermName' property <> "()" (_, _) -> toTermName' base <> "." <> toTermName' property - S.MethodCall targetId methodId _ -> toTermName' targetId <> sep <> toTermName' methodId <> "()" + S.MethodCall targetId methodId methodParams -> toTermName' targetId <> sep <> toTermName' methodId <> "(" <> (intercalate ", " (toArgName <$> methodParams)) <> ")" where sep = case unwrap targetId of S.FunctionCall{} -> "()." _ -> "." @@ -163,9 +163,9 @@ toTermName source term = case unwrap term of termNameFromRange range = toText $ Source.slice range source range = characterRange . extract toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Text - toArgName arg = case unwrap arg of - S.AnonymousFunction _ _ -> "..." - _ -> toTermName' arg + toArgName arg = case identifiable arg of + Identifiable arg -> toTermName' arg + Unidentifiable _ -> "..." maybeParentContext :: Maybe (Category, Text) -> Doc maybeParentContext = maybe "" (\annotation -> From 0c82459b84dedaddd3ee80b6aed0b1b57a8f85e4 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 14:43:55 -0500 Subject: [PATCH 08/15] Reuse identifiable constructor function for `prependSummary` --- src/DiffSummary.hs | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index b138aca9c..95d63cf79 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -194,21 +194,10 @@ termToDiffInfo blob term = case unwrap term of termToDiffInfo' = termToDiffInfo blob prependSummary :: (HasCategory leaf, HasField fields Range, HasField fields Category) => Source Char -> Term leaf (Record fields) -> DiffSummary DiffInfo -> DiffSummary DiffInfo -prependSummary source term summary = if (isNothing $ parentAnnotation summary) && hasIdentifier term - then summary { parentAnnotation = Just (category $ extract term, toTermName source term) } - else summary - where hasIdentifier term = case unwrap term of - S.FunctionCall{} -> True - S.Function _ _ _ -> True - S.Assignment{} -> True - S.MathAssignment{} -> True - S.MemberAccess{} -> True - S.MethodCall{} -> True - S.VarAssignment{} -> True - S.SubscriptAccess{} -> True - S.Class{} -> True - S.Method{} -> True - _ -> False +prependSummary source term summary = + case (parentAnnotation summary, identifiable term) of + (Nothing, Identifiable term) -> summary { parentAnnotation = Just (category . extract $ term, toTermName source term) } + (_, _) -> summary isBranchInfo :: DiffInfo -> Bool isBranchInfo info = case info of From bf888f52f90cd81df5bfe980fef8fce31dd14da7 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 17:57:48 -0500 Subject: [PATCH 09/15] Add newlines for easier readability (and easier vim'ing) --- src/Parser.hs | 126 ++++++++++++++++++++++++++------------------------ 1 file changed, 66 insertions(+), 60 deletions(-) diff --git a/src/Parser.hs b/src/Parser.hs index d2a0c5ce1..4989eef7a 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -40,49 +40,56 @@ termConstructor source sourceSpan info = fmap cofree . construct construct [] = case category info of Return -> withDefaultInfo $ S.Return Nothing -- Map empty return statements to Return Nothing _ -> withDefaultInfo . S.Leaf . pack . toString $ slice (characterRange info) source + construct children | Return == category info = withDefaultInfo $ S.Return (listToMaybe children) + construct children | Assignment == category info = case children of (identifier:value:[]) -> withDefaultInfo $ S.Assignment identifier value children -> errorWith children + construct children | MathAssignment == category info = case children of (identifier:value:[]) -> withDefaultInfo $ S.MathAssignment identifier value children -> errorWith children + construct children | MemberAccess == category info = case children of (base:property:[]) -> withDefaultInfo $ S.MemberAccess base property children -> errorWith children + construct children | SubscriptAccess == category info = case children of (base:element:[]) -> withDefaultInfo $ S.SubscriptAccess base element _ -> errorWith children + construct children | isOperator (category info) = withDefaultInfo $ S.Operator children + construct children | CommaOperator == category info = withDefaultInfo $ case children of [child, rest] | S.Indexed cs <- unwrap rest -> S.Indexed $ child : toList cs _ -> S.Indexed children - construct children | Function == category info = case children of - (body:[]) -> withDefaultInfo $ S.AnonymousFunction Nothing body - (params:body:[]) | (info :< _) <- runCofree params, Params == category info -> - withDefaultInfo $ S.AnonymousFunction (Just params) body - (id:body:[]) | (info :< _) <- runCofree id, Identifier == category info -> - withDefaultInfo $ S.Function id Nothing body - (id:params:body:[]) | (info :< _) <- runCofree id, Identifier == category info -> - withDefaultInfo $ S.Function id (Just params) body - _ -> errorWith children - construct children | FunctionCall == category info = case runCofree <$> children of - [ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] -> - pure $! setCategory info MethodCall :< S.MethodCall memberId property args - [ (_ :< S.MemberAccess{..}) ] -> - pure $! setCategory info MethodCall :< S.MethodCall memberId property [] - [ x@(_ :< S.Leaf{}), (_ :< S.Args args) ] -> - withDefaultInfo $ S.FunctionCall (cofree x) args - _ -> errorWith children + construct children | Function == category info = + case children of + (body:[]) -> withDefaultInfo $ S.AnonymousFunction Nothing body + (params:body:[]) | (info :< _) <- runCofree params, Params == category info -> withDefaultInfo $ S.AnonymousFunction (Just params) body + (id:body:[]) | (info :< _) <- runCofree id, Identifier == category info -> withDefaultInfo $ S.Function id Nothing body + (id:params:body:[]) | (info :< _) <- runCofree id, Identifier == category info -> withDefaultInfo $ S.Function id (Just params) body + _ -> errorWith children + + construct children | FunctionCall == category info = + case runCofree <$> children of + [ (_ :< S.MemberAccess{..}), (_ :< S.Args args) ] -> pure $! setCategory info MethodCall :< S.MethodCall memberId property args + [ (_ :< S.MemberAccess{..}) ] -> pure $! setCategory info MethodCall :< S.MethodCall memberId property [] + [ x@(_ :< S.Leaf{}), (_ :< S.Args args) ] -> withDefaultInfo $ S.FunctionCall (cofree x) args + _ -> errorWith children + + construct children | Ternary == category info = + case children of + (condition:cases) -> withDefaultInfo $ S.Ternary condition cases + _ -> errorWith children - construct children | Ternary == category info = case children of - (condition:cases) -> withDefaultInfo $ S.Ternary condition cases - _ -> errorWith children construct children | Args == category info = withDefaultInfo $ S.Args children - construct children | VarAssignment == category info - , [x, y] <- children = withDefaultInfo $ S.VarAssignment x y + + construct children | VarAssignment == category info, [x, y] <- children = withDefaultInfo $ S.VarAssignment x y + construct children | VarDecl == category info = withDefaultInfo . S.Indexed $ toVarDecl <$> children where toVarDecl :: (HasField fields Category) => Term Text (Record fields) -> Term Text (Record fields) @@ -103,46 +110,45 @@ termConstructor source sourceSpan info = fmap cofree . construct toTuple child = pure child construct children | Pair == (category info) = withDefaultInfo $ S.Fixed children - construct children | C.Error == category info = - errorWith children + + construct children | C.Error == category info = errorWith children + construct children | If == category info, Just (expr, clauses) <- uncons children = case clauses of [clause1, clause2] -> withDefaultInfo $ S.If expr clause1 (Just clause2) [clause] -> withDefaultInfo $ S.If expr clause Nothing _ -> errorWith children - construct children | For == category info, Just (exprs, body) <- unsnoc children = - withDefaultInfo $ S.For exprs body - construct children | While == category info, [expr, body] <- children = - withDefaultInfo $ S.While expr body - construct children | DoWhile == category info, [expr, body] <- children = - withDefaultInfo $ S.DoWhile expr body - construct children | Throw == category info, [expr] <- children = - withDefaultInfo $ S.Throw expr - construct children | Constructor == category info, [expr] <- children = - withDefaultInfo $ S.Constructor expr - construct children | Try == category info = case children of - [body] -> withDefaultInfo $ S.Try body Nothing Nothing - [body, catch] | Catch <- category (extract catch) -> withDefaultInfo $ S.Try body (Just catch) Nothing - [body, finally] | Finally <- category (extract finally) -> withDefaultInfo $ S.Try body Nothing (Just finally) - [body, catch, finally] | Catch <- category (extract catch), - Finally <- category (extract finally) -> - withDefaultInfo $ S.Try body (Just catch) (Just finally) - _ -> errorWith children - construct children | ArrayLiteral == category info = - withDefaultInfo $ S.Array children - construct children | Method == category info = case children of - [identifier, params, exprs] | - Params == category (extract params), - S.Indexed params' <- unwrap params -> - withDefaultInfo $ S.Method identifier params' (toList (unwrap exprs)) - [identifier, exprs] -> - withDefaultInfo $ S.Method identifier mempty (toList (unwrap exprs)) - _ -> errorWith children - construct children | Class == category info = case children of - [identifier, superclass, definitions] -> - withDefaultInfo $ S.Class identifier (Just superclass) (toList (unwrap definitions)) - [identifier, definitions] -> - withDefaultInfo $ S.Class identifier Nothing (toList (unwrap definitions)) - _ -> errorWith children - construct children = - withDefaultInfo $ S.Indexed children + + construct children | For == category info, Just (exprs, body) <- unsnoc children = withDefaultInfo $ S.For exprs body + + construct children | While == category info, [expr, body] <- children = withDefaultInfo $ S.While expr body + + construct children | DoWhile == category info, [expr, body] <- children = withDefaultInfo $ S.DoWhile expr body + + construct children | Throw == category info, [expr] <- children = withDefaultInfo $ S.Throw expr + + construct children | Constructor == category info, [expr] <- children = withDefaultInfo $ S.Constructor expr + + construct children | Try == category info = + case children of + [body] -> withDefaultInfo $ S.Try body Nothing Nothing + [body, catch] | Catch <- category (extract catch) -> withDefaultInfo $ S.Try body (Just catch) Nothing + [body, finally] | Finally <- category (extract finally) -> withDefaultInfo $ S.Try body Nothing (Just finally) + [body, catch, finally] | Catch <- category (extract catch), Finally <- category (extract finally) -> withDefaultInfo $ S.Try body (Just catch) (Just finally) + _ -> errorWith children + + construct children | ArrayLiteral == category info = withDefaultInfo $ S.Array children + + construct children | Method == category info = + case children of + [identifier, params, exprs] | Params == category (extract params), S.Indexed params' <- unwrap params -> withDefaultInfo $ S.Method identifier params' (toList (unwrap exprs)) + [identifier, exprs] -> withDefaultInfo $ S.Method identifier mempty (toList (unwrap exprs)) + _ -> errorWith children + + construct children | Class == category info = + case children of + [identifier, superclass, definitions] -> withDefaultInfo $ S.Class identifier (Just superclass) (toList (unwrap definitions)) + [identifier, definitions] -> withDefaultInfo $ S.Class identifier Nothing (toList (unwrap definitions)) + _ -> errorWith children + + construct children = withDefaultInfo $ S.Indexed children From fdd56cc67d7725236552e7f7c321674b6da1847f Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 26 Aug 2016 17:59:26 -0500 Subject: [PATCH 10/15] :fire: hasIdentity and dependency on Category MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit We should use Syntax because we cannot guarantee that a given term’s category will always match or correspond with its Syntax. We also plan to move away from using Category all together, and relying on Category here would only add more more work for us in the future. --- src/DiffSummary.hs | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 95d63cf79..48e107c7b 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -13,7 +13,6 @@ import Category as C import Data.Functor.Foldable as Foldable import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both -import qualified Data.Set as Set import Data.Text as Text (intercalate) import Test.QuickCheck hiding (Fixed) import Patch.Arbitrary() @@ -25,21 +24,22 @@ import Source data Identifiable a = Identifiable a | Unidentifiable a -hasIdentity = Set.fromList [ C.FunctionCall - , C.Function - , C.Assignment - , C.MathAssignment - , C.MemberAccess - , C.MethodCall - , C.VarAssignment - , C.SubscriptAccess - , C.Class - , C.Method - , C.Identifier - ] +isIdentifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Bool +isIdentifiable term = + case unwrap term of + S.FunctionCall _ _ -> True + S.Function{} -> True + S.Assignment{} -> True + S.MathAssignment{} -> True + S.VarAssignment{} -> True + S.SubscriptAccess{} -> True + S.Class _ _ _ -> True + S.Method _ _ _ -> True + S.Leaf _ -> True + _ -> False identifiable :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Identifiable (Term leaf (Record fields)) -identifiable term = if Set.member (category . extract $ term) hasIdentity then Identifiable term else Unidentifiable term +identifiable term = if isIdentifiable term then Identifiable term else Unidentifiable term data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text } | BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch } From b07d4d2cdfe79944e6e67e23f695255ed93853e5 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 31 Aug 2016 13:09:41 -0500 Subject: [PATCH 11/15] Extract Arguments to its own module --- semantic-diff.cabal | 1 + src/Arguments.hs | 15 +++++++++++++++ 2 files changed, 16 insertions(+) create mode 100644 src/Arguments.hs diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 1e9cd3dc7..8b9b62986 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -15,6 +15,7 @@ library hs-source-dirs: src exposed-modules: Algorithm , Alignment + , Arguments , Category , Data.Align.Generic , Data.Bifunctor.Join.Arbitrary diff --git a/src/Arguments.hs b/src/Arguments.hs new file mode 100644 index 000000000..830ea80b0 --- /dev/null +++ b/src/Arguments.hs @@ -0,0 +1,15 @@ +module Arguments (Arguments(..)) where + +import Data.Functor.Both +import qualified Prelude as P +import Prologue +import qualified Renderer as R + +-- | The command line arguments to the application. +data Arguments = Arguments { + format :: R.Format, + maybeShas :: Both (Maybe P.String), + maybeTimeout :: Maybe Float, + output :: Maybe FilePath, + filepaths :: [FilePath] } + deriving (Show) From a78a9be087c28d4162b301bd9f29041d8a1bb3e0 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 31 Aug 2016 15:11:33 -0500 Subject: [PATCH 12/15] Move args smart constructor function to Arguments module --- src/Arguments.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Arguments.hs b/src/Arguments.hs index 830ea80b0..547b55d55 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -1,7 +1,8 @@ -module Arguments (Arguments(..)) where +module Arguments (Arguments(..), args) where import Data.Functor.Both import qualified Prelude as P +import Prelude import Prologue import qualified Renderer as R @@ -13,3 +14,11 @@ data Arguments = Arguments { output :: Maybe FilePath, filepaths :: [FilePath] } deriving (Show) + +args :: String -> String -> [String] -> R.Format -> Arguments +args sha1 sha2 filePaths format = Arguments { format = format + , maybeShas = Just <$> both sha1 sha2 + , filepaths = filePaths + , maybeTimeout = Just 10.0 + , output = Nothing + } From 2ad87cd022e6194025516d6db09973239a41af15 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 31 Aug 2016 16:57:32 -0500 Subject: [PATCH 13/15] :fire: extra space --- src/Renderer.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Renderer.hs b/src/Renderer.hs index 442d963a4..76a478517 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -19,7 +19,7 @@ data DiffArguments = DiffArguments { format :: Format, output :: Maybe FilePath, data Format = Split | Patch | JSON | Summary deriving (Show) -data Output = SplitOutput Text | PatchOutput Text | JSONOutput (Map Text Value) | SummaryOutput (Map Text (Map Text [Text])) +data Output = SplitOutput Text | PatchOutput Text | JSONOutput (Map Text Value) | SummaryOutput (Map Text (Map Text [Text])) deriving (Show) -- Returns a key representing the filename. If the filenames are different, From 59ee8eb0028b504d39c5e83739734e6645759162 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 6 Sep 2016 16:07:21 -0500 Subject: [PATCH 14/15] Update constructor-call JSONTestCases --- src/DiffSummary.hs | 2 +- vendor/text-icu | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index c6f64a6f9..1df82d683 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -165,7 +165,7 @@ toTermName source term = case unwrap term of toArgName :: (HasCategory leaf, HasField fields Category, HasField fields Range) => Term leaf (Record fields) -> Text toArgName arg = case identifiable arg of Identifiable arg -> toTermName' arg - Unidentifiable _ -> "..." + Unidentifiable arg -> "..." maybeParentContext :: Maybe (Category, Text) -> Doc maybeParentContext = maybe "" (\annotation -> diff --git a/vendor/text-icu b/vendor/text-icu index 6d07c2b20..1b58f3605 160000 --- a/vendor/text-icu +++ b/vendor/text-icu @@ -1 +1 @@ -Subproject commit 6d07c2b2034f2bfdcd038de0d6a3ceca445f0221 +Subproject commit 1b58f36050fc7e04047ded572747e2b12d553266 From 0d041ed3f49ab0573212c31b0d78f8ec01e75d21 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 6 Sep 2016 16:51:24 -0500 Subject: [PATCH 15/15] Use statically linked text-icu --- vendor/text-icu | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/text-icu b/vendor/text-icu index 1b58f3605..6d07c2b20 160000 --- a/vendor/text-icu +++ b/vendor/text-icu @@ -1 +1 @@ -Subproject commit 1b58f36050fc7e04047ded572747e2b12d553266 +Subproject commit 6d07c2b2034f2bfdcd038de0d6a3ceca445f0221