mirror of
https://github.com/github/semantic.git
synced 2024-11-28 10:15:55 +03:00
Merge branch 'master' into split-rendering-of-fixed-nodes
# Conflicts: # src/Split.hs
This commit is contained in:
commit
aadd8c7f30
1
.gitignore
vendored
1
.gitignore
vendored
@ -6,3 +6,4 @@ xcuserdata
|
||||
*.xccheckout
|
||||
.stack-work
|
||||
libbridge.dylib
|
||||
semantic-diff-profile.*
|
@ -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%;
|
||||
}
|
||||
|
@ -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
|
||||
|
38
src/Split.hs
38
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
|
||||
@ -61,7 +62,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
|
||||
@ -69,12 +83,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]
|
||||
|
Loading…
Reference in New Issue
Block a user