mmsyn4 0.5.0.0 → 0.6.0.0
raw patch · 3 files changed
+104/−86 lines, 3 filesdep +mmsyn2-arraydep −mmsyn2dep −vectorPVP ok
version bump matches the API change (PVP)
Dependencies added: mmsyn2-array
Dependencies removed: mmsyn2, vector
API changes (from Hackage documentation)
Files
- ChangeLog.md +16/−12
- MMSyn4.hs +80/−66
- mmsyn4.cabal +8/−8
ChangeLog.md view
@@ -14,17 +14,17 @@ ## 0.1.2.0 -- 2019-10-22 -* First version revised C. Changed the output files scheme. Avoided a pipe redirection in the terminal. +* First version revised C. Changed the output files scheme. Avoided a pipe redirection in the terminal. Some minor documentation and .cabal file improvements. ## 0.1.3.0 -- 2019-12-16 -* First version revised D. Added the possibility to avoid using the at-sign in the resulting visualization file. Added the possibility to choose +* First version revised D. Added the possibility to avoid using the at-sign in the resulting visualization file. Added the possibility to choose different splines schemes according to the GraphViz documentation. ## 0.1.4.0 -- 2019-12-17 -* First version revised E. Added filtering for not to duplicate records in the +* First version revised E. Added filtering for not to duplicate records in the .gv file. Some minor documentation improvement. ## 0.1.5.0 -- 2019-12-24@@ -37,21 +37,21 @@ ## 0.2.0.0 -- 2020-05-14 -* Second version. Changed the bounds for dependencies so that now also GHC 8.10* series is supported. Changed a module structur so that now it has -additional module MMSyn4 with almost all functions in it (they mostly are not exported because of their specific usage). Added possibility -to specify another basic file to work with except 1.csv. Added a possibility to specify an output graphics format. Some code and +* Second version. Changed the bounds for dependencies so that now also GHC 8.10* series is supported. Changed a module structur so that now it has+additional module MMSyn4 with almost all functions in it (they mostly are not exported because of their specific usage). Added possibility+to specify another basic file to work with except 1.csv. Added a possibility to specify an output graphics format. Some code and documentation improvements. ## 0.3.0.0 -- 2020-05-16 -* Third version. The code is almost fully rewritten. Fixed issues with wrong processing and formatting of the file. Fixed issue with double -printed prompt message in the MMSyn4 module. Changed the exported and imported functions and dependencies for modules. Added the possibility -to specify three additional command line arguments to specify the command to be executed to create the visualization file and its format. +* Third version. The code is almost fully rewritten. Fixed issues with wrong processing and formatting of the file. Fixed issue with double+printed prompt message in the MMSyn4 module. Changed the exported and imported functions and dependencies for modules. Added the possibility+to specify three additional command line arguments to specify the command to be executed to create the visualization file and its format. So, now the program behavior can be basically controlled with command line arguments. ## 0.3.1.0 -- 2020-05-16 -* Third version revised A. Added CPP pre-processor to support compilation also for GHC-7.8* series. +* Third version revised A. Added CPP pre-processor to support compilation also for GHC-7.8* series. ## 0.3.1.1 -- 2020-05-16 @@ -59,12 +59,16 @@ ## 0.4.0.0 -- 2020-05-19 -* Fourth version. Added the new command line arguments "-y", "-s...", "-b..." to specify whether to remove the '@' markers, which option is used to splines -GraphViz functionality and what is the basic name for the created files respectively. For this changed the functions. Some documentation additions +* Fourth version. Added the new command line arguments "-y", "-s...", "-b..." to specify whether to remove the '@' markers, which option is used to splines+GraphViz functionality and what is the basic name for the created files respectively. For this changed the functions. Some documentation additions respectively. ## 0.5.0.0 -- 2020-10-29 * Fifth version. Changed the inlining policies. Some minor code improvements. Boundaries changes for dependencies. +## 0.6.0.0 -- 2020-12-15++* Sixth version. Switched to the GHC.Arr module from the base package. Removed vector and mmsyn2 as dependencies. +Some code improvements.
MMSyn4.hs view
@@ -1,3 +1,7 @@+{-# OPtIONS_HADDOCK show-extensions #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+ {-| Module : MMSyn4 Description : The "glue" between electronic tables and GraphViz@@ -6,14 +10,11 @@ Maintainer : olexandr543@yahoo.com Stability : Experimental -A program @mmsyn4@ converts a specially formated @.csv@ file with a colon as a field separator obtained from the electronic table +A program @mmsyn4@ converts a specially formated @.csv@ file with a colon as a field separator obtained from the electronic table into a visualized by GraphViz graph in the one of the supported by GraphViz graphics format. The proper GraphViz installation is required. -} -{-# LANGUAGE CPP #-}--module MMSyn4 (getFormat,process2)- where+module MMSyn4 (getFormat,process2) where #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__>=710@@ -25,8 +26,8 @@ import System.Info (os) import System.CPUTime (getCPUTime) import System.Process (callCommand)-import CaseBi (getBFst')-import qualified Data.Vector as V+import CaseBi.Arr+import GHC.Arr import EndOfExe (showE) import Data.Maybe (isJust,fromJust) @@ -42,29 +43,40 @@ -- | Returns @True@ if OS is Windows. isWindows :: Bool-isWindows = take 5 os == "mingw" +isWindows = take 5 os == "mingw" {-# INLINE isWindows #-} divideString :: (Char -> Bool) -> String -> [String]-divideString p xs +divideString p xs | null xs = [] | otherwise = let (zs,ys) = break p xs in zs:(if null ys then [""] else divideString p (drop 1 ys))- + isEscapeChar :: Char -> Bool isEscapeChar x = x == '\n' || x == '\r' dropEmptyLines :: [String] -> [String] dropEmptyLines [] = []-dropEmptyLines (ys:yss) - | let ts = dropWhile isSep ys in all isEscapeChar ts || null ts = dropEmptyLines yss +dropEmptyLines (ys:yss)+ | let ts = dropWhile isSep ys in all isEscapeChar ts || null ts = dropEmptyLines yss | otherwise = ys:dropEmptyLines yss -cells :: String -> V.Vector [String]-cells = V.map (divideString isSep) . V.fromList . dropEmptyLines . map (\rs -> if drop (length rs - 1) rs == "\r" then init rs else rs) . lines+cells :: String -> Array Int [String]+cells xs = amap (divideString isSep) . listArray (0,l) . dropEmptyLines . map (\rs -> if drop (length rs - 1) rs == "\r" then init rs else rs) $ yss+ where (yss,l) = linesL1 xs {-# INLINE cells #-} -processCells :: String -> V.Vector [String] -> String-processCells xs v = makeRecordGv xs . convertElemsToStringGv . filterNeeded . changeNeededCells $ v+-- | Inspired by: <https://hackage.haskell.org/package/base-4.14.0.0/docs/src/Data.OldList.html#lines>+linesL :: ([String],Int) -> String -> ([String],Int)+linesL (xs,y) "" = (xs,y)+linesL (xs,y) s = linesL (l:xs,y + 1) (case s' of { [] -> [] ; _:s'' -> s'' })+ where (l, s') = break (== '\n') s++-- | Inspired by: <https://hackage.haskell.org/package/base-4.14.0.0/docs/src/Data.OldList.html#lines>+linesL1 :: String -> ([String],Int)+linesL1 = linesL ([],-1)++processCells :: String -> Array Int [String] -> String+processCells xs arr = makeRecordGv xs . convertElemsToStringGv . filterNeeded . changeNeededCells $ arr {-# INLINE processCells #-} processCellsG :: String -> String -> String@@ -72,32 +84,32 @@ {-# INLINE processCellsG #-} -- | Do not change the lengths of element lists-changeNeededCells :: V.Vector [String] -> V.Vector [String]-changeNeededCells v = V.generate (V.length v) (\i -> changeLine i v)+changeNeededCells :: Array Int [String] -> Array Int [String]+changeNeededCells arr = listArray (bounds arr) . map (\(i, e) -> changeLine i e arr) . assocs $ arr {-# INLINE changeNeededCells #-} --- | Changes every line by changing (if needed) one empty String to the needed one non-empty. It is necessary for this to find the parent cell for the --- line in the previous elements of the 'V.Vector'. The contents of the cell (if exist) are substituted instead of the empty 'String' in the line being +-- | Changes every line by changing (if needed) one empty String to the needed one non-empty. It is necessary for this to find the parent cell for the+-- line in the previous elements of the 'Array'. The contents of the cell (if exist) are substituted instead of the empty 'String' in the line being -- processed. Afterwards, drops all the preceding empty strings in the line. The length of the line now is not constant.-changeLine :: Int -> V.Vector [String] -> [String]-changeLine i v = - let n = length . takeWhile null . V.unsafeIndex v $ i- xs = parentCellContents n i v in if null xs then drop n . V.unsafeIndex v $ i else xs:(drop n . V.unsafeIndex v $ i)+changeLine :: Int -> [String] -> Array Int [String] -> [String]+changeLine i yss arr =+ let !n = length . takeWhile null $ yss+ !xs = parentCellContents n i arr in if null xs then drop n yss else xs:(drop n yss) {-# NOINLINE changeLine #-} -parentCellContents :: Int -> Int -> V.Vector [String] -> String-parentCellContents n i v +parentCellContents :: Int -> Int -> Array Int [String] -> String+parentCellContents n i arr | n == 0 || i == 0 = []- | otherwise = V.unsafeLast . V.filter (not . null) . (\v1 -> V.unsafeSlice 0 i v1) . V.map (!! (n - 1)) $ v+ | otherwise = foldr1Elems (\x y -> if not . null $ y then y else x) . amap (!! (n - 1)) $ arr -- | Change the lengths of element lists by dropping the last empty strings in every element.-filterNeeded :: V.Vector [String] -> V.Vector [String]-filterNeeded = V.map (takeWhile (not . null))+filterNeeded :: Array Int [String] -> Array Int [String]+filterNeeded = amap (takeWhile (not . null)) {-# INLINE filterNeeded #-} --- | Makes conversion for every line -convertElemsToStringGv :: V.Vector [String] -> V.Vector String-convertElemsToStringGv v = (V.map convertLineToStrGv v) V.++ (findAndMakeFilledWithClr v)+-- | Makes conversion for every line+convertElemsToStringGv :: Array Int [String] -> (Array Int String, String)+convertElemsToStringGv arr = (amap convertLineToStrGv arr, findAndMakeFilledWithClr arr) convertLineToStrGv :: [String] -> String convertLineToStrGv xss = "\"" ++ (let ys = concatMap (++"\"->\"") xss in take (length ys - 3) ys) ++ endOfLineGv@@ -108,9 +120,9 @@ | otherwise = "\n" {-# INLINE endOfLineGv #-} -findAndMakeFilledWithClr :: V.Vector [String] -> V.Vector String-findAndMakeFilledWithClr = - V.singleton . concatMap (('\"':) . (++ "\" [style=filled, fillcolor=\"#ffffba\"];" ++ endOfLineGv)) . nub . mconcat . V.toList . V.map lineWithAtSign+findAndMakeFilledWithClr :: Array Int [String] -> String+findAndMakeFilledWithClr = concatMap (('\"':) .+ (++ "\" [style=filled, fillcolor=\"#ffffba\"];" ++ endOfLineGv)) . nub . mconcat . elems . amap lineWithAtSign {-# INLINE findAndMakeFilledWithClr #-} -- | In every list (representing a line) returns only those strings that begin with at-sign.@@ -119,19 +131,19 @@ {-# INLINE lineWithAtSign #-} beginsWithAtSign :: String -> Bool-beginsWithAtSign xs = if take 1 xs == "@" then True else take 2 xs == "\"@" +beginsWithAtSign xs = if take 1 xs == "@" then True else take 2 xs == "\"@" {-# INLINE beginsWithAtSign #-} --- | Makes all needed additions and synthesizes into a single String ready to be recorded to the .gv file.-makeRecordGv :: String -> V.Vector String -> String-makeRecordGv xs v = mconcat ["strict digraph 1 {", endOfLineGv, "overlap=false", endOfLineGv, "splines=", - getBFst' ("true", V.fromList [("0", "false"), ("1", "true"), ("2", "ortho"), ("3", "polyline")]) xs, endOfLineGv, - mconcat . V.toList $ v, "}", endOfLineGv]+-- | Makes all needed additions and synthesizes into a single 'String' ready to be recorded to the .gv file.+makeRecordGv :: String -> (Array Int String, String) -> String+makeRecordGv xs (arr1,str2) = mconcat ["strict digraph 1 {", endOfLineGv, "overlap=false", endOfLineGv, "splines=",+ case xs of { "0" -> "false" ; "1" -> "true" ; "2" -> "ortho" ; "3" -> "polyline" ; ~vvv -> "true" }, endOfLineGv,+ mconcat (elems arr1 `mappend` [str2]), "}", endOfLineGv] {-# INLINE makeRecordGv #-} --- | Processes the given text (the first 'String' argument). The second one is used to get a name of the command to be --- executed to obtain a visualization file. The third argument is used for the 'getFormat'. The fourth argument is the --- basic name for the created files (without prefixes and extensions), the fifth one is an option for GraphVize splines +-- | Processes the given text (the first 'String' argument). The second one is used to get a name of the command to be+-- executed to obtain a visualization file. The third argument is used for the 'getFormat'. The fourth argument is the+-- basic name for the created files (without prefixes and extensions), the fifth one is an option for GraphVize splines -- functionality. The sixth argument is used to specify whether to remove at-signs from the created files. process2 :: String -> String -> String -> String -> String -> String -> IO () process2 text xxs yys bnames splines remAts@@ -139,11 +151,11 @@ ts <- getCPUTime [bnames1,splines1] <- proc2Params2 bnames splines if remAts == "y"- then do + then do let ys = filter (/='@') . processCellsG splines1 $ text in writeFile (show ts ++ "." ++ bnames1 ++ ".gv") ys putStrLn "The visualization will be created without the at-sign." processFile 'n' ts bnames1 xxs yys- else do + else do let ys = processCellsG splines1 text in writeFile ("at." ++ show ts ++ "." ++ bnames1 ++ ".gv") ys putStrLn "The visualization will be created with the at-sign preserved." processFile 'a' ts bnames1 xxs yys@@ -151,7 +163,7 @@ procCtrl :: Int -> IO String procCtrl 1 = putStrLn "Please, input the basic name of the visualization file!" >> getLine-procCtrl 2 = do +procCtrl 2 = do putStrLn "Please, specify the splines mode for GraphViz (see the documentation for GraphViz)" putStrLn "0 -- for \"splines=false\"" putStrLn "1 -- for \"splines=true\""@@ -169,19 +181,19 @@ {-# INLINE processFile #-} processFile1 :: Char -> Integer -> String -> String -> String -> IO ()-processFile1 w t zs xxs yys = do +processFile1 w t zs xxs yys = do [vs,spec] <- proc2Params xxs yys- let u = take 1 vs - if null u || u == "\n" || u == "\x0000" - then error "MMSyn4.processFile1: Please, specify the needed character." - else do - let temp = getBFst' (fromJust (showE "sfdp"), V.fromList (map (\(x, y) -> (x, fromJust y)) [("c", showE "circo"), ("d", showE "dot"), - ("f", showE "fdp"), ("n", showE "neato"), ("o",showE "osage"), ("p", showE "patchwork"), ("s", showE "sfdp"), ("t", showE "twopi")]))- q = getFormat spec + let u = take 1 vs+ if null u || u == "\n" || u == "\x0000"+ then error "MMSyn4.processFile1: Please, specify the needed character."+ else do+ let temp = fromJust . showE . (\x -> case x of { "c" -> "circo" ; "d" -> "dot" ; "f" -> "fdp" ; "n" -> "neato" ;+ "o" ->"osage" ; "p" -> "patchwork" ; "s" -> "sfdp" ; "t" -> "twopi" ; ~vv -> "sfdp" })+ q = getFormat spec callCommand $ temp u ++ (if w == 'n' then " -T" ++ q ++ " " else " -T" ++ q ++ " at.") ++ show t ++ "." ++ zs ++ ".gv -O " proc2Params :: String -> String -> IO [String]-proc2Params xxs yys +proc2Params xxs yys | null xxs = if null yys then mapM getFormat1 [1,2] else do { vs <- getFormat1 1 ; return [vs,yys] } | null yys = do { spec <- getFormat1 2 ; return [xxs,spec] } | otherwise = return [xxs,yys]@@ -196,34 +208,36 @@ {-# INLINE specFormatFile #-} proc2Params2 :: String -> String -> IO [String]-proc2Params2 bnames splines +proc2Params2 bnames splines | null bnames = if null splines then mapM procCtrl [1,2] else do { bnames1 <- procCtrl 1 ; return [bnames1,splines] } | null splines = do { splines1 <- procCtrl 2 ; return [bnames,splines1] } | otherwise = return [bnames,splines] {-# INLINE proc2Params2 #-} getFormat1 :: Int -> IO String-getFormat1 1 = do +getFormat1 1 = do putStrLn "Please, specify the GraphViz command: " mapM_ printGraphFilter ["d","f","t","c","n","s","p","o"] putStrLn "otherwise there will be used the default sfdp" getLine-getFormat1 _ = specFormatFile +getFormat1 _ = specFormatFile {-# INLINE getFormat1 #-} --- | For the given argument (usually of two characters) return the full form of the file format to be generated by GraphViz and @mmsyn4@. The default one +-- | For the given argument (usually of two characters) return the full form of the file format to be generated by GraphViz and @mmsyn4@. The default one -- is \"svg\". getFormat :: String -> String-getFormat = getBFst' ("svg",V.fromList [("cm", "cmapx"),("do", "dot"),("fi", "fig"),("gi", "gif"),("im", "imap"),- ("je", "jpeg"),("jp", "jpg"),("js", "json"),("pd", "pdf"),("pn", "png"),("ps", "ps"),("sv", "svg"),("sz", "svgz"),("xd", "xdot")])+getFormat xs = case xs of { "cm" -> "cmapx" ; "do" -> "dot" ; "fi" -> "fig" ; "gi" -> "gif" ; "im" -> "imap" ;+ "je" -> "jpeg" ; "jp" -> "jpg" ; "js" -> "json" ; "pd" -> "pdf" ; "pn" -> "png" ; "ps" -> "ps" ; "sv" -> "svg" ; "sz" -> "svgz" ; "xd" -> "xdot" ; ~vvv -> "svg" } {-# INLINE getFormat #-} printFormF :: String -> IO ()-printFormF xs = putStrLn $ show xs ++ " -- for -T" ++ getBFst' ("svg",V.fromList [("cm", "cmapx"),("do", "dot"),("fi", "fig"),("gi", "gif"),("im", "imap"),- ("je", "jpeg"),("jp", "jpg"),("js", "json"),("pd", "pdf"),("pn", "png"),("ps", "ps"),("sv", "svg"),("sz", "svgz"),("xd", "xdot")]) xs ++ "\""+printFormF xs = putStrLn $ show xs ++ " -- for -T" ++ case xs of { "cm" -> "cmapx" ; "do" -> "dot" ; "fi" -> "fig" ;+ "gi" -> "gif" ; "im" -> "imap" ; "je" -> "jpeg" ; "jp" -> "jpg" ; "js" -> "json" ; "pd" -> "pdf" ; "pn" -> "png" ;+ "ps" -> "ps" ; "sv" -> "svg" ; "sz" -> "svgz" ; "xd" -> "xdot" ; ~vvv -> "svg" } ++ "\"" {-# INLINE printFormF #-} printGraphFilter :: String -> IO ()-printGraphFilter xs = putStrLn $ show (take 1 xs) ++ " -- for " ++ getBFst' ("sfdp", V.fromList [("c", "circo"), ("d", "dot"), ("f", "fdp"), - ("n", "neato"), ("o", "osage"), ("p", "patchwork"), ("s", "sfdp"), ("t", "twopi")]) (take 1 xs)+printGraphFilter xs = putStrLn $ show (take 1 xs) ++ " -- for " ++ case take 1 xs of { "c" -> "circo" ; "d" -> "dot" ;+ "f" -> "fdp" ; "n" -> "neato" ; "o" -> "osage" ; "p" -> "patchwork" ; "s" -> "sfdp" ; "t" -> "twopi" ;+ ~vvv -> "sfdp" } {-# INLINE printGraphFilter #-}
mmsyn4.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: mmsyn4-version: 0.5.0.0+version: 0.6.0.0 synopsis: The "glue" between electronic tables and GraphViz description: The program mmsyn4 converts a specially formated .csv file with a colon as a field separator obtained from the electronic table into a visualized by GraphViz graph. homepage: https://hackage.haskell.org/package/mmsyn4@@ -10,7 +10,7 @@ license-file: LICENSE author: OleksandrZhabenko maintainer: olexandr543@yahoo.com--- copyright:+copyright: Oleksandr Zhabenko category: Graphics build-type: Simple extra-source-files: ChangeLog.md, README.markdown@@ -18,16 +18,16 @@ library exposed-modules: Main, MMSyn4- -- other-modules: - other-extensions: CPP- build-depends: base >=4.7 && <4.15, directory >=1 && <1.5, process >=1.2 && <1.8, mmsyn2 >=0.3 && <1, vector >=0.11 && <0.14, mmsyn3 >=0.1.5 && <0.2+ -- other-modules:+ other-extensions: CPP, BangPatterns+ build-depends: base >=4.7 && <4.15, directory >=1 && <1.5, process >=1.2 && <1.8, mmsyn2-array >=0.1 && <1, mmsyn3 >=0.1.5 && <0.2 -- hs-source-dirs: default-language: Haskell2010 executable mmsyn4 main-is: Main.hs- -- other-modules:- other-extensions: CPP- build-depends: base >=4.7 && <4.15, directory >=1 && <1.5, process >=1.2 && <1.8, mmsyn2 >=0.3 && <1, vector >=0.11 && <0.14, mmsyn3 >=0.1.5 && <0.2+ other-modules: MMSyn4+ other-extensions: CPP, BangPatterns+ build-depends: base >=4.7 && <4.15, directory >=1 && <1.5, process >=1.2 && <1.8, mmsyn2-array >=0.1 && <1, mmsyn3 >=0.1.5 && <0.2 -- hs-source-dirs: default-language: Haskell2010