Merge master into git-diff

.gitignore

@@ -7,3 +7,22 @@ xcuserdata
 .stack-work
 semantic-diff-profile.*
 tags
+
+vendor/icu/tools
+vendor/icu/lib
+vendor/icu/layoutex
+vendor/icu/layout
+vendor/icu/i18n
+vendor/icu/test/
+vendor/icu/stubdata/
+vendor/icu/samples/
+vendor/icu/io/
+vendor/icu/icudefs.mk
+vendor/icu/extra/
+vendor/icu/data/
+vendor/icu/config/
+vendor/icu/config.status
+vendor/icu/config.log
+vendor/icu/common/
+vendor/icu/bin/
+vendor/icu/Makefile

.gitmodules

@@ -1,6 +1,6 @@
 [submodule "vendor/tree-sitter-parsers"]
 	path = vendor/tree-sitter-parsers
-	url = https://github.com/github/tree-sitter-parsers
+	url = git@github.com:github/tree-sitter-parsers.git
 [submodule "vendor/text-icu"]
 	path = vendor/text-icu
 	url = https://github.com/joshvera/text-icu

ROADMAP.md

@@ -1,17 +1,17 @@
 # Semantic diff roadmap
 
-During Q4 2015/Q1 2016, the focus of the semantic diff project will be building tooling and prototypes in exploration of how we _can_ interact with changes to source files, and how we _want_ to do so.
-
-This is a living document and will be updated as necessary.
-
-## Q4 2015
-
-1. A semantic diff prototyping toolkit. Library & wrapper tool for experimentation with diffing algorithms & spitting out actual diffs so we can evaluate alternatives more easily.
-
-2. A prototype of user-facing semantic diff presentation and interaction.
-
-3. [Table of contents for .com diffs](https://github.com/github/semantic-diff/issues/16), linking to defined symbols in supported sources.
-
 ## Q1 2016
 
-1. [Semantic diffing on .com](https://github.com/github/semantic-diff/milestones/Dot%20Calm).
+1. [Staff ship & limited beta of semantic diffing on .com](https://github.com/github/semantic-diff/milestones/Staff%20Ship). This will be an opt-in, limited release of semantic diffs for a very small set of languages. UI in general will be unchanged; we’ll simply start showing better diffs for the languages in question. The goal is to ease ourselves into deployment of the system, and benchmark under real loads.
+
+2. [Semantic diffing on .com](https://github.com/github/semantic-diff/milestones/Dot%20Calm). General release of semantic diffs for the supported languages.
+
+
+## Q2–Q4 2016
+
+We will discuss future milestones at the **@github/network-intelligence** minisummit mid-Q1 2016, and document them here at that point.
+ 
+
+## Ongoing
+
+- Creation, curation, and cultivation of grammars for semantic diffs.

Setup.hs

@@ -1,2 +1,28 @@
+import Data.Maybe
+import qualified Distribution.PackageDescription as P
 import Distribution.Simple
-main = defaultMain
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Setup
+import System.Directory
+import System.Process
+
+main = defaultMainWithHooks simpleUserHooks { confHook = conf }
+
+conf :: (P.GenericPackageDescription, P.HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo
+conf x flags = do
+  localBuildInfo <- confHook simpleUserHooks x flags
+  let packageDescription = localPkgDescr localBuildInfo
+      library = fromJust $ P.library packageDescription
+      libraryBuildInfo = P.libBuildInfo library
+      relativeIncludeDirs = [ "common", "i18n" ] in do
+      dir <- getCurrentDirectory
+      return localBuildInfo {
+        localPkgDescr = packageDescription {
+          P.library = Just $ library {
+            P.libBuildInfo = libraryBuildInfo {
+              P.extraLibDirs = (dir ++ "/vendor/icu/lib") : P.extraLibDirs libraryBuildInfo,
+              P.includeDirs = (((dir ++ "/vendor/icu/source/") ++) <$> relativeIncludeDirs) ++ P.includeDirs libraryBuildInfo
+            }
+          }
+        }
+      }

app/Main.hs

@@ -22,7 +22,6 @@ import qualified Data.Text.Lazy.IO as TextIO
 import qualified System.IO as IO
 import qualified Data.Text.ICU.Detect as Detect
 import qualified Data.Text.ICU.Convert as Convert
-import Data.Biapplicative
 import Data.Bifunctor.Join
 import Git.Libgit2
 import Git.Types
@@ -32,14 +31,14 @@ import Control.Monad.Reader
 
 data Renderer = Unified | Split | Patch
 
-data Argument = Argument { renderer :: Renderer, output :: Maybe FilePath, shaA :: String, shaB :: String, repoPath :: FilePath, filepath :: FilePath }
+data Arguments = Arguments { renderer :: Renderer, output :: Maybe FilePath, shaA :: String, shaB :: String, repositoryPath :: FilePath, filepath :: FilePath }
 
-arguments :: Parser Argument
-arguments = Argument
+arguments :: Parser Arguments
+arguments = Arguments
   <$> (flag Split Unified (long "unified" <> help "output a unified diff")
   <|> flag Split Patch (long "patch" <> help "output a patch(1)-compatible diff")
   <|> flag' Split (long "split" <> help "output a split diff"))
-  <*> (optional $ strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaulting to stdout if unspecified"))
+  <*> optional (strOption (long "output" <> short 'o' <> help "output directory for split diffs, defaulting to stdout if unspecified"))
   <*> strArgument (metavar "SHA_A")
   <*> strArgument (metavar "SHA_B")
   <*> strArgument (metavar "REPO_PATH")
@@ -47,12 +46,12 @@ arguments = Argument
 
 main :: IO ()
 main = do
-  arguments@Argument{..} <- execParser opts
+  arguments@Arguments{..} <- execParser opts
   let shas = Join (shaA, shaB)
-  sources <- sequence $ (fetchFromGitRepo repoPath filepath <$> shas)
+  sources <- sequence $ fetchFromGitRepo repositoryPath filepath <$> shas
   let parse = (P.parserForType . T.pack . takeExtension) filepath
   terms <- sequence $ parse <$> sources
-  let replaceLeaves = replaceLeavesWithWordBranches <$> sources
+  let replaceLeaves = breakDownLeavesByWord <$> sources
   printDiff arguments (runJoin sources) (runJoin $ replaceLeaves <*> terms)
   where opts = info (helper <*> arguments)
           (fullDesc <> progDesc "Diff some things" <> header "semantic-diff - diff semantically")
@@ -63,7 +62,7 @@ fetchFromGitRepo repoPath path sha = join $ withRepository lgFactory repoPath $
     commitIHope <- lookupObject object
     commit <- case commitIHope of
       (CommitObj commit) -> return commit
-      obj -> error $ "Expected commit SHA"
+      obj -> error "Expected commit SHA"
     tree <- lookupTree (commitTree commit)
     entry <- treeEntry tree (B1.pack path)
     bytestring <- case entry of
@@ -74,7 +73,7 @@ fetchFromGitRepo repoPath path sha = join $ withRepository lgFactory repoPath $
                    return s
     return $ transcode bytestring
 
-printDiff :: Argument -> (Source Char, Source Char) -> (Term T.Text Info, Term T.Text Info) -> IO ()
+printDiff :: Arguments -> (Source Char, Source Char) -> (Term T.Text Info, Term T.Text Info) -> IO ()
 printDiff arguments (aSource, bSource) (aTerm, bTerm) = case renderer arguments of
   Unified -> do
     rendered <- unified diff aSource bSource
@@ -89,20 +88,16 @@ printDiff arguments (aSource, bSource) (aTerm, bTerm) = case renderer arguments
                          else path
         IO.withFile outputPath IO.WriteMode (write rendered)
       Nothing -> TextIO.putStr rendered
-  Patch -> do
-    putStr $ PatchOutput.patch diff aSource bSource
+  Patch -> putStr $ PatchOutput.patch diff aSource bSource
   where diff = interpret comparable aTerm bTerm
         write rendered h = TextIO.hPutStr h rendered
 
-replaceLeavesWithWordBranches :: Source Char -> Term T.Text Info -> Term T.Text Info
-replaceLeavesWithWordBranches source = replaceIn source 0
+breakDownLeavesByWord :: Source Char -> Term T.Text Info -> Term T.Text Info
+breakDownLeavesByWord source = cata replaceIn
   where
-    replaceIn source startIndex (info@(Info range categories) :< syntax) | substring <- slice (offsetRange (negate startIndex) range) source = info :< case syntax of
-      Leaf _ | ranges <- rangesAndWordsFrom (start range) (toList substring), length ranges > 1 -> Indexed $ makeLeaf categories <$> ranges
-      Indexed i -> Indexed $ replaceIn substring (start range) <$> i
-      Fixed f -> Fixed $ replaceIn substring (start range) <$> f
-      Keyed k -> Keyed $ replaceIn substring (start range) <$> k
-      _ -> syntax
+    replaceIn info@(Info range categories) (Leaf _) | ranges <- rangesAndWordsInSource range, length ranges > 1 = info :< (Indexed $ makeLeaf categories <$> ranges)
+    replaceIn info syntax = info :< syntax
+    rangesAndWordsInSource range = rangesAndWordsFrom (start range) (toList $ slice range source)
     makeLeaf categories (range, substring) = Info range categories :< Leaf (T.pack substring)
 
 readAndTranscodeFile :: FilePath -> IO (Source Char)

semantic-diff.cabal

@@ -5,9 +5,9 @@ description:         Please see README.md
 homepage:            http://github.com/github/semantic-diff#readme
 author:              Rob Rix, Josh Vera
 maintainer:          rob.rix@github.com
-copyright:           2015 GitHub
+copyright:           2016 GitHub
 category:            Web
-build-type:          Simple
+build-type:          Custom
 -- extra-source-files:
 cabal-version:       >=1.10
 
@@ -20,7 +20,7 @@ library
                      , Interpreter
                      , Line
                      , Row
-                     , OrderedMap
+                     , Data.OrderedMap
                      , Patch
                      , PatchOutput
                      , SES
@@ -51,7 +51,12 @@ executable semantic-diff-exe
   hs-source-dirs:      app
   main-is:             Main.hs
   other-modules:       Parsers
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  if os(darwin)
+    ghc-options:       -threaded -rtsopts -with-rtsopts=-N -static
+  else
+    ghc-options:       -threaded -rtsopts -with-rtsopts=-N -static -pgml=script/g++
+  cc-options:          -DU_STATIC_IMPLEMENTATION=1
+  cpp-options:         -DU_STATIC_IMPLEMENTATION=1
   build-depends:       base
                      , bifunctors
                      , bytestring
@@ -69,38 +74,19 @@ executable semantic-diff-exe
                      , mtl
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings
-
-executable semantic-diff-profile
-  hs-source-dirs:      app
-  main-is:             Main.hs
-  other-modules:       Parsers
-  ghc-options:         -O2
-                       -threaded
-                       -fprof-auto
-                       "-with-rtsopts=-N -p -s -h -i0.1"
-  build-depends:       base
-                     , bifunctors
-                     , bytestring
-                     , containers
-                     , directory
-                     , filepath
-                     , free
-                     , optparse-applicative
-                     , semantic-diff
-                     , text >= 1.2.1.3
-                     , text-icu
-                     , gitlib
-                     , gitlib-libgit2
-                     , tagged
-                     , mtl
-  default-extensions:  OverloadedStrings
-  default-language:    Haskell2010
+  if os(darwin)
+    extra-libraries:   stdc++ icuuc icudata icui18n
 
 test-suite semantic-diff-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
   other-modules:       ArbitraryTerm
+                     , InterpreterSpec
+                     , OrderedMapSpec
+                     , PatchOutputSpec
+                     , SplitSpec
+                     , TermSpec
   build-depends:       base
                      , containers
                      , free

src/Data/OrderedMap.hs

@@ -1,10 +1,10 @@
-module OrderedMap (
+module Data.OrderedMap (
     OrderedMap
   , fromList
   , toList
   , keys
   , (!)
-  , OrderedMap.lookup
+  , Data.OrderedMap.lookup
   , size
   , empty
   , union
@@ -31,7 +31,7 @@ keys (OrderedMap pairs) = fst <$> pairs
 infixl 9 !
 
 (!) :: Eq key => OrderedMap key value -> key -> value
-map ! key = Maybe.fromMaybe (error "no value found for key") $ OrderedMap.lookup key map
+map ! key = Maybe.fromMaybe (error "no value found for key") $ Data.OrderedMap.lookup key map
 
 lookup :: Eq key => key -> OrderedMap key value -> Maybe value
 lookup key = Prelude.lookup key . toList

src/Interpreter.hs

@@ -10,8 +10,8 @@ import Syntax
 import Term
 import Control.Monad.Free
 import Control.Comonad.Cofree hiding (unwrap)
-import qualified OrderedMap as Map
-import OrderedMap ((!))
+import qualified Data.OrderedMap as Map
+import Data.OrderedMap ((!))
 import qualified Data.List as List
 import Data.List ((\\))
 import Data.Maybe

src/Operation.hs

@@ -1,7 +1,7 @@
 module Operation where
 
 import Diff
-import OrderedMap
+import Data.OrderedMap
 import qualified Data.Text as T
 import Term
 

src/Parser.hs

@@ -4,7 +4,7 @@ import Diff
 import Syntax
 import Term
 import Control.Comonad.Cofree
-import qualified OrderedMap as Map
+import qualified Data.OrderedMap as Map
 import qualified Data.Set as Set
 import Source
 import Data.Text as Text

src/Range.hs

@@ -9,11 +9,14 @@ import Data.Maybe (fromMaybe)
 data Range = Range { start :: !Int, end :: !Int }
   deriving (Eq, Show)
 
+rangeLength :: Range -> Int
+rangeLength range = end range - start range
+
 substring :: Range -> T.Text -> T.Text
-substring range = T.take (end range - start range) . T.drop (start range)
+substring range = T.take (rangeLength range) . T.drop (start range)
 
 sublist :: Range -> [a] -> [a]
-sublist range = take (end range - start range) . drop (start range)
+sublist range = take (rangeLength range) . drop (start range)
 
 totalRange :: T.Text -> Range
 totalRange t = Range 0 $ T.length t

src/Source.hs

@@ -18,7 +18,7 @@ toList :: Source a -> [a]
 toList = Vector.toList . getVector
 
 slice :: Range -> Source a -> Source a
-slice range = Source . Vector.slice (start range) (end range - start range) . getVector
+slice range = Source . Vector.slice (start range) (rangeLength range) . getVector
 
 toString :: Source Char -> String
 toString = toList

src/Split.hs

@@ -21,7 +21,7 @@ import Data.Either
 import Data.Foldable
 import Data.Functor.Identity
 import Data.Monoid
-import qualified OrderedMap as Map
+import qualified Data.OrderedMap as Map
 import qualified Data.Set as Set
 import Source hiding ((++))
 

src/Syntax.hs

@@ -1,6 +1,6 @@
 module Syntax where
 
-import OrderedMap
+import Data.OrderedMap
 import qualified Data.Text as T
 
 -- | A node in an abstract syntax tree.

src/Term.hs

@@ -1,6 +1,6 @@
 module Term where
 
-import OrderedMap hiding (size)
+import Data.OrderedMap hiding (size)
 import Data.Maybe
 import Control.Comonad.Cofree
 import Syntax

src/Unified.hs

@@ -10,7 +10,7 @@ import Control.Arrow
 import Control.Monad.Free
 import Control.Comonad.Cofree
 import Data.List hiding (foldl)
-import qualified OrderedMap as Map
+import qualified Data.OrderedMap as Map
 import Rainbow
 
 unified :: Diff a Info -> Source Char -> Source Char -> IO ByteString
@@ -30,7 +30,7 @@ unified diff before after = do
       afterChunk = maybe [] (change "+" . unifiedTerm after) $ Patch.after patch
 
     unifiedTerm :: Source Char -> Term a Info -> [Chunk String]
- 
+
     unifiedTerm source term = fst $ cata (annotationAndSyntaxToChunks source) term
 
     unifiedRange :: Range -> [([Chunk String], Maybe Range)] -> Source Char -> [Chunk String]

test/ArbitraryTerm.hs

@@ -5,7 +5,7 @@ import Syntax
 import Term
 import Control.Comonad.Cofree
 import Control.Monad
-import qualified OrderedMap as Map
+import qualified Data.OrderedMap as Map
 import qualified Data.List as List
 import qualified Data.Set as Set
 import GHC.Generics

test/OrderedMapSpec.hs

@@ -1,6 +1,6 @@
 module OrderedMapSpec where
 
-import OrderedMap as Map
+import qualified Data.OrderedMap as Map
 import Test.Hspec
 
 spec :: Spec

test/Spec.hs

@@ -1 +1,16 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+module Main where
+
+import qualified InterpreterSpec
+import qualified OrderedMapSpec
+import qualified PatchOutputSpec
+import qualified SplitSpec
+import qualified TermSpec
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+  describe "Interpreter" InterpreterSpec.spec
+  describe "OrderedMap" OrderedMapSpec.spec
+  describe "PatchOutput" PatchOutputSpec.spec
+  describe "Split" SplitSpec.spec
+  describe "Term" TermSpec.spec

test/TermSpec.hs

@@ -2,19 +2,13 @@ module TermSpec where
 
 import Test.Hspec
 import Test.Hspec.QuickCheck
-import Test.QuickCheck hiding (Fixed)
 import Data.Text.Arbitrary ()
 
 import Categorizable
 import Interpreter
 import Diff
-import Syntax
-import Term
 import ArbitraryTerm
 
-main :: IO ()
-main = hspec spec
-
 spec :: Spec
 spec = parallel $ do
   describe "Term" $ do

vendor/text-icu

@@ -1 +1 @@
-Subproject commit 843f3d1e47c29f859bafece88bdad9e526b8fb8e
+Subproject commit e0918154a29f096f41b5254dd31fb80c15023847

vendor/tree-sitter-parsers

@@ -1 +1 @@
-Subproject commit ddaaf9d0ab39345da4f1c6bda12958d67a6b4147
+Subproject commit fa44c40c5225f01ca5d06228978ce1120f677f58