graphex diff (#56)

* rank-diff init

* tabs

* floodMap seems to work. Starting optimized floodCount now

* rank --edges

* fmt

* diff might be done? lazy record was nice

* keep

* cleanup and set up diff-only pr

* diff html

* sort by abs Down

* diff2text

* add hable to extra-deps for CI

* cleaning up

app/Main.hs

@@ -1,31 +1,27 @@
 {-# LANGUAGE ApplicativeDo #-}
 module Main where
 
-import           Control.Applicative  ((<|>))
-import           Data.Aeson           (encode)
-import           Data.Bool            (bool)
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Csv             as CSV
+import           Data.Aeson               (encode)
+import           Data.Bool                (bool)
+import qualified Data.ByteString.Lazy     as BL
+import qualified Data.Csv                 as CSV
 import           Data.Foldable
-import           Data.List.NonEmpty   (NonEmpty (..))
-import qualified Data.List.NonEmpty   as NE
-import           Data.Maybe           (fromMaybe)
-import           Data.Text            (Text)
-import qualified Data.Text            as T
-import qualified Data.Text.IO         as TIO
-import           Data.Tree.View       (drawTree)
-import           Options.Applicative  (Parser, argument, command,
-                                       customExecParser, fullDesc, help, helper,
-                                       hsubparser, info, long, metavar, prefs,
-                                       progDesc, short, showDefault,
-                                       showHelpOnError, some, str, strOption,
-                                       switch, value, (<**>))
-import           System.IO            (stdin)
+import           Data.List.NonEmpty       (NonEmpty (..))
+import qualified Data.List.NonEmpty       as NE
+import           Data.Maybe               (fromMaybe)
+import           Data.Text                (Text)
+import qualified Data.Text                as T
+import qualified Data.Text.IO             as TIO
+import           Data.Tree.View           (drawTree)
+import           Options.Applicative
+import           System.IO                (stdin)
+import           Text.Blaze.Renderer.Utf8 (renderMarkup)
 import           Text.Regex.TDFA
 
 import           Graphex
 import           Graphex.Core
 import qualified Graphex.CSV
+import           Graphex.Diff
 import           Main.Cabal
 
 data Command
@@ -42,7 +38,7 @@ data Command
     deriving stock Show
 
 
-data Options = GraphCmd GraphOptions | CabalCmd CabalOptions
+data Options = GraphCmd GraphOptions | CabalCmd CabalOptions | DiffCmd DiffOptions
   deriving stock Show
 
 data GraphOptions = GraphOptions {
@@ -55,6 +51,7 @@ options :: Parser Options
 options = hsubparser $ fold
   [ command "graph" (info (GraphCmd <$> graphOptions) (progDesc "Graph operations"))
   , command "cabal" (info (CabalCmd <$> cabalOptions) (progDesc "Cabal operations"))
+  , command "diff" (info (DiffCmd <$> diffOptions) (progDesc "Diff operations"))
   ]
 
 graphOptions :: Parser GraphOptions
@@ -85,6 +82,34 @@ graphOptions = GraphOptions
         removeCmd = Remove <$> switch (short 'r' <> help "Use regex") <*> some1 (argument str (metavar "module"))
         some1 = fmap NE.fromList . some
 
+data DiffType =
+    DiffRanks
+  | DiffReverseRanks
+  deriving stock (Show)
+data DiffOptions = DiffOptions
+  { graph1 :: FilePath
+  , graph2 :: FilePath
+  , format :: DiffFormat
+  }
+  deriving stock (Show)
+
+data DiffFormat =
+    DiffText
+  | DiffHtml
+  deriving stock (Show)
+
+readDiffFormat :: ReadM DiffFormat
+readDiffFormat = eitherReader $ \case
+  "text" -> Right DiffText
+  "html" -> Right DiffHtml
+  x -> Left $ "Unrecognized diff format: " ++ x
+
+diffOptions :: Parser DiffOptions
+diffOptions = DiffOptions
+  <$> argument str (metavar "GRAPH")
+  <*> argument str (metavar "GRAPH")
+  <*> option readDiffFormat (long "format" <> short 'f')
+
 printStrs :: Foldable f => f Text -> IO ()
 printStrs = traverse_ TIO.putStrLn
 
@@ -125,5 +150,13 @@ main = customExecParser (prefs showHelpOnError) opts >>= \case
                    | otherwise -> (`elem` patterns)
           BL.putStr $ encode $ graphToDep $ filterNodes shouldRemove graph
   CabalCmd cabalOpts -> runCabal cabalOpts
+  DiffCmd DiffOptions{..} -> do
+    g1 <- getInput graph1
+    g2 <- getInput graph2
+    let Diff{..} = diff g1 g2
+    case format of
+      DiffHtml -> BL.putStr $ renderMarkup $ diff2html Diff{..}
+      DiffText -> do
+        TIO.putStrLn $ diff2text Diff{..}
   where
     opts = info (options <**> helper) ( fullDesc <> progDesc "Graph CLI tool.")

package.yaml

@@ -40,11 +40,15 @@ dependencies:
 - these
 - regex-tdfa
 - stm
+- blaze-markup
+- blaze-html
+- hable
 
 library:
   source-dirs: src
   ghc-options:
     - -Wall
+    - -Werror=incomplete-patterns
 
 default-extensions:
   - OverloadedStrings
@@ -53,6 +57,7 @@ default-extensions:
   - DerivingStrategies
   - DeriveAnyClass
   - DeriveGeneric
+  - DeriveFoldable
   - GeneralizedNewtypeDeriving
   - ViewPatterns
   - TupleSections
@@ -76,6 +81,7 @@ executables:
       - -rtsopts
       - -with-rtsopts=-N
       - -Wall
+      - -Werror=incomplete-patterns
     dependencies:
     - graphex
 
@@ -87,6 +93,8 @@ tests:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
+    - -Wall
+    - -Werror=incomplete-patterns
     dependencies:
     - graphex
     - HUnit

src/Graphex/Diff.hs

@@ -0,0 +1,89 @@
+module Graphex.Diff where
+
+import           Control.Arrow               (second)
+import           Control.Parallel.Strategies (NFData)
+import           Data.List                   (sortOn)
+import           Data.Map                    (Map)
+import qualified Data.Map                    as Map
+import           Data.Monoid                 (Sum (..))
+import           Data.Ord                    (Down (..))
+import           Data.Semialign
+import           Data.Text                   (Text)
+import qualified Data.Text                   as T
+import           Data.Tuple                  (swap)
+import           Hable
+import           Prelude                     hiding (div)
+import           Text.Blaze.Html5
+
+import           Graphex
+
+data Diff a = Diff
+  { netNodes         :: Int
+  , nodes            :: Map a Int
+
+  , netReversedNodes :: Int
+  , reversedNodes    :: Map a Int
+  } deriving stock (Show)
+
+diff :: NFData a => Ord a => Graph a -> Graph a -> Diff a
+diff g1 g2 = Diff{..}
+  where
+    g1rev = reverseEdges g1
+    g2rev = reverseEdges g2
+
+    r1 = rankings g1
+    r2 = rankings g2
+
+    r1rev = rankings g1rev
+    r2rev = rankings g2rev
+
+    doDiff x y =
+      let x' = Map.fromList $ fmap (second (Sum . negate) . swap) x
+          y' = Map.fromList $ fmap (second Sum . swap) y
+      in Map.filter (/= 0) $ Map.map getSum $ salign x' y'
+
+    nodes = doDiff r1 r2
+    netNodes = sum nodes
+
+    reversedNodes = doDiff r1rev r2rev
+    netReversedNodes = sum reversedNodes
+
+diffFoldFor :: Ord a => Monoid b => (Diff a -> Map a Int) -> Diff a -> ((a, Int) -> b) -> b
+diffFoldFor getter d = flip foldMap (sortOn (Down . abs . snd) $ Map.toList $ getter d)
+
+diff2html :: Diff Text -> Html
+diff2html d = mconcat
+  [ div $ mconcat
+    [ "Net change in transitive import dependencies: ", toHtml (netNodes d)
+    , details $ table $ mconcat
+      [ tr $ mconcat
+        [ th "Module", th "Change" ]
+      , diffFoldFor nodes d $ \(m, net) ->
+          tr $ mconcat
+          [ td $ toHtml m, td $ toHtml net ]
+      ]
+    ]
+  , div $ mconcat
+    [ "Net change in reverse transitive import dependencies: ", toHtml (netReversedNodes d)
+    , details $ table $ mconcat
+      [ tr $ mconcat
+        [ th "Module", th "Change" ]
+      , diffFoldFor reversedNodes d $ \(m, net) ->
+          tr $ mconcat
+          [ td $ toHtml m, td $ toHtml net ]
+      ]
+    ]
+  ]
+
+diff2text :: Diff Text -> Text
+diff2text d = T.pack $ unlines
+  [ unwords ["Net change in transitive import dependencies:", show (netNodes d)]
+  , hable defaultConfig $ (diffHeader :) $ diffFoldFor nodes d $ \(m, net) ->
+      [[T.unpack m, show net]]
+  , unwords ["Net change in reverse transitive import dependencies:", show (netReversedNodes d)]
+  , hable defaultConfig $ (diffHeader :) $ diffFoldFor reversedNodes d $ \(m, net) ->
+      [[T.unpack m, show net]]
+  ]
+
+diffHeader :: [String]
+diffHeader = ["Module", "Change"]

stack.yaml

@@ -66,3 +66,6 @@ extra-deps: []
 # compiler-check: newer-minor
 nix:
   packages: [zlib]
+
+extra-deps:
+- hable-0.3.1

test/CabalSpec.hs

@@ -26,6 +26,7 @@ libModules =
   , Module "Graphex.Search" "src/Graphex/Search.hs"
   , Module "Graphex.Logger" "src/Graphex/Logger.hs"
   , Module "Graphex.Queue" "src/Graphex/Queue.hs"
+  , Module "Graphex.Diff" "src/Graphex/Diff.hs"
   ]
 
 searchModuleGraph :: ModuleGraph