diff --git a/.gitignore b/.gitignore index cb0b8a9b1..d280975d8 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,4 @@ xcuserdata *.xccheckout .stack-work libbridge.dylib +semantic-diff-profile.* \ No newline at end of file diff --git a/prototype/UI/style.css b/prototype/UI/style.css index 50cbbaccf..98e591dda 100644 --- a/prototype/UI/style.css +++ b/prototype/UI/style.css @@ -1,10 +1,20 @@ table { - width: 100%; + width: 100%; + table-layout: fixed; } table.diff td { width: 50%; height: 15px; } + +table.diff td.blob-num { + width: 40px; +} + +table.diff td.blob-code { + min-width: 100px; +} + #before, #after { width: 50%; } diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 2c137b432..9ce2da5d4 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -53,6 +53,25 @@ executable semantic-diff-exe extra-libraries: bridge extra-lib-dirs: . +executable semantic-diff-profile + hs-source-dirs: app + main-is: Main.hs + other-modules: TreeSitter + ghc-options: -O2 + -threaded + -fprof-auto + "-with-rtsopts=-N -p -s -h -i0.1" + build-depends: base + , containers + , free + , semantic-diff + , bytestring + , optparse-applicative + , filepath + default-language: Haskell2010 + extra-libraries: bridge + extra-lib-dirs: . + test-suite semantic-diff-test type: exitcode-stdio-1.0 hs-source-dirs: test diff --git a/src/Split.hs b/src/Split.hs index 109373d8b..3f7cbabec 100644 --- a/src/Split.hs +++ b/src/Split.hs @@ -10,6 +10,7 @@ import Control.Comonad.Cofree import Range import Control.Monad.Free import Data.ByteString.Lazy.Internal +import Text.Blaze.Html import Text.Blaze.Html5 hiding (map) import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Utf8 @@ -62,7 +63,20 @@ split diff before after = return . renderHtml . ((head $ link ! A.rel (stringValue "stylesheet") ! A.href (stringValue "style.css")) <>) . body . (table ! A.class_ (stringValue "diff")) - . mconcat $ toMarkup <$> (fst $ diffToRows diff (0, 0) before after) + . mconcat $ toMarkup <$> (reverse $ foldl numberRows [] rows) + where + rows = fst $ diffToRows diff (0, 0) before after + + numberRows :: [(Int, Line, Int, Line)] -> Row -> [(Int, Line, Int, Line)] + numberRows [] (Row EmptyLine EmptyLine) = [] + numberRows [] (Row left@(Line _) EmptyLine) = [(1, left, 0, EmptyLine)] + numberRows [] (Row EmptyLine right@(Line _)) = [(0, EmptyLine, 1, right)] + numberRows [] (Row left right) = [(1, left, 1, right)] + numberRows rows@((leftCount, _, rightCount, _):_) (Row EmptyLine EmptyLine) = (leftCount, EmptyLine, rightCount, EmptyLine):rows + numberRows rows@((leftCount, _, rightCount, _):_) (Row left@(Line _) EmptyLine) = (leftCount + 1, left, rightCount, EmptyLine):rows + numberRows rows@((leftCount, _, rightCount, _):_) (Row EmptyLine right@(Line _)) = (leftCount, EmptyLine, rightCount + 1, right):rows + numberRows rows@((leftCount, _, rightCount, _):_) (Row left right) = (leftCount + 1, left, rightCount + 1, right):rows + data Row = Row Line Line deriving Eq @@ -70,12 +84,26 @@ data Row = Row Line Line instance Show Row where show (Row left right) = "\n" ++ show left ++ " | " ++ show right -instance ToMarkup Row where - toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) <> string "\n" +instance ToMarkup (Int, Line, Int, Line) where + toMarkup (_, EmptyLine, _, EmptyLine) = tr $ numberTd "" <> td (string "") <> numberTd "" <> toMarkup (string "") <> string "\n" + toMarkup (_, EmptyLine, num, right) = tr $ numberTd "" <> td (string "") <> + numberTd (show num) <> toMarkup right <> string "\n" + toMarkup (num, left, _, EmptyLine) = tr $ numberTd (show num) <> toMarkup left <> + numberTd "" <> td (string "") <> string "\n" + toMarkup (leftNum, left, rightNum, right) = tr $ numberTd (show leftNum) <> toMarkup left <> + numberTd (show rightNum) <> toMarkup right <> string "\n" + +numberTd :: String -> Html +numberTd s = td (string s) ! A.class_ (stringValue "blob-num") + +codeTd :: Html -> Html +codeTd el = td el ! A.class_ (stringValue "blob-code") +--instance ToMarkup Row where +-- toMarkup (Row left right) = (tr $ toMarkup left <> toMarkup right) <> string "\n" instance ToMarkup Line where - toMarkup EmptyLine = td (string "") - toMarkup (Line html) = td . mconcat $ toMarkup <$> html + toMarkup EmptyLine = codeTd (string "") + toMarkup (Line html) = codeTd . mconcat $ toMarkup <$> html data Line = Line [HTML]