Zora 1.1.23 → 1.2.0

raw patch · 3 files changed

+8/−203 lines, 3 filesdep +tastydep +tasty-hunitPVP ok

version bump matches the API change (PVP)

Dependencies added: tasty, tasty-hunit

API changes (from Hackage documentation)

Files

• Tests/test-zora.hs +4/−4
• Zora.cabal +4/−4
• Zora/Graphing/TreeGraphing.hs +0/−195

@@ -9,13 +9,13 @@  import qualified Zora.List as ZL -testTakeWhileAndLast :: Assertion-testTakeWhileAndLast = do-    1 @?= 2+testTakeWhileKeepLast :: Assertion+testTakeWhileKeepLast = do+    ZL.take_while_keep_last (< 3) [1..] @?= [1,2,3]  tests :: TestTree tests = testGroup "unit tests"-    [ testCase "Testing `testTakeWhileAndLast`" testTakeWhileAndLast ]+    [ testCase "Testing `take_while_keep_last`" testTakeWhileKeepLast ]  main :: IO () main = defaultMain tests

@@ -1,5 +1,5 @@ Name:		   Zora-Version:	   1.1.23+Version:	   1.2.0 Synopsis:      Graphing library wrapper + assorted useful functions  Description:   A library of assorted useful functions for working with lists, doing mathematical operations and graphing custom data types. Category:      Unclassified@@ -25,16 +25,16 @@     graphviz,     fgl,     shelly >= 1.5.4.1,-    directory+    directory,+    random    Exposed-Modules:     Zora.List     Zora.Math-    Zora.Graphing.TreeGraphing     Zora.Graphing.DAGGraphing  Test-Suite test-zora     type:       exitcode-stdio-1.0     main-is:    Tests/test-zora.hs-    build-depends: base >= 4 && < 5, Zora+    build-depends: base >= 4 && < 5, Zora, tasty-hunit, tasty, containers, random     default-language:    Haskell2010

@@ -1,195 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ExtendedDefaultRules #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}---- |--- Module      : Zora.Graphing.TreeGraphing--- Copyright   : (c) Brett Wines 2014------ License	   : BSD-style------ Maintainer  : bgwines@cs.stanford.edu--- Stability   : experimental--- Portability : portable--- --- [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 {-# DEPRECATED "Use Zora.Graphing.DAGGraphing instead" #-}-( TreeGraphable-, value-, get_children-, is_empty-, graph-) where--import Shelly-import System.Directory (removeFile, getDirectoryContents)-import Control.Exception-import System.IO.Error hiding (catch)--import System.IO.Unsafe--import Data.Maybe-import Data.Tuple--import Data.Monoid--import qualified Data.Map as M-import qualified Data.List as L hiding (zip, map, length, take, drop, takeWhile, last, filter, concatMap)-import qualified Data.Text.Lazy as Ly-import qualified Data.ByteString.Char8 as ByteString----  hiding (Graph, Edge, Node)-import Data.Graph.Inductive-import Data.GraphViz-import Data.GraphViz.Attributes.Complete hiding (value, Label)-import Data.Word--type Label = Int---- | A typeclass for algebraic data types that are able to be graphed.------ For these descriptions, assume the following example data type:--- --- > data Tree a = Empty | Leaf a | Node a (Tree a) (Tree a)--- -class TreeGraphable g where-	-- | Gets the value contained in a node. For example,-	-- -	-- > value (Empty) = error "Empty nodes don't contain values."-	-- > value (Leaf x) = x-	-- > value (Node x _ _) = x-	value :: g a -> a-	-	-- | Gets the children of the current node. For example,-	-- -	-- > get_children (Empty) = error "Empty nodes don't have children."-	-- > get_children (Leaf _) = []-	-- > get_children (Node _ l r) = [l, r]-	get_children :: g a -> [g a]--	-- | Returns whether a node is empty. Sometimes, when declaring algebraic data types, it is desirable to have an \"Empty\" value constructor. If your data type does not have an \"Empty\" value constructor, just always return @False@.-	-- -	-- > is_empty Empty = True-	-- > is_empty _ = False-	is_empty :: g a -> Bool--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 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--		nodes_in_g :: [g a]-		nodes_in_g = zoldMap (\a -> [a]) 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 )--				m :: M.Map Ly.Text Label-				m = M.fromList $ map swap nodes---- | 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]--				ga = [ GraphAttrs [ RankDir	 FromTop-								  , BgColor	 [toWColor White] ]-					 , NodeAttrs	[ shape	 BoxShape-									-- , FillColor (some_color 4)-									-- , style	 filled-									, Width	 0.1-									, Height	0.1 ] ]---- | 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--				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.--		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