packages feed

lambdiff (empty) → 0.1

raw patch · 8 files changed

+596/−0 lines, 8 filesdep +attoparsecdep +attoparsec-enumeratordep +basesetup-changed

Dependencies added: attoparsec, attoparsec-enumerator, base, bytestring, enumerator, gtk, mtl

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Jamie Turner++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jamie Turner nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lambdiff.cabal view
@@ -0,0 +1,72 @@+-- lambdiff.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                lambdiff++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Diff Viewer++-- A longer description of the package.+-- Description:         ++-- URL for the project homepage or repository.+Homepage:            https://github.com/jamwt/lambdiff.git++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Jamie Turner++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          jamie@bu.mp++-- A copyright notice.+-- Copyright:           ++Category:            Development++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.4++Executable lambdiff+  hs-source-dirs:      src++   -- Modules not exported by this package.+  Other-modules:      Lambdiff.DiffParse,+                      Lambdiff.Process,+                      Lambdiff.Types,+                      Lambdiff.UI++  Main-is: Lambdiff/Main.hs++  -- Packages needed in order to build this package.+  Build-depends:  base >= 4 && < 5,+                  bytestring>=0.9 && <1.0,+                  mtl>=2 && <3,+                  enumerator>=0.4.5 && < 0.5,+                  attoparsec>=0.9 && <1.0,+                  gtk>=0.12 && <0.13,+                  attoparsec-enumerator>=0.2 && < 0.3++  Extensions: OverloadedStrings,DeriveDataTypeable+  Extensions: FlexibleInstances,DoAndIfThenElse,ScopedTypeVariables+  Extensions: BangPatterns,GADTs++  Ghc-Options: -O2 -threaded -rtsopts -funfolding-use-threshold=16 -fexcess-precision -feager-blackholing
+ src/Lambdiff/DiffParse.hs view
@@ -0,0 +1,73 @@+module Lambdiff.DiffParse where++import Data.ByteString.Char8 as S+import Control.Applicative ((<|>))++import qualified Data.Attoparsec as Atto+import qualified Data.Attoparsec.Char8 as AttoC++data ParseFileResult = ParseFileResult S.ByteString S.ByteString [ParseChunk]+  deriving Show++data ParseChunk = ParseChunk Int Int [ParseLine]+  deriving Show++data ParseLine = ParseLineNone S.ByteString+               | ParseLineAdd S.ByteString+               | ParseLineSub S.ByteString+               | ParseLineComment S.ByteString+  deriving Show++diffParser :: Atto.Parser [ParseFileResult]+diffParser = Atto.many parseDiff++parseDiff :: Atto.Parser ParseFileResult+parseDiff = do+    (f1, f2) <- consumeHeader+    chunks <- Atto.many parseChunk+    return $ ParseFileResult f1 f2 chunks++parseChunk :: Atto.Parser ParseChunk+parseChunk = do+    Atto.string "@@ -"+    lineNo1 <- AttoC.decimal+    _ <- Atto.many1 $ AttoC.notChar '+'+    _ <- AttoC.char '+'+    lineNo2 <- AttoC.decimal+    _ <- Atto.many1 $ AttoC.notChar '\n'+    _ <- AttoC.char '\n'+    lines <- Atto.many1 parseChunkLine+    return $ ParseChunk lineNo1 lineNo2 lines++parseChunkLine :: Atto.Parser ParseLine+parseChunkLine = do+    const <- noLead <|> addLead <|> subLead <|> comLead+    restOfLine <- AttoC.takeWhile (/='\n')+    AttoC.char '\n'+    return $ const $ S.concat [restOfLine, "\n"]++noLead = AttoC.char ' ' >> (return ParseLineNone)+addLead = AttoC.char '+' >> (return ParseLineAdd)+subLead = AttoC.char '-' >> (return ParseLineSub)+comLead = AttoC.char '\\' >> (return ParseLineComment)++-- | Handle both git-style unified diffs and+-- | diff -u style ones+consumeHeader :: Atto.Parser (S.ByteString, S.ByteString)+consumeHeader = do+    (Atto.string "diff " >> AttoC.scan "" findFileTop) <|> (Atto.string "---")+    _  <- AttoC.char ' '+    f1 <- AttoC.takeWhile1 (\c -> and [(c/='\n'), (c/='\t')])+    _  <- AttoC.takeWhile (/='\n')+    _  <- Atto.string "\n+++ "+    f2 <- AttoC.takeWhile1 (\c -> and [(c/='\n'), (c/='\t')])+    _  <- AttoC.takeWhile (/='\n')+    _  <- AttoC.char '\n'+    return (f1, f2)+  where+    findFileTop "---\n" ' '  = Nothing+    findFileTop _       '\n' = Just "\n"+    findFileTop s       '-'  = Just $ '-' : s+    findFileTop _        _   = Just ""++
+ src/Lambdiff/Main.hs view
@@ -0,0 +1,24 @@+import Prelude hiding (sequence)+import Control.Monad (when)+import Data.Enumerator (run, ($$), sequence)+import Data.Enumerator.Binary (enumHandle)+import Data.Attoparsec.Enumerator (iterParser)+import System.IO (stdin)+import System.Exit++import Lambdiff.DiffParse (diffParser)+import Lambdiff.Process (processParseFile)+import Lambdiff.UI (renderUI)++main = do+    res <- run ((enumHandle 262144 stdin) $$ (iterParser diffParser))+    diffs <- case res of+                    Left _ -> do+                        putStrLn "Invalid diff; use unified format (`git diff` or `diff -u`)"+                        exitWith $ ExitFailure 1+                    Right d -> return d+    when (length diffs == 0) $ do+        putStrLn "No renderable diffs in input"+        exitWith $ ExitFailure 1++    renderUI $ map processParseFile diffs
+ src/Lambdiff/Process.hs view
@@ -0,0 +1,85 @@+module Lambdiff.Process where++import Data.List (foldl')+import Data.Maybe (fromMaybe)++import Lambdiff.DiffParse (ParseFileResult(..),+                           ParseChunk(..),+                           ParseLine(..))+import Lambdiff.Types+import Debug.Trace (trace)++isNotNull = (/= "/dev/null")++processParseFile :: ParseFileResult -> FileDiff+processParseFile (ParseFileResult name1 name2 chunks) =+    FileDiff unifiedFilename direction sections+  where+    unifiedFilename = if name1exists then name1 else name2++    name1exists = isNotNull name1+    name2exists = isNotNull name2+    direction = getDirection name1exists name2exists++    getDirection True True = DirectionChanged+    getDirection False True = DirectionAdded+    getDirection True False = DirectionRemoved++    sections = map processChunk chunks++processChunk :: ParseChunk -> DiffSection+processChunk (ParseChunk start1 start2 lines) =+    DiffSection plines+  where+    !plines = (reverse . fst4) $! foldl' processLine +                ([], start1, start2, Nothing) lines++fst4 (a, b, c, d) = a+++processLine :: ([DiffLine], Int, Int, Maybe Int) +            -> ParseLine +            -> ([DiffLine], Int, Int, Maybe Int) +processLine inp (ParseLineComment s) = inp++processLine (all, l1, l2, _) (ParseLineNone s) = +    (newline : all, l1 + 1, l2 + 1, Nothing)+  where+    newline = DiffLine DirectionNone (Just (l1, s)) (Just (l2, s))++processLine (all, l1, l2, msub) (ParseLineSub s) =+    (newline : all, l1 + 1, l2, Just $ (fromMaybe 0 msub) + 1)+  where+    newline = DiffLine DirectionRemoved (Just (l1, s)) Nothing+++-- change case, merge:+processLine (all, l1, l2, Just 1) (ParseLineAdd s) =+    (fixed, l1, l2 + 1, Nothing)+  where+    fixed = mergeChange allsimple+    allsimple = simple : all+    simple = DiffLine DirectionAdded Nothing (Just (l2, s))++-- non-change case:+processLine (all, l1, l2, msub) (ParseLineAdd s) =+    (newline : all, l1, l2 + 1, fmap (subtract 1) msub)+  where+    newline = DiffLine DirectionAdded Nothing (Just (l2, s))+++mergeChange :: [DiffLine] -> [DiffLine]+mergeChange lines = +    mergedLines ++ remainingLines+  where+    (opLines, remainingLines) = span isAddOrSub lines++    isAddOrSub (DiffLine DirectionAdded _ _) = True+    isAddOrSub (DiffLine DirectionRemoved _ _) = True+    isAddOrSub _ = False++    mergedLines = uncurry (zipWith mergeLine) $ splitAt (length opLines `div` 2) opLines++    mergeLine (DiffLine DirectionAdded Nothing add)+              (DiffLine DirectionRemoved sub Nothing) =+                    DiffLine DirectionChanged sub add
+ src/Lambdiff/Types.hs view
@@ -0,0 +1,19 @@+module Lambdiff.Types where++import Data.ByteString.Char8 as S++data FileDiff = FileDiff S.ByteString DiffDirection [DiffSection]+  deriving Show+data DiffDirection = DirectionAdded+                   | DirectionRemoved+                   | DirectionChanged+                   | DirectionNone+  deriving Show++data DiffSection = DiffSection [DiffLine]+  deriving Show++data DiffLine = DiffLine DiffDirection (Maybe LineData) (Maybe LineData)+  deriving Show++type LineData = (Int, S.ByteString)
+ src/Lambdiff/UI.hs view
@@ -0,0 +1,291 @@+module Lambdiff.UI where++import Control.Monad (mapM_)+import System.Exit+import qualified Data.ByteString.Char8 as S+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Gdk.Events (Event(Key))++import Lambdiff.Types++renderUI :: [FileDiff] -> IO ()+renderUI diffs = do+    initGUI+    window <- windowNew+    outbox <- vBoxNew True 2+    bar    <- labelNew $ Just "λiff v0.1 -- use keys (j, k, J, K, l, h, P, N, Esc)"+--    labelSetText bar "lambdiff"+--    entrySetHasFrame bar False+--    set bar [entryEditable := False]+    box <- hBoxNew True 8+    boxSetHomogeneous outbox False+    boxPackStart outbox box PackGrow 0+    boxPackStart outbox bar PackNatural 0+    tv <- treeViewNew+    scrollbox <- scrolledWindowNew Nothing Nothing+    ibox <- hBoxNew True 5+    i2 <- textViewNew+    i3 <- textViewNew++    textViewSetCursorVisible i2 False+    textViewSetCursorVisible i3 False++    scrolledWindowAddWithViewport scrollbox ibox+    boxSetHomogeneous box False+    boxPackStart box tv PackNatural 0+    boxPackStart box scrollbox PackGrow 0++    boxPackStart ibox i2 PackGrow 0+    boxPackStart ibox i3 PackGrow 0+    boxSetHomogeneous ibox False++    textViewSetEditable i2 False+    textViewSetEditable i3 False++    table <- textTagTableNew+    tagMono <- textTagNew $ Just "mono"+    tagRemove <- textTagNew $ Just "remove"+    tagAdd <- textTagNew $ Just "add"+    tagChange <- textTagNew $ Just "change"+    tagDull <- textTagNew $ Just "dull"+    tagMissing <- textTagNew $ Just "missing"+    tagLineNo <- textTagNew $ Just "lineno"+    tagSep <- textTagNew $ Just "sep"++    set tagMono [textTagFamily    := "monospace",+                 textTagWeight    := 400+                 ]+    set tagRemove [ textTagParagraphBackground  := "#f66"+                 ]+    set tagAdd   [ textTagParagraphBackground  := "#6f6"+                 ]+    set tagChange [ textTagParagraphBackground  := "#ff6"+                 ]+    set tagSep [ textTagParagraphBackground  := "#000",+                 textTagSize := 2500+                 ]+    set tagDull [ textTagForeground  := "#999"+                 ]+    set tagMissing [ textTagParagraphBackground  := "#eee" ]++    set tagLineNo [ textTagBackground  := "#fff",+                    textTagForeground := "#999"+                    ]++    textTagTableAdd table tagMono+    textTagTableAdd table tagRemove+    textTagTableAdd table tagAdd+    textTagTableAdd table tagChange+    textTagTableAdd table tagDull+    textTagTableAdd table tagMissing+    textTagTableAdd table tagLineNo+    textTagTableAdd table tagSep++    buf1 <- textBufferNew $ Just table+    buf2 <- textBufferNew $ Just table++    list <- listStoreNew diffs+    col <- treeViewColumnNew+    textRender <- cellRendererTextNew+    treeViewColumnPackStart col textRender True+    cellLayoutSetAttributes col textRender list $ \row -> [+        cellText := (let FileDiff fn _ _ = row in S.unpack fn)+        ]+    treeViewSetModel tv list+    treeViewAppendColumn tv col+    treeViewSetHeadersVisible tv False++    textViewSetBuffer i2 buf1+    textViewSetBuffer i3 buf2+    onCursorChanged tv $ processChange diffs scrollbox tv buf1 buf2++    set window [containerBorderWidth := 10,+                containerChild := outbox ]+    onDestroy window mainQuit+    onKeyPress window $ handleKeyPress (length diffs) tv scrollbox+    widgetShowAll window++    (w, _) <- widgetGetSize tv+    let size = min 250 w+    widgetSetSizeRequest tv size (-1)++    mainGUI++pageDown scroll = do+    pageMove scroll (+)++pageUp scroll = do+    pageMove scroll (-)++pageMove scroll op = do+    adj <- scrolledWindowGetVAdjustment scroll+    here <- adjustmentGetValue adj+    pageDown <- adjustmentGetPageIncrement adj+    pageSize <- adjustmentGetPageSize adj+    upperLimit <- adjustmentGetUpper adj+    let halfPage = pageDown / 2.0+    let proposed = here `op` halfPage+    let bounded = max 0 $ min (upperLimit - pageSize) proposed+    adjustmentSetValue adj bounded++nextFile = moveFile (+1)+prevFile = moveFile (subtract 1)++downFiles = moveFile (+10)+upFiles = moveFile (subtract 10)++moveFile op numItems tv = do+    (ix, _) <- treeViewGetCursor tv+    case ix of+        [] -> return ()+        (x:[]) -> do+                    let adj = max 0 $ min (numItems - 1) $ op x+                    treeViewSetCursor tv [adj] Nothing+        _      -> error "unexpected index!"++shrink = slide (flip subtract)+grow = slide (+)++slide op tv = do+    (w, _) <- widgetGetSize tv+    let size = max 0 $ w `op` 30+    widgetSetSizeRequest tv size (-1)++handleKeyPress numItems tv scroll (Key rel _ _ mods _ _ _ val name char) = do+    case name of+        "J" -> pageDown scroll+        "Page_Down" -> pageDown scroll+        "space" -> pageDown scroll++        "K" -> pageUp scroll+        "Page_Up" -> pageUp scroll++        "j" -> nextFile numItems tv+        "Down" -> nextFile numItems tv++        "k" -> prevFile numItems tv+        "Up" -> prevFile numItems tv++        "h" -> shrink tv+        "Left" -> shrink tv+        "l" -> grow tv+        "Right" -> grow tv++        "p" -> upFiles numItems tv+        "P" -> upFiles numItems tv+        "n" -> downFiles numItems tv+        "N" -> downFiles numItems tv++        "Escape" -> exitWith ExitSuccess+        o   -> (return ())+    return True+--            scrolledWindowSetVAdjustment scroll adj++processChange :: [FileDiff] -> ScrolledWindow -> TreeView -> TextBuffer -> TextBuffer -> IO ()+processChange diffs scroll tv buf1 buf2 = do+    (ix, _) <- treeViewGetCursor tv+    case ix of+        [] -> return ()+        (x:[]) -> do+                    let diff = diffs !! x+                    writeTextForDiff diff scroll buf1 buf2+        _      -> error "unexpected index!"++clearLastLine buf = do+    lines <- textBufferGetLineCount buf+    start <- textBufferGetIterAtLineOffset buf (lines - 2) 0+    end   <- textBufferGetEndIter buf+    textBufferDelete buf start end++writeTextForDiff :: FileDiff -> ScrolledWindow -> TextBuffer -> TextBuffer -> IO ()+writeTextForDiff (FileDiff fn dir secs) scroll buf1 buf2 = do+    textBufferSetText buf1 ""+    textBufferSetText buf2 ""+    adj <- scrolledWindowGetVAdjustment scroll+    adjustmentSetValue adj 0++    mapM_ (\(DiffSection lines)->(mapM_ writeLine $ lines) >> writeSep) secs++    clearLastLine buf1+    start1   <- textBufferGetStartIter buf1+    end1     <- textBufferGetEndIter buf1+    textBufferApplyTagByName buf1 "mono" start1 end1++    clearLastLine buf2+    start2   <- textBufferGetStartIter buf2+    end2     <- textBufferGetEndIter buf2+    textBufferApplyTagByName buf2 "mono" start2 end2++  where+    lineNum n = concat [replicate (5 - (length s)) ' ',  s, " "]+      where+        s = show n++    writeSep = do+        cur   <- textBufferGetEndIter buf1+        mark1 <- textBufferCreateMark buf1 Nothing cur True+        cur   <- textBufferGetEndIter buf2+        mark2 <- textBufferCreateMark buf2 Nothing cur True+        textBufferInsertByteStringAtCursor buf1 "\n"+        textBufferInsertByteStringAtCursor buf2 "\n"+        start1 <- textBufferGetIterAtMark buf1 mark1+        start2 <- textBufferGetIterAtMark buf2 mark2+        {-start1 <- textBufferGetStartIter buf1-}+        {-start2 <- textBufferGetStartIter buf2-}+        end1 <- textBufferGetEndIter buf1+        end2 <- textBufferGetEndIter buf2+        textBufferApplyTagByName buf1 "sep" start1 end1+        textBufferApplyTagByName buf2 "sep" start2 end2++    writeLine (DiffLine dir ml1 ml2) = do+        cur   <- textBufferGetEndIter buf1+        mark1 <- textBufferCreateMark buf1 Nothing cur True+        cur   <- textBufferGetEndIter buf2+        mark2 <- textBufferCreateMark buf2 Nothing cur True+        markMid1 <- case ml1 of+            Just (no, bs) -> do+                textBufferInsertAtCursor buf1 $ lineNum no+                cur  <- textBufferGetEndIter buf1+                mark <- textBufferCreateMark buf1 Nothing cur True+                textBufferInsertByteStringAtCursor buf1 bs+                return $ Just mark+            Nothing -> textBufferInsertByteStringAtCursor buf1 "\n" >> (return Nothing)+        markMid2 <- case ml2 of+            Just (no, bs) -> do+                textBufferInsertAtCursor buf2 $ lineNum no+                cur  <- textBufferGetEndIter buf2+                mark <- textBufferCreateMark buf2 Nothing cur True+                textBufferInsertByteStringAtCursor buf2 bs+                return $ Just mark+            Nothing -> textBufferInsertByteStringAtCursor buf2 "\n" >> (return Nothing)+        start1 <- textBufferGetIterAtMark buf1 mark1+        start2 <- textBufferGetIterAtMark buf2 mark2+        {-start1 <- textBufferGetStartIter buf1-}+        {-start2 <- textBufferGetStartIter buf2-}+        end1 <- textBufferGetEndIter buf1+        end2 <- textBufferGetEndIter buf2++        case dir of+            DirectionAdded -> do+                textBufferApplyTagByName buf1 "missing" start1 end1+                textBufferApplyTagByName buf2 "add" start2 end2+            DirectionRemoved -> do+                textBufferApplyTagByName buf1 "remove" start1 end1+                textBufferApplyTagByName buf2 "missing" start2 end2+            DirectionChanged -> do+                textBufferApplyTagByName buf1 "change" start1 end1+                textBufferApplyTagByName buf2 "change" start2 end2+            DirectionNone -> do+                textBufferApplyTagByName buf1 "dull" start1 end1+                textBufferApplyTagByName buf2 "dull" start2 end2++        case markMid1 of+            Just mark -> do+                i <- textBufferGetIterAtMark buf1 mark+                textBufferApplyTagByName buf1 "lineno" start1 i+            Nothing -> return ()+        case markMid2 of+            Just mark -> do+                i <- textBufferGetIterAtMark buf2 mark+                textBufferApplyTagByName buf2 "lineno" start2 i+            Nothing -> return ()