darcs2dot (empty) → 0.1.0.0

raw patch · 4 files changed

+166/−0 lines, 4 filesdep +basedep +containersdep +darcssetup-changed

Dependencies added: base, containers, darcs, graph-wrapper, string-conversions

Files

LICENSE +30/−0
Setup.hs +2/−0
darcs2dot.cabal +35/−0
darcs2dot.hs +99/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2012, Sönke Hahn++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 Sönke Hahn 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

+ darcs2dot.cabal view

@@ -0,0 +1,35 @@+-- Initial darcs2dot.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                darcs2dot+version:             0.1.0.0+synopsis:            Outputs dependencies of darcs patches in dot format.+description:+    Outputs dependencies of darcs patches in dot format. Just run darcs2dot in a darcs repo and it will output (the transitive reduction of) the dependencies of the patches in dot format to stdout.+    .+    You can use the graphviz tools to generate graph files from that. For example:+    .+    @$ darcs2dot | dot -Tpdf -o darcsDeps.pdf@++license:             BSD3+license-file:        LICENSE+author:              Sönke Hahn+maintainer:          soenkehahn@gmail.com+-- copyright:           +category:            Development+build-type:          Simple+cabal-version:       >=1.8++source-repository head+    type:     darcs+    location: shahn@patch-tag.com:/r/shahn/darcs2dot++executable darcs2dot+  main-is: darcs2dot.hs+  build-depends:+    base ==4.5.*,+    darcs == 2.8.*,+    string-conversions == 0.2.*,+    containers == 0.4.*,+    graph-wrapper == 0.2.*+

+ darcs2dot.hs view

@@ -0,0 +1,99 @@+#!/usr/bin/env runhaskell++{-# language GADTs, TypeOperators, ViewPatterns, FlexibleContexts, ScopedTypeVariables #-}+++import Data.Graph.Wrapper+import Data.Map (Map, (!))+import qualified Data.Map as Map+import Data.String.Conversions++import Text.Printf++import Control.Applicative++import Darcs.Repository+import Darcs.Witnesses.Ordered+import Darcs.Patch.Named+import Darcs.Patch.Info+import Darcs.Patch.Choices+import Darcs.Patch.Patchy+++main = withRepository [] $ RepoJob $ \ repo ->+    putStr . toDot . dependencies . patchSetToPatches =<< readRepo repo+++dependencies :: Patchy (Named p) => FL (Named p) x y -> Graph Tag String+dependencies fl =+    let choices = patchChoices fl+        tags = getNamedTags choices+    in fromList $ flip map tags $ \ (name, tag) ->+        let firsts = getFirsts $ forceFirst tag choices+            depends = filter (\ (n, t) -> t /= tag) firsts+        in (tag, name, map snd depends) :: (Tag, String, [Tag])+++type NamedTag = (String, Tag)++getFirsts :: Patchy (Named p) => PatchChoices (Named p) x y -> [NamedTag]+getFirsts (getChoices -> (a :> _)) = getTagsFL a++getNamedTags :: Patchy (Named p) => PatchChoices (Named p) x y -> [NamedTag]+getNamedTags (getChoices -> (a :> (b :> c))) =+    getTagsFL a +++    getTagsFL b +++    getTagsFL c++getTagsFL :: FL (TaggedPatch (Named p)) x y -> [(String, Tag)]+getTagsFL NilFL = []+getTagsFL (a :>: b) = e : getTagsFL b+  where+    e = (cs . _piName . patch2patchinfo . tpPatch $ a, tag a)++-- not used+showChoices :: Patchy (Named p) => PatchChoices (Named p) x y -> String+showChoices choices =+    case getChoices choices of+        (a :> (b :> c)) -> showFL a ++ " :> (" ++ showFL b ++ " :> " ++ showFL c ++ ")"++-- not used+showFL :: FL (TaggedPatch (Named p)) x y -> String+showFL fl =+    case mapFL (cs . _piName . patch2patchinfo . tpPatch) fl of+         [] -> "[]"+         x -> unwords x+++-- * graph stuff++transitiveReduction :: Ord i => Graph i v -> Graph i v+transitiveReduction g =+    fromList $ map inner $ toList g+  where+    inner (i, v, outgoing) =+        (i, v, filter (\ o -> not $ hasIndirectPath i o) outgoing)+    hasIndirectPath a b = any (\ m -> a ~> m && m ~> b) (vertices g)+    a ~> b = b `elem` successors g a+++-- * dot++toDot :: (Ord i) => Graph i String -> String+toDot graph =+    "digraph g {\n" +++        (concatMap inner $ toList $ fmap (take 15) $ transitiveReduction $ indexToInt graph) +++    "}\n"+  where+    inner (i, name, outgoing) =+        printf "    %i [label = \"%s\"];\n" i name +++        concatMap (\ out -> printf "    %i -> %i;\n" i out) outgoing++-- | convert indices to Ints+indexToInt :: forall i v . Ord i => Graph i v -> Graph Int v+indexToInt g =+    fromList $ map inner $ toList g+  where+    inner (i, v, outgoing) = (intMap ! i, v, map (intMap !) outgoing)+    intMap :: Map i Int+    intMap = Map.fromList $ zip (vertices g) [0..]