prolog-graph-lib (empty) → 0.1

raw patch · 4 files changed

+120/−0 lines, 4 filesdep +basedep +fgldep +graphvizsetup-changed

Dependencies added: base, fgl, graphviz, mtl, prolog, text

Files

• GraphViz.hs +90/−0
• Language/Prolog/GraphViz.hs +2/−0
• Setup.hs +2/−0
• prolog-graph-lib.cabal +26/−0

@@ -0,0 +1,90 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module GraphViz where++import Control.Applicative ((<$>), Applicative(..))+import Control.Monad+import Control.Monad.State+import Control.Monad.Error+import Data.List (intercalate, intersperse)++import qualified Data.Graph.Inductive as Graph+import Data.HashTable (hashString)++import Data.GraphViz (preview, runGraphviz, setDirectedness, graphToDot, GraphvizOutput(Png), toLabel, nonClusteredParams, GraphvizParams(..))+import Data.GraphViz.Attributes.Colors (Color(X11Color), X11Color(..))+import Data.GraphViz.Attributes.HTML++import qualified Data.Text.Lazy++import Language.Prolog++htmlStr = HtmlStr . Data.Text.Lazy.pack+++-- Graphical output of derivation tree+resolveTree p q = preview =<< execGraphGenT (resolve_ p q)++resolveTreeToFile path p q = do+ graph <- execGraphGenT (resolve_ p q)+ runGraphviz (setDirectedness graphToDot params graph) Png path+   where+    params = nonClusteredParams { fmtNode = \ (_,l) -> [toLabel l]+                                , fmtEdge = \ (_, _, l) -> [toLabel l]+                                }+++type Graph = Graph.Gr HtmlText HtmlText++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 Graph.empty+execGraphGenT (GraphGenT st) = execStateT st Graph.empty+++instance Monad m => MonadGraphGen (GraphGenT m) where++   createConnections usf gs branches = do+      let current = hash (usf, gs)+      let label = makeNodeLabel usf gs+      ensureNode current label+      forM_ branches $ \x@(u',gs') -> do+         connect current u' gs'+      when (null branches) $ do+         modifyLabel current (colorize Red)++   markSolution usf = do+      let current = hash (usf,[])+      modifyLabel current (colorize Green)++   markCutBranches stackPrefix = do+      forM_ stackPrefix $ \(u_,gs_,alts_) -> do+         forM_ alts_ $ \x -> do+            let child = hash x+            modifyLabel child (colorize Gray)+++ensureNode node label =+   modify $ \graph ->+      if Graph.gelem node graph+         then graph+         else Graph.insNode (node, label) graph++makeNodeLabel _ [] = [htmlStr "[]"]+makeNodeLabel _ gs = [htmlStr $ intercalate "," $ map show gs]++makeEdgeLabel [] _ = [HtmlFont [HtmlPointSize 8] [htmlStr "{}"]]+makeEdgeLabel u  _ = [HtmlFont [HtmlPointSize 8] $ intersperse (HtmlNewline []) [htmlStr $ show v ++ " = " ++ show t | (v,t) <- u]]++modifyLabel node f = do+   modify $ Graph.gmap $ \cxt@(in_,node',label,out) ->+      if node == node'+         then (in_, node', f label, out)+         else cxt++colorize color label = [HtmlFont [HtmlColor (X11Color color)] label]++connect current u gs = do+   let new = hash (u, gs)+   modify $ Graph.insNode (new, makeNodeLabel u gs)+   modify $ Graph.insEdge (current, new, makeEdgeLabel u gs)++hash = fromEnum . hashString . show

@@ -0,0 +1,2 @@+module Language.Prolog.GraphViz (module GraphViz) where+import GraphViz

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+Name:                prolog-graph-lib+Version:             0.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:          bartsch@cs.uni-bonn.de+Homepage:            https://github.com/Erdwolf/prolog+Category:            Language+Build-type:          Simple+Cabal-version:       >=1.6++Source-repository head+   type: git+   location: git://github.com/Erdwolf/prolog.git++Library+  Exposed-Modules: Language.Prolog.GraphViz+  Other-Modules: GraphViz+  Build-depends:+    prolog == 0.1.*,+    base >=4 && <5,+    fgl >= 5.4.2.4,+    mtl >= 2.0.1.0,+    text >= 0.11.1.5,+    graphviz >= 2999.12.0.3