haphviz 0.1.1.5 → 0.1.2.0

raw patch · 3 files changed

+78/−44 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• haphviz.cabal +3/−2
• src/Text/Dot/Class.hs +23/−0
• src/Text/Dot/FSA.hs +52/−42

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                haphviz-version:             0.1.1.5+version:             0.1.2.0 synopsis:            Graphviz code generation with Haskell description:   There are multiple ways to describe this package:@@ -30,8 +30,9 @@  library   exposed-modules:     Text.Dot-                       Text.Dot.Gen+                       Text.Dot.Class                        Text.Dot.FSA+                       Text.Dot.Gen                        Text.Dot.Render                        Text.Dot.Attributes                        Text.Dot.Attributes.Arrows

@@ -0,0 +1,23 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+module Text.Dot.Class where++import           Text.Dot.Gen++import           Control.Monad (void)++import qualified Data.Text     as T++-- | A class of datatypes representable as a graph with a given config.+class Graph g c | c -> g, g -> c where+    -- | The default config for rendering a @g@.+    defaultGenConfig :: c++    -- | Draw @g@ using @c@ to configure its rendering.+    genGraph :: c -> g -> DotGen ()+++-- | Render a @g@ using the default render config+genDefault :: Graph g c => g -> DotGen ()+genDefault = genGraph defaultGenConfig+

@@ -1,15 +1,17 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-} -- | Easy FSA visualisation module Text.Dot.FSA where  import           Text.Dot+import           Text.Dot.Class -import           Control.Monad (forM, forM_, when)-import           Data.Maybe    (fromMaybe, isNothing)+import           Control.Monad  (forM, forM_, when)+import           Data.Maybe     (fromMaybe, isNothing)  import           Data.Text-import qualified Data.Text     as T-import qualified Data.Text.IO  as T+import qualified Data.Text      as T+import qualified Data.Text.IO   as T  -- | An easy way to generate an FSA visualization --@@ -35,47 +37,55 @@ -- >     1 -> 1 [label=<q>]; -- >     1 -> 2 [label=<p>]; -- > }-------fsaGraph :: [Text] -- ^ Set of states-          -> Text -- ^ Initial state-          -> [Text] -- ^ Accepting states-          -> [(Text, Text, Text)] -- ^ Edges: From, To, Symbol-          -> DotGraph-fsaGraph states initial accepting edges = graph_ directed $ do-    nodeDec [width =: "0", height =: "0"] -- Nodes as small as possible-    rankdir leftRight -    stateNodes <- forM states $ \s -> do-        n <- newNode-        genNode n $-            if s `elem` accepting-                then [label =: s, shape =: "doublecircle"]-                else [label =: s]-        return (s, n)+data FSA = FSA {+      fsaStates    :: [Text] -- ^ Set of states+    , fsaInitial   :: Text -- ^ Initial state+    , fsaAccepting :: [Text] -- ^ Accepting states+    , fsaEdges     :: [(Text, Text, Text)] -- ^ Edges: From, To, Symbol+    } deriving (Show, Eq) -    -- Check that accepting states are actually states-    forM_ accepting $ \s -> do-        when-            (isNothing $ lookup s stateNodes)-            (error $ "Accepting state is not in the set of states: " ++ T.unpack s)+data FSARenderConfig = FSARenderConfig -    -- Draw an edge from an invisible state to the initial state-    case lookup initial stateNodes of-        Nothing -> error "Initial state is not in the set of states"-        Just initialNode -> do+instance Graph FSA FSARenderConfig where+    defaultGenConfig = FSARenderConfig+    genGraph _ (FSA states initial accepting edges) = do+        nodeDec [width =: "0", height =: "0"] -- Nodes as small as possible+        rankdir leftRight++        stateNodes <- forM states $ \s -> do             n <- newNode-            genNode n ["style" =: "invis"]-            n --> initialNode+            genNode n $+                if s `elem` accepting+                    then [label =: s, shape =: "doublecircle"]+                    else [label =: s]+            return (s, n) -    -- Draw the edges-    forM_ edges $ \(from, to, symbol) -> do-        let fromNode = fromMaybe-                    (error $ "From node not found: " ++ T.unpack from)-                    (lookup from stateNodes)-        let toNode = fromMaybe-                    (error $ "To node not found: " ++ T.unpack to)-                    (lookup to stateNodes)-        genEdge fromNode toNode [label =: symbol]+        -- Check that accepting states are actually states+        forM_ accepting $ \s -> do+            when+                (isNothing $ lookup s stateNodes)+                (error $ "Accepting state is not in the set of states: " ++ T.unpack s) +        -- Draw an edge from an invisible state to the initial state+        case lookup initial stateNodes of+            Nothing -> error "Initial state is not in the set of states"+            Just initialNode -> do+                n <- newNode+                genNode n ["style" =: "invis"]+                n --> initialNode +        -- Draw the edges+        forM_ edges $ \(from, to, symbol) -> do+            let fromNode = fromMaybe+                        (error $ "From node not found: " ++ T.unpack from)+                        (lookup from stateNodes)+            let toNode = fromMaybe+                        (error $ "To node not found: " ++ T.unpack to)+                        (lookup to stateNodes)+            genEdge fromNode toNode [label =: symbol]++++fsaGraph :: FSA -> DotGraph+fsaGraph g = graph_ directed $ genGraph FSARenderConfig g