Zora 1.1.10 → 1.1.10.2

raw patch · 5 files changed

+107/−224 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Zora.cabal +2/−4
• Zora/Graphing/DAGGraphing.hs +2/−11
• Zora/Graphing/TreeGraphing.hs +103/−113
• Zora/Types.hs +0/−31
• supporting-files/dot.hs +0/−65

@@ -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

@@ -13,14 +13,13 @@ -- Stability   : experimental -- Portability : portable -- --- A typeclass with default implementation for graphing trees with <https://hackage.haskell.org/package/graphviz Haskell GraphViz>. 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 <https://hackage.haskell.org/package/graphviz Haskell GraphViz>. 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

@@ -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 <https://hackage.haskell.org/package/graphviz Haskell GraphViz>. 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

@@ -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

@@ -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---