diff --git a/Zora.cabal b/Zora.cabal --- a/Zora.cabal +++ b/Zora.cabal @@ -1,7 +1,7 @@ Name: Zora -Version: 1.1.10 +Version: 1.1.10.2 Synopsis: Graphing library wrapper + assorted useful functions -Description: A library of assorted useful functions and data types and classes for working with lists, doing mathematical operations and graphing custom data types. +Description: A library of assorted useful functions for working with lists, doing mathematical operations and graphing custom data types. Category: Unclassified Cabal-Version: >= 1.6 License: BSD3 @@ -11,7 +11,6 @@ Maintainer: brettwines@gmail.com Homepage: http://github.com/bgwines/zora Build-Type: Simple -Extra-Source-Files: supporting-files/dot.hs Source-Repository head type: git location: git://github.com/bgwines/zora.git @@ -31,6 +30,5 @@ Exposed-Modules: Zora.List Zora.Math - Zora.Types Zora.Graphing.TreeGraphing Zora.Graphing.DAGGraphing diff --git a/Zora/Graphing/DAGGraphing.hs b/Zora/Graphing/DAGGraphing.hs --- a/Zora/Graphing/DAGGraphing.hs +++ b/Zora/Graphing/DAGGraphing.hs @@ -13,14 +13,13 @@ -- Stability : experimental -- Portability : portable -- --- A typeclass with default implementation for graphing trees with . It is intended to be extremely straightforward to graph your data type; you only need to define three very simple functions (example implementations below). +-- A typeclass with default implementation for graphing trees with . It is intended to be extremely straightforward to graph your data type; you only need to define one simple function (example implementation below). -- module Zora.Graphing.DAGGraphing ( DAGGraphable , graph , expand -, zoldMap ) where import Shelly @@ -28,8 +27,6 @@ import Control.Exception import System.IO.Error hiding (catch) -import System.IO.Unsafe - import Data.Maybe import Data.Tuple @@ -63,7 +60,7 @@ -- > expand (Node x l r) = Just (x, [("L child", l), ("R child", r)]) expand :: g -> Maybe (Maybe String, [(Maybe String, g)]) --- | Returns whether a node is empty. Sometimes, when declaringlgebraic data types, it is desirable to have an \"Empty\" show_node constructor. If your data type does not have an \"Empty\" show_node constructor, just always return @False@. +-- | Returns whether a node is empty. Sometimes, when declaring algebraic data types, it is desirable to have an \"Empty\" show_node constructor. If your data type does not have an \"Empty\" show_node constructor, just always return @False@. -- -- > is_empty Empty = True -- > is_empty _ = False @@ -94,12 +91,6 @@ then error "DAGGraphable implementation error. We shouldn't be calling this function for an empty node." else snd . fromJust . expand $ node --- | A default implementation of @zoldMap@ -- being instance of @DAGGraphable@ is enough to make your data type an instance of @Zoldable@ (in @Zora.Types@). You shouldn't need to override this implementation; just define --- --- > instance Zoldable Tree where --- > zoldMap :: (Monoid m) => (Tree a -> m) -> Tree a -> m --- > zoldMap = G.zoldMap --- zoldMap :: (Monoid m, DAGGraphable g) => (g -> m) -> g -> m zoldMap f node = if is_empty node diff --git a/Zora/Graphing/TreeGraphing.hs b/Zora/Graphing/TreeGraphing.hs --- a/Zora/Graphing/TreeGraphing.hs +++ b/Zora/Graphing/TreeGraphing.hs @@ -13,17 +13,16 @@ -- Stability : experimental -- Portability : portable -- --- [DEPRECATED; use @DAGGraphable@ instead] +-- [DEPRECATED; use @Zora.Graphing.DAGGraphing@ instead] -- A typeclass with default implementation for graphing trees with . It is intended to be extremely straightforward to graph your data type; you only need to define three very simple functions (example implementations below). -- -module Zora.Graphing.TreeGraphing +module Zora.Graphing.TreeGraphing {-# DEPRECATED "Use Zora.Graphing.DAGGraphing instead" #-} ( TreeGraphable , value , get_children , is_empty , graph -, zoldMap ) where import Shelly @@ -57,12 +56,6 @@ -- -- > data Tree a = Empty | Leaf a | Node a (Tree a) (Tree a) -- --- Being an instance of @TreeGraphable@ is enough to make your data type an instance of @Zoldable@; just define --- --- > instance Zoldable Tree where --- > zoldMap :: (Monoid m) => (Tree a -> m) -> Tree a -> m --- > zoldMap = G.zoldMap --- class TreeGraphable g where -- | Gets the value contained in a node. For example, -- @@ -84,122 +77,119 @@ -- > is_empty _ = False is_empty :: g a -> Bool - -- | A default implementation of @zoldMap@. This enough to make you an instance of @Zoldable@ (in @Zora.Types@). You shouldn't need to override this implementation. - zoldMap :: (Monoid m) => (g a -> m) -> g a -> m - zoldMap f node = - if is_empty node - then mempty - else (f node) `mappend` (mconcat . map (zoldMap f) . get_children $ node) +zoldMap :: (Monoid m, TreeGraphable g) => (g a -> m) -> g a -> m +zoldMap f node = + if is_empty node + then mempty + else (f node) `mappend` (mconcat . map (zoldMap f) . get_children $ node) - -- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You shouldn't need to override this implementation. - as_graph :: forall a. (Ord a, Show a) => g a -> ([LNode Ly.Text], [LEdge Ly.Text]) - as_graph g = (nodes, edges) - where - nodes :: [LNode Ly.Text] - nodes = zip [0..] $ map show' nodes_in_g +-- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You shouldn't need to override this implementation. +as_graph :: forall a g. (Ord a, Show a, TreeGraphable g) => g a -> ([LNode Ly.Text], [LEdge Ly.Text]) +as_graph g = (nodes, edges) + where + nodes :: [LNode Ly.Text] + nodes = zip [0..] $ map show' nodes_in_g - show' :: g a -> Ly.Text - show' = Ly.pack . show . value + show' :: g a -> Ly.Text + show' = Ly.pack . show . value - nodes_in_g :: [g a] - nodes_in_g = zoldMap (\a -> [a]) g + nodes_in_g :: [g a] + nodes_in_g = zoldMap (\a -> [a]) g - edges :: [LEdge Ly.Text] - edges = concatMap edgeify nodes_in_g + edges :: [LEdge Ly.Text] + edges = concatMap edgeify nodes_in_g - edgeify :: g a -> [LEdge Ly.Text] - edgeify node = - catMaybes . map maybe_edge . get_children $ node - where - maybe_edge :: g a -> Maybe (LEdge Ly.Text) - maybe_edge child = if is_empty child - then Nothing - else Just - ( m M.! (show' node) - , m M.! (show' child) - , Ly.empty ) + edgeify :: g a -> [LEdge Ly.Text] + edgeify node = + catMaybes . map maybe_edge . get_children $ node + where + maybe_edge :: g a -> Maybe (LEdge Ly.Text) + maybe_edge child = if is_empty child + then Nothing + else Just + ( m M.! (show' node) + , m M.! (show' child) + , Ly.empty ) - m :: M.Map Ly.Text Label - m = M.fromList $ map swap nodes + m :: M.Map Ly.Text Label + m = M.fromList $ map swap nodes - -- TODO: Multiple trees (e.g. binomial heaps / random access lists) - -- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You won't need to override this implementation. - as_dotfile :: forall a. (Show a, Ord a) => g a -> String - as_dotfile - = Ly.unpack - . printDotGraph - . graphToDot params - . mkGraph' - . as_graph - where - mkGraph' :: ([LNode Ly.Text], [LEdge Ly.Text]) -> (Gr Ly.Text Ly.Text) - mkGraph' (v, e) = mkGraph v e +-- | Returns a @String@ to be put into a @.dot@ file for the given @Graphable@ type. You won't need to override this implementation. +as_dotfile :: forall a g. (Show a, Ord a, TreeGraphable g) => g a -> String +as_dotfile + = Ly.unpack + . printDotGraph + . graphToDot params + . mkGraph' + . as_graph + where + mkGraph' :: ([LNode Ly.Text], [LEdge Ly.Text]) -> (Gr Ly.Text Ly.Text) + mkGraph' (v, e) = mkGraph v e - params :: GraphvizParams n Ly.Text Ly.Text () Ly.Text - params = nonClusteredParams { globalAttributes = ga - , fmtNode = fn - , fmtEdge = fe } - where - fn (_,l) = [textLabel l] - fe (_,_,l) = [textLabel l] + params :: GraphvizParams n Ly.Text Ly.Text () Ly.Text + params = nonClusteredParams { globalAttributes = ga + , fmtNode = fn + , fmtEdge = fe } + where + fn (_,l) = [textLabel l] + fe (_,_,l) = [textLabel l] - ga = [ GraphAttrs [ RankDir FromTop - , BgColor [toWColor White] ] - , NodeAttrs [ shape BoxShape - -- , FillColor (some_color 4) - -- , style filled - , Width 0.1 - , Height 0.1 ] ] + ga = [ GraphAttrs [ RankDir FromTop + , BgColor [toWColor White] ] + , NodeAttrs [ shape BoxShape + -- , FillColor (some_color 4) + -- , style filled + , Width 0.1 + , Height 0.1 ] ] - -- TODO : output is written to a file named \"graph-i.dot\", where /i/ is the successor of the highest /i/-value of all existing \"graph-i.dot\" files in the current directory. - -- | Graphs the given @TreeGraphable@ data type. Creates and writes to a file named \"graph.png\", overwriting any existing files with that name. You won't need to override this implementation. - graph :: (Show a, Ord a) => g a -> IO String - graph g = - let - outfile :: String - outfile = "graph-" ++ index ++ ".png" - where - index :: String - index - = show - . (+) 1 - . (\s -> read s :: Integer) - . takeWhile (/= '.') - . drop 6 -- (length "graph-") - . last - $ "graph--1" : graph_files_in_dir +-- | Graphs the given @TreeGraphable@ data type. Creates and writes to a file named \"graph.png\", overwriting any existing files with that name. You won't need to override this implementation. +graph :: (Show a, Ord a, TreeGraphable g) => g a -> IO String +graph g = + let + outfile :: String + outfile = "graph-" ++ index ++ ".png" + where + index :: String + index + = show + . (+) 1 + . (\s -> read s :: Integer) + . takeWhile (/= '.') + . drop 6 -- (length "graph-") + . last + $ "graph--1" : graph_files_in_dir - files_in_dir :: IO [String] - files_in_dir = getDirectoryContents "." :: IO [String] - - graph_files_in_dir :: [String] - graph_files_in_dir - = L.sort - . filter (starts_with "graph-") - . filter ((==) "graph.png") - . unsafePerformIO -- TODO: not this - $ files_in_dir + files_in_dir :: IO [String] + files_in_dir = getDirectoryContents "." :: IO [String] + + graph_files_in_dir :: [String] + graph_files_in_dir + = L.sort + . filter (starts_with "graph-") + . filter ((==) "graph.png") + . unsafePerformIO -- TODO: not this + $ files_in_dir - starts_with :: String -> String -> Bool - starts_with prefix str = take (length prefix) str == prefix + starts_with :: String -> String -> Bool + starts_with prefix str = take (length prefix) str == prefix - run_dot_cmd :: IO () - run_dot_cmd = shelly $ do - cmd "dot" "-Tpng" "graph.dot" "-ograph.png"--("-o" ++ outfile) -- Can't get this to compile. Not sure why yet. For now, we always write to the same file. + run_dot_cmd :: IO () + run_dot_cmd = shelly $ do + cmd "dot" "-Tpng" "graph.dot" "-ograph.png"--("-o" ++ outfile) -- Can't get this to compile. Not sure why yet. For now, we always write to the same file. - write_dot_file :: IO () - write_dot_file = do - writeFile "graph.dot" $ as_dotfile g + write_dot_file :: IO () + write_dot_file = do + writeFile "graph.dot" $ as_dotfile g - remove_dot_file :: IO () - remove_dot_file = removeFile "graph.dot" `catch` handleExists - where - handleExists e - | isDoesNotExistError e = return () - | otherwise = throwIO e - in - do - write_dot_file - run_dot_cmd - remove_dot_file - return ("Graphed data structure to " ++ "graph.png") -- outfile + remove_dot_file :: IO () + remove_dot_file = removeFile "graph.dot" `catch` handleExists + where + handleExists e + | isDoesNotExistError e = return () + | otherwise = throwIO e + in + do + write_dot_file + run_dot_cmd + remove_dot_file + return ("Graphed data structure to " ++ "graph.png") -- outfile diff --git a/Zora/Types.hs b/Zora/Types.hs deleted file mode 100644 --- a/Zora/Types.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | --- Module : Zora.Types --- Copyright : (c) Brett Wines 2014 --- --- License : BSD-style --- --- Maintainer : bgwines@cs.stanford.edu --- Stability : experimental --- Portability : portable --- --- Assorted types and typeclasses --- -module Zora.Types -( Zoldable -, zoldMap -) where - -import Data.Monoid - --- | `Zora.Zoldable` is much like `Data.Foldable`, but with a crucial difference: --- --- > foldMap :: (Foldable t, Monoid m) => ( a -> m) -> t a -> m --- > zoldMap :: (Zoldable t, Monoid m) => (t a -> m) -> t a -> m --- --- It is an augmented form -- @foldMap f t@ is @zoldMap (f . g) t@ where @g :: t a -> a@. With @foldMap@, you lose information that you have at the time of invocation of @f@: the @t a@; the context in which the @a@ is enclosed is discarded. Consider the following situation: you have some tree type, e.g. --- --- > data Tree a = Leaf a | Node a (Tree a) (Tree a) --- --- Suppose you want to get a list of all the nodes in the tree. This is just @zoldMap (\x -> [x]) tree@. -class Zoldable z where - zoldMap :: (Monoid m) => (z a -> m) -> z a -> m diff --git a/supporting-files/dot.hs b/supporting-files/dot.hs deleted file mode 100644 --- a/supporting-files/dot.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - -import Data.Graph.Inductive -import Data.GraphViz -import Data.GraphViz.Attributes.Complete -import Data.GraphViz.Types.Generalised as G -import Data.GraphViz.Types.Monadic -import Data.Text.Lazy as L -import Data.Word - -import System.IO - --- $ runhaskell dot.hs > graph.dot --- $ dot -Tpng graph.dot > graph.png' - -make_graph :: String -> Gr Text Text -make_graph str = mkGraph v e - where - (v, e) = graph . fromList $ str' - str' = read str :: [Integer] - -example_graph :: Gr Text Text -example_graph = mkGraph - [(1,"one"), (3,"three")] - [(1,3,"edge label")] - -params :: GraphvizParams n L.Text L.Text () L.Text -params = nonClusteredParams { globalAttributes = ga - , fmtNode = fn - , fmtEdge = fe - } - where - fn (_,l) = [textLabel l] - fe (_,_,l) = [textLabel l] - - ga = [ GraphAttrs [ RankDir FromTop - , BgColor [toWColor White] - ] - , NodeAttrs [ shape BoxShape - -- , FillColor (some_color 4) - -- , style filled - , Width 0.1 - , Height 0.1 - ] - ] - -some_color :: Word8 -> ColorList -some_color n | n == 1 = c $ (RGB 127 108 138) - | n == 2 = c $ (RGB 175 177 112) - | n == 3 = c $ (RGB 226 206 179) - | n == 4 = c $ (RGB 172 126 100) - where c rgb = toColorList [rgb] - -my_color :: Word8 -> Attribute -my_color = Color . some_color - -main :: IO () -main = do - str <- getLine - putStr . unpack . printDotGraph . graphToDot params . make_graph $ str - - -