prolog-graph-lib 0.2.0.1 → 0.2.1
raw patch · 2 files changed
+34/−26 lines, 2 filesnew-uploader
Files
- GraphViz.hs +28/−23
- prolog-graph-lib.cabal +6/−3
GraphViz.hs view
@@ -1,26 +1,28 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, FlexibleContexts #-} module GraphViz where -import Control.Applicative ((<$>), Applicative(..))+import Control.Applicative ((<$>), Applicative(..), Alternative(..)) import Control.Monad import Control.Monad.State import Control.Monad.Error import Control.Concurrent (forkIO) import Data.List (intercalate, intersperse, nub)+import Data.Char (ord) import qualified Data.Graph.Inductive as Graph-import Data.HashTable (hashString)+-- import Data.HashTable (hashString) import Data.GraphViz (runGraphvizCommand, runGraphvizCanvas', GraphvizCanvas(Xlib), graphElemsToDot, GraphvizOutput(..), toLabel, nonClusteredParams, GraphvizParams(..), GlobalAttributes(GraphAttrs), GraphvizCommand(Dot))-import Data.GraphViz.Attributes.Colors (Color(X11Color), X11Color(..))+import Data.GraphViz.Attributes.Colors (Color(X11Color), WeightedColor(..))+import Data.GraphViz.Attributes.Colors.X11 (X11Color(..)) import Data.GraphViz.Attributes.HTML-import Data.GraphViz.Attributes.Complete (Attribute(Ordering,Label,Shape,Color,Width,Regular), Shape(BoxShape), Label(HtmlLabel), HtmlLabel(HtmlText))+import Data.GraphViz.Attributes.Complete (Attribute(Ordering,Label,Shape,Color,Width,Regular), Shape(BoxShape), Label(HtmlLabel), Order(OutEdges)) import qualified Data.Text.Lazy import Language.Prolog -htmlStr = HtmlStr . Data.Text.Lazy.pack+htmlStr = Str . Data.Text.Lazy.pack -- Graphical output of derivation tree resolveTree p q = preview =<< execGraphGenT (resolve_ p q)@@ -37,7 +39,7 @@ where params = nonClusteredParams { fmtNode = \ (_,l) -> formatNode l , fmtEdge = \ (_, _, l) -> formatEdge l- , globalAttributes = [GraphAttrs (Ordering "out" : attrs)] -- child nodes are drawn in edge-order+ , globalAttributes = [GraphAttrs (Ordering OutEdges : attrs)] -- child nodes are drawn in edge-order , isDirected = True } @@ -60,9 +62,9 @@ labEdges (Gr _ es) = es -newtype GraphGenT m a = GraphGenT (StateT Graph m a) deriving (Monad, Functor, MonadFix, MonadPlus, Applicative, MonadError e, MonadState Graph, MonadTrans)-runGraphGenT (GraphGenT st) = runStateT st empty-execGraphGenT (GraphGenT st) = execStateT st empty+newtype GraphGenT m a = GraphGenT (StateT Graph m a) deriving (Monad, Functor, MonadFix, MonadPlus, Applicative, MonadError e, MonadState Graph, MonadTrans, Alternative)+runGraphGenT (GraphGenT st) = runStateT st GraphViz.empty+execGraphGenT (GraphGenT st) = execStateT st GraphViz.empty instance Monad m => MonadGraphGen (GraphGenT m) where@@ -95,21 +97,21 @@ -formatNode :: NodeLabel -> [Attribute]+formatNode :: NodeLabel -> [Data.GraphViz.Attributes.Complete.Attribute] formatNode ((_,(_,u',[])), _, WasNotCut) = -- Success Shape BoxShape : case filterOriginal u' of [] -> [ toLabel ("" :: String)- , Width 0.2+ , Data.GraphViz.Attributes.Complete.Width 0.2 , Regular True- , Color [X11Color Green]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Green) Nothing)] ] uf -> [ toLabel $ colorize Green $ htmlUnifier uf- , Color [X11Color Green]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Green) Nothing)] ] formatNode ((_,(_,_,gs')), [], WasNotCut) = -- Failure [ toLabel $ colorize Red [htmlGoals gs'] - , Color [X11Color Red]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Red) Nothing)] ] formatNode ((_,(_,_,gs')), _, WasNotCut) = [ toLabel [htmlGoals gs'] ]@@ -117,34 +119,34 @@ Shape BoxShape : case filterOriginal u' of [] -> [ toLabel ("" :: String)- , Width 0.2+ , Data.GraphViz.Attributes.Complete.Width 0.2 , Regular True- , Color [X11Color Gray]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Gray) Nothing)] ] uf -> [ toLabel $ colorize Gray $ htmlUnifier uf- , Color [X11Color Gray]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Gray) Nothing)] ] formatNode ((_,(_,_,gs')), _, WasCut) = -- Cut [ toLabel $ colorize Gray [htmlGoals gs']- , Color [X11Color Gray]+ , Data.GraphViz.Attributes.Complete.Color [(WC (X11Color Gray) Nothing)] ] -formatEdge :: EdgeLabel -> [Attribute]+formatEdge :: EdgeLabel -> [Data.GraphViz.Attributes.Complete.Attribute] formatEdge ((_,u ,_),_) =- [ toLabel [HtmlFont [HtmlPointSize 8] $ htmlUnifier $ simplify u] ]+ [ toLabel [Font [PointSize 8] $ htmlUnifier $ simplify u] ] simplify = ([] +++) htmlGoals = htmlStr . intercalate "," . map show htmlUnifier [] = [htmlStr " "]-htmlUnifier u = intersperse (HtmlNewline []) [ htmlStr $ show v ++ " = " ++ show t | (v,t) <- u ]+htmlUnifier u = intersperse (Newline []) [ htmlStr $ show v ++ " = " ++ show t | (v,t) <- u ] modifyLabel node f = modify $ relabelNode f node -colorize color label = [HtmlFont [HtmlColor (X11Color color)] label]+colorize color label = [Font [Data.GraphViz.Attributes.HTML.Color (X11Color color)] label] hash :: Path -> Int -- TODO This is a complicated way to hash a list of integers.@@ -152,3 +154,6 @@ hash = fromEnum . hashString . show filterOriginal = filter $ \(VariableName n _, _) -> n == 0++hashString = fromIntegral . foldr f 0+ where f c m = ord c + (m * 128) `rem` 1500007
prolog-graph-lib.cabal view
@@ -1,11 +1,10 @@ Name: prolog-graph-lib-Version: 0.2.0.1+Version: 0.2.1 Synopsis: Generating images of resolution trees for Prolog queries. Description: This is the library part (See <http://hackage.haskell.org/package/prolog-graph> for the command line tool). License: PublicDomain Author: Matthias Bartsch-Maintainer: none-Homepage: https://github.com/Erdwolf/prolog+Maintainer: Marcel Fourné (haskell@marcelfourne.de) Category: Language Build-type: Simple Cabal-version: >=1.6@@ -20,3 +19,7 @@ mtl >= 2.0.1.0, text >= 0.11.1.5, graphviz >= 2999.12.0.3++source-repository head+ type: git+ location: https://github.com/mfourne/prolog-graph-lib