{-# OPtIONS_HADDOCK show-extensions #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE BangPatterns #-}

{-|
Module      : GVTI
Description : GraphViz Tabular Interface main conversion functionality.
Copyright   : (c) Oleksandr Zhabenko, 2017-2023
License     : MIT
Maintainer  : oleksandr.zhabenko@yahoo.com
Stability   : Experimental

A program @gvti@ converts a specially formated @.csv@ file with a special 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.
This is the main functionality module.
-}

module GVTI (getFormat,process2,makeRecordGv) where

import GHC.Base
import GHC.List
import GHC.Num
import System.IO
import Text.Show (show)
import Data.List (nub)
import System.Info (os)
import System.CPUTime (getCPUTime)
import System.Process (callCommand)
import GHC.Arr
import EndOfExe (showE)
import Data.Maybe (isJust,fromJust,isNothing)
import Text.Read (readMaybe)
import qualified Data.Foldable as F (foldr)

isSep :: Char -> Bool
isSep :: Char -> Bool
isSep = (forall a. Eq a => a -> a -> Bool
== Char
':')

isSepG :: String -> Char -> Bool
isSepG :: String -> Char -> Bool
isSepG String
delims Char
c = Char
c forall a. Eq a => a -> [a] -> Bool
`elem` String
delims

-- | Returns @True@ if OS is Windows.
isWindows :: Bool
isWindows :: Bool
isWindows = forall a. Int -> [a] -> [a]
take Int
5 String
os forall a. Eq a => a -> a -> Bool
== String
"mingw"
{-# INLINE isWindows #-}

divideString :: (Char -> Bool) -> String -> [String]
divideString :: (Char -> Bool) -> String -> [String]
divideString Char -> Bool
p String
xs
 | forall a. [a] -> Bool
null String
xs = []
 | Bool
otherwise = let (String
zs,String
ys) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
xs in String
zsforall a. a -> [a] -> [a]
:(if forall a. [a] -> Bool
null String
ys then [String
""] else (Char -> Bool) -> String -> [String]
divideString Char -> Bool
p (forall a. Int -> [a] -> [a]
drop Int
1 String
ys))

isEscapeChar :: Char -> Bool
isEscapeChar :: Char -> Bool
isEscapeChar Char
x = Char
x forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
x forall a. Eq a => a -> a -> Bool
== Char
'\r'

dropEmptyLines :: String -> [String] -> [String]
dropEmptyLines :: String -> [String] -> [String]
dropEmptyLines String
_ [] = []
dropEmptyLines String
delims (String
ys:[String]
yss)
 | let ts :: String
ts = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> Char -> Bool
isSepG String
delims) String
ys in forall a. (a -> Bool) -> [a] -> Bool
all Char -> Bool
isEscapeChar String
ts Bool -> Bool -> Bool
|| forall a. [a] -> Bool
null String
ts = String -> [String] -> [String]
dropEmptyLines String
delims [String]
yss
 | Bool
otherwise = String
ysforall a. a -> [a] -> [a]
:String -> [String] -> [String]
dropEmptyLines String
delims [String]
yss

cells 
  :: String -- ^ The list of 'Char' delimiters to be used.
  -> String 
  -> Array Int [String] 
cells :: String -> String -> Array Int [String]
cells String
delims String
xs = forall a b i. (a -> b) -> Array i a -> Array i b
amap ((Char -> Bool) -> String -> [String]
divideString (String -> Char -> Bool
isSepG String
delims)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
dropEmptyLines String
delims forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
rs -> if forall a. Int -> [a] -> [a]
drop (forall a. [a] -> Int
length String
rs forall a. Num a => a -> a -> a
- Int
1) String
rs forall a. Eq a => a -> a -> Bool
== String
"\r" then forall a. [a] -> [a]
init String
rs else String
rs) forall a b. (a -> b) -> a -> b
$ [String]
yss
  where ([String]
yss,Int
l) = String -> ([String], Int)
linesL1 String
xs
{-# INLINE cells #-}

-- | 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 :: ([String], Int) -> String -> ([String], Int)
linesL ([String]
xs,Int
y) String
"" = ([String]
xs,Int
y)
linesL ([String]
xs,Int
y) String
s  = ([String], Int) -> String -> ([String], Int)
linesL (String
lforall a. a -> [a] -> [a]
:[String]
xs,Int
y forall a. Num a => a -> a -> a
+ Int
1) (case String
s' of { [] -> [] ; Char
_:String
s'' -> String
s'' })
  where (String
l, String
s') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'\n') String
s

-- | Inspired by: <https://hackage.haskell.org/package/base-4.14.0.0/docs/src/Data.OldList.html#lines>
linesL1 :: String -> ([String],Int)
linesL1 :: String -> ([String], Int)
linesL1 = ([String], Int) -> String -> ([String], Int)
linesL ([],-Int
1)

processCells :: String -> Maybe (Double, Double) -> String -> Array Int [String] -> String
processCells :: String
-> Maybe (Double, Double) -> String -> Array Int [String] -> String
processCells String
xs Maybe (Double, Double)
size String
ratio Array Int [String]
arr = String
-> Maybe (Double, Double)
-> String
-> (Array Int String, String)
-> String
makeRecordGv String
xs Maybe (Double, Double)
size String
ratio forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int [String] -> (Array Int String, String)
convertElemsToStringGv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int [String] -> Array Int [String]
filterNeeded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array Int [String] -> Array Int [String]
changeNeededCells forall a b. (a -> b) -> a -> b
$ Array Int [String]
arr
{-# INLINE processCells #-}

processCellsG :: String -> String -> Maybe (Double, Double) -> String -> String -> String
processCellsG :: String
-> String -> Maybe (Double, Double) -> String -> String -> String
processCellsG String
delims String
xs Maybe (Double, Double)
size String
ratio = String
-> Maybe (Double, Double) -> String -> Array Int [String] -> String
processCells String
xs Maybe (Double, Double)
size String
ratio forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Array Int [String]
cells String
delims
{-# INLINE processCellsG #-}

-- | Do not change the lengths of element lists
changeNeededCells :: Array Int [String] -> Array Int [String]
changeNeededCells :: Array Int [String] -> Array Int [String]
changeNeededCells Array Int [String]
arr = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall i e. Array i e -> (i, i)
bounds Array Int [String]
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, [String]
e) -> Int -> [String] -> Array Int [String] -> [String]
changeLine Int
i [String]
e Array Int [String]
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => Array i e -> [(i, e)]
assocs forall a b. (a -> b) -> a -> b
$ Array Int [String]
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 '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 -> [String] -> Array Int [String] -> [String]
changeLine :: Int -> [String] -> Array Int [String] -> [String]
changeLine Int
i [String]
yss Array Int [String]
arr =
  let !n :: Int
n = forall a. [a] -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall a. [a] -> Bool
null forall a b. (a -> b) -> a -> b
$ [String]
yss
      !xs :: String
xs = Int -> Int -> Array Int [String] -> String
parentCellContents Int
n Int
i Array Int [String]
arr in if forall a. [a] -> Bool
null String
xs then forall a. Int -> [a] -> [a]
drop Int
n [String]
yss else String
xsforall a. a -> [a] -> [a]
:(forall a. Int -> [a] -> [a]
drop Int
n [String]
yss)
{-# NOINLINE changeLine #-}

parentCellContents :: Int -> Int -> Array Int [String] -> String
parentCellContents :: Int -> Int -> Array Int [String] -> String
parentCellContents Int
n Int
i Array Int [String]
arr
 | Int
n forall a. Eq a => a -> a -> Bool
== Int
0 = []
 | Int
ll forall a. Eq a => a -> a -> Bool
== Int
0 = []
 | Bool
otherwise = (\(String
x, Int
_, Int
_) -> String
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c} {a}. (Ord c, Num c) => [a] -> ([a], c, c) -> ([a], c, c)
f ([], Int
0, Int
ll) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b i. (a -> b) -> Array i a -> Array i b
amap (forall a. [a] -> Int -> a
!! (Int
n forall a. Num a => a -> a -> a
- Int
1)) forall a b. (a -> b) -> a -> b
$ Array Int [String]
arr
     where ll :: Int
ll = forall i e. Array i e -> Int
numElements Array Int [String]
arr forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
- Int
1
           f :: [a] -> ([a], c, c) -> ([a], c, c)
f [a]
e ([a]
e0, c
m, c
k)
             | c
m forall a. Ord a => a -> a -> Bool
< c
k Bool -> Bool -> Bool
&& Bool -> Bool
not (forall a. [a] -> Bool
null [a]
e) = ([a]
e, c
m forall a. Num a => a -> a -> a
+ c
1, c
k)
             | Bool
otherwise = ([a]
e0, c
m forall a. Num a => a -> a -> a
+ c
1, c
k)

-- | Change the lengths of element lists by dropping the last empty strings in every element.
filterNeeded :: Array Int [String] -> Array Int [String]
filterNeeded :: Array Int [String] -> Array Int [String]
filterNeeded = forall a b i. (a -> b) -> Array i a -> Array i b
amap (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Bool
null))
{-# INLINE filterNeeded #-}

-- | Makes conversion for every line
convertElemsToStringGv :: Array Int [String] -> (Array Int String, String)
convertElemsToStringGv :: Array Int [String] -> (Array Int String, String)
convertElemsToStringGv Array Int [String]
arr = (forall a b i. (a -> b) -> Array i a -> Array i b
amap [String] -> String
convertLineToStrGv Array Int [String]
arr, Array Int [String] -> String
findAndMakeFilledWithClr Array Int [String]
arr)

convertLineToStrGv :: [String] -> String
convertLineToStrGv :: [String] -> String
convertLineToStrGv [String]
xss = String
"\"" forall a. Monoid a => a -> a -> a
`mappend` (let ys :: String
ys = forall a b. (a -> [b]) -> [a] -> [b]
concatMap (forall a. Monoid a => a -> a -> a
`mappend`String
"\"->\"") [String]
xss in forall a. Int -> [a] -> [a]
take (forall a. [a] -> Int
length String
ys forall a. Num a => a -> a -> a
- Int
3) String
ys) forall a. Monoid a => a -> a -> a
`mappend` String
endOfLineGv
{-# INLINE convertLineToStrGv #-}

endOfLineGv :: String
endOfLineGv :: String
endOfLineGv | Bool
isWindows = String
"\r\n"
            | Bool
otherwise = String
"\n"
{-# INLINE endOfLineGv #-}

findAndMakeFilledWithClr :: Array Int [String] -> String
findAndMakeFilledWithClr :: Array Int [String] -> String
findAndMakeFilledWithClr = forall a b. (a -> [b]) -> [a] -> [b]
concatMap ((Char
'\"'forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (forall a. [a] -> [a] -> [a]
++ String
"\" [style=filled, fillcolor=\"#ffffba\"];" forall a. [a] -> [a] -> [a]
++ String
endOfLineGv)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Array i e -> [e]
elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b i. (a -> b) -> Array i a -> Array i b
amap [String] -> [String]
lineWithAtSign
{-# INLINE findAndMakeFilledWithClr #-}

-- | In every list (representing a line) returns only those strings that begin with at-sign.
lineWithAtSign :: [String] -> [String]
lineWithAtSign :: [String] -> [String]
lineWithAtSign = forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
beginsWithAtSign
{-# INLINE lineWithAtSign #-}

beginsWithAtSign :: String -> Bool
beginsWithAtSign :: String -> Bool
beginsWithAtSign String
xs 
 | forall a. Int -> [a] -> [a]
take Int
1 String
xs forall a. Eq a => a -> a -> Bool
== String
"@" = Bool
True 
 | Bool
otherwise = forall a. Int -> [a] -> [a]
take Int
2 String
xs forall a. Eq a => a -> a -> Bool
== String
"\"@"
{-# INLINE beginsWithAtSign #-}

-- | Makes all needed additions and synthesizes into a single 'String' ready to be recorded to the .gv file.
makeRecordGv :: String -> Maybe (Double, Double) -> String -> (Array Int String, String) -> String
makeRecordGv :: String
-> Maybe (Double, Double)
-> String
-> (Array Int String, String)
-> String
makeRecordGv String
xs Maybe (Double, Double)
size String
ratio (Array Int String
arr1,String
str2) = forall a. Monoid a => [a] -> a
mconcat [String
"strict digraph 1 {", String
endOfLineGv, forall {a} {a}.
(Show a, Show a) =>
Maybe (a, a) -> String -> String
sizeF Maybe (Double, Double)
size String
endOfLineGv, String -> String -> String
ratioF String
ratio String
endOfLineGv, String
"overlap=false", String
endOfLineGv, String
"splines=",
  case String
xs of { String
"0" -> String
"false" ; String
"1" -> String
"true" ; String
"2" -> String
"ortho" ; String
"3" -> String
"polyline" ; ~String
vvv -> String
"true" }, String
endOfLineGv,
    forall a. Monoid a => [a] -> a
mconcat (forall i e. Array i e -> [e]
elems Array Int String
arr1 forall a. Monoid a => a -> a -> a
`mappend` [String
str2]), String
"}", String
endOfLineGv]
       where sizeF :: Maybe (a, a) -> String -> String
sizeF si :: Maybe (a, a)
si@(Just (a
x,a
y)) String
ks = String
"size=\"" forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show a
x forall a. Monoid a => a -> a -> a
`mappend` String
"," forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show a
y forall a. Monoid a => a -> a -> a
`mappend` String
"\"" forall a. Monoid a => a -> a -> a
`mappend` String
ks
             sizeF Maybe (a, a)
_ String
_ = String
""
             ratioF :: String -> String -> String
ratioF String
ks String
js 
               | forall a. Maybe a -> Bool
isNothing Maybe Double
rRat = 
                   if String
ks forall a. Eq a => a -> [a] -> Bool
`elem` [String
"fill",String
"compress",String
"auto"] 
                       then String
"ratio=" forall a. Monoid a => a -> a -> a
`mappend` String
ks forall a. Monoid a => a -> a -> a
`mappend` String
js
                       else String
""
               | Bool
otherwise = String
"ratio=" forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show (forall a. HasCallStack => Maybe a -> a
fromJust Maybe Double
rRat) forall a. Monoid a => a -> a -> a
`mappend` String
js
                     where rRat :: Maybe Double
rRat = forall a. Read a => String -> Maybe a
readMaybe String
ratio::Maybe Double
{-# INLINE makeRecordGv #-}

-- | Processes the given text (the last 'String' argument). The first 'String' argument is 
-- the list oof delimiters every one of which will mark the edge in the resulting digraph. 
-- 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 GraphViz splines
-- functionality. The sixth argument is used to specify whether to remove at-signs from the created files. 
-- The 'Maybe' argument specifies the optional maximum size for the created visualization image in inches.
-- The next argument specifies the aspect ratio (drawing height/drawing width) for the drawing. 
--
process2 :: String -> String -> String -> String -> String -> String -> Maybe (Double, Double) -> String -> String -> IO ()
process2 :: String
-> String
-> String
-> String
-> String
-> String
-> Maybe (Double, Double)
-> String
-> String
-> IO ()
process2 String
delims String
xxs String
yys String
bnames String
splines String
remAts Maybe (Double, Double)
sizes String
ratio String
text
 | forall a. [a] -> Bool
null String
text = forall a. HasCallStack => String -> a
error String
"GVTI.process2: Empty text to be processed! "
 | Bool
otherwise = do
      Integer
ts <- IO Integer
getCPUTime
      [String
bnames1,String
splines1] <- String -> String -> IO [String]
proc2Params2 String
bnames String
splines
      let ys :: String
ys = Bool -> String -> String
g (String
remAts forall a. Eq a => a -> a -> Bool
== String
"y") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> String -> Maybe (Double, Double) -> String -> String -> String
processCellsG String
delims String
splines1 Maybe (Double, Double)
sizes String
ratio forall a b. (a -> b) -> a -> b
$ String
text in String -> String -> IO ()
writeFile (Bool -> String -> String
f (String
remAts forall a. Eq a => a -> a -> Bool
== String
"y") (forall a. Show a => a -> String
show Integer
ts forall a. Monoid a => a -> a -> a
`mappend` String
"." forall a. Monoid a => a -> a -> a
`mappend` String
bnames1 forall a. Monoid a => a -> a -> a
`mappend` String
".gv")) String
ys
      String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"The visualization will be created with" forall a. Monoid a => a -> a -> a
`mappend` (if String
remAts forall a. Eq a => a -> a -> Bool
== String
"y" then String
"out" else String
"") forall a. Monoid a => a -> a -> a
`mappend` String
" the at-sign."
      Char -> Integer -> String -> String -> String -> IO ()
processFile (if String
remAts forall a. Eq a => a -> a -> Bool
== String
"y" 
                       then Char
'n'
                       else Char
'a') Integer
ts String
bnames1 String
xxs String
yys
       where f :: Bool -> String -> String
f Bool
bool String
ys
               | Bool
bool = String
ys
               | Bool
otherwise = String
"at." forall a. Monoid a => a -> a -> a
`mappend` String
ys
             g :: Bool -> String -> String
g Bool
bool 
               | Bool
bool = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'@')
               | Bool
otherwise = forall a. a -> a
id               

procCtrl :: Int -> IO String
procCtrl :: Int -> IO String
procCtrl Int
1 = String -> IO ()
putStrLn String
"Please, input the basic name of the visualization file!" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String
getLine
procCtrl Int
2 = do
  String -> IO ()
putStrLn String
"Please, specify the splines mode for GraphViz (see the documentation for GraphViz)"
  String -> IO ()
putStrLn String
"0 -- for \"splines=false\""
  String -> IO ()
putStrLn String
"1 -- for \"splines=true\""
  String -> IO ()
putStrLn String
"2 -- for \"splines=ortho\""
  String -> IO ()
putStrLn String
"3 -- for \"splines=polyline\""
  String -> IO ()
putStrLn String
"The default one is \"splines=true\""
  IO String
getLine
procCtrl Int
_ = String -> IO ()
putStrLn String
"Would you like to remove all \'@\' signs from the visualization file?" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String
getLine

processFile :: Char -> Integer -> String -> String -> String -> IO ()
processFile :: Char -> Integer -> String -> String -> String -> IO ()
processFile Char
w Integer
t String
zs String
xxs String
yys = do
  if forall a. (a -> Bool) -> [a] -> Bool
all (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE) [String
"fdp",String
"twopi",String
"circo",String
"neato",String
"sfdp",String
"dot",String
"patchwork",String
"osage"]
    then Char -> Integer -> String -> String -> String -> IO ()
processFile1 Char
w Integer
t String
zs String
xxs String
yys
    else forall a. HasCallStack => String -> a
error String
"GVTI.processFile: Please, install the GraphViz so that its executables are in the directories mentioned in the variable PATH!"
{-# INLINE processFile #-}

processFile1 :: Char -> Integer -> String -> String -> String -> IO ()
processFile1 :: Char -> Integer -> String -> String -> String -> IO ()
processFile1 Char
w Integer
t String
zs String
xxs String
yys = do
  [String
vs,String
spec] <- String -> String -> IO [String]
proc2Params String
xxs String
yys
  let u :: String
u = forall a. Int -> [a] -> [a]
take Int
1 String
vs
  if forall a. [a] -> Bool
null String
u Bool -> Bool -> Bool
|| String
u forall a. Eq a => a -> a -> Bool
== String
"\n" Bool -> Bool -> Bool
|| String
u forall a. Eq a => a -> a -> Bool
== String
"\x0000"
    then forall a. HasCallStack => String -> a
error String
"GVTI.processFile1: Please, specify the needed character."
    else do
      let temp :: String -> String
temp = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
showE forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
x -> case String
x of { String
"c" -> String
"circo" ; String
"d" -> String
"dot" ; String
"f" -> String
"fdp" ; String
"n" -> String
"neato" ;
           String
"o" ->String
"osage" ; String
"p" -> String
"patchwork" ; String
"s" -> String
"sfdp" ; String
"t" -> String
"twopi" ; ~String
vv -> String
"sfdp" })
          q :: String
q = String -> String
getFormat String
spec
      String -> IO ()
callCommand forall a b. (a -> b) -> a -> b
$ String -> String
temp String
u forall a. Monoid a => a -> a -> a
`mappend` (if Char
w forall a. Eq a => a -> a -> Bool
== Char
'n' then String
" -T" forall a. Monoid a => a -> a -> a
`mappend` String
q forall a. Monoid a => a -> a -> a
`mappend` String
" " else String
" -T" forall a. Monoid a => a -> a -> a
`mappend` String
q forall a. Monoid a => a -> a -> a
`mappend` String
" at.") forall a. Monoid a => a -> a -> a
`mappend` forall a. Show a => a -> String
show Integer
t forall a. Monoid a => a -> a -> a
`mappend` String
"." forall a. Monoid a => a -> a -> a
`mappend` String
zs forall a. Monoid a => a -> a -> a
`mappend` String
".gv -O "

proc2Params :: String -> String -> IO [String]
proc2Params :: String -> String -> IO [String]
proc2Params String
xxs String
yys
 | forall a. [a] -> Bool
null String
xxs = if forall a. [a] -> Bool
null String
yys then forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO String
getFormat1 [Int
1,Int
2] else do { String
vs <- Int -> IO String
getFormat1 Int
1 ; forall (m :: * -> *) a. Monad m => a -> m a
return [String
vs,String
yys] }
 | forall a. [a] -> Bool
null String
yys = do { String
spec <- Int -> IO String
getFormat1 Int
2 ; forall (m :: * -> *) a. Monad m => a -> m a
return [String
xxs,String
spec] }
 | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return [String
xxs,String
yys]
{-# INLINE proc2Params #-}

specFormatFile :: IO String
specFormatFile :: IO String
specFormatFile = do
  String -> IO ()
putStrLn String
"Please, specify the GraphViz output format for the file: "
  forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO ()
printFormF [String
"do", String
"xd", String
"ps", String
"pd", String
"sv", String
"sz", String
"fi", String
"pn", String
"gi", String
"jp", String
"je", String
"js", String
"im", String
"cm"] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"otherwise there will be used the default -Tsvg" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String
getLine
{-# INLINE specFormatFile #-}

proc2Params2 :: String -> String -> IO [String]
proc2Params2 :: String -> String -> IO [String]
proc2Params2 String
bnames String
splines
 | forall a. [a] -> Bool
null String
bnames = if forall a. [a] -> Bool
null String
splines then forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> IO String
procCtrl [Int
1,Int
2] else do { String
bnames1 <- Int -> IO String
procCtrl Int
1 ; forall (m :: * -> *) a. Monad m => a -> m a
return [String
bnames1,String
splines] }
 | forall a. [a] -> Bool
null String
splines = do { String
splines1 <- Int -> IO String
procCtrl Int
2 ; forall (m :: * -> *) a. Monad m => a -> m a
return [String
bnames,String
splines1] }
 | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return [String
bnames,String
splines]
{-# INLINE proc2Params2 #-}

getFormat1 :: Int -> IO String
getFormat1 :: Int -> IO String
getFormat1 Int
1 = do
  String -> IO ()
putStrLn String
"Please, specify the GraphViz command: "
  forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO ()
printGraphFilter [String
"d",String
"f",String
"t",String
"c",String
"n",String
"s",String
"p",String
"o"] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
"otherwise there will be used the default sfdp" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO String
getLine
getFormat1 Int
_ = IO String
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
-- is \"svg\".
getFormat :: String -> String
getFormat :: String -> String
getFormat String
xs = case String
xs of { String
"cm" -> String
"cmapx" ; String
"do" -> String
"dot" ; String
"fi" -> String
"fig" ; String
"gi" -> String
"gif" ; String
"im" -> String
"imap" ;
  String
"je" -> String
"jpeg" ; String
"jp" -> String
"jpg" ; String
"js" -> String
"json" ; String
"pd" -> String
"pdf" ; String
"pn" -> String
"png" ; String
"ps" -> String
"ps" ; String
"sv" -> String
"svg" ; String
"sz" -> String
"svgz" ; String
"xd" -> String
"xdot" ; ~String
vvv -> String
"svg" }
{-# INLINE getFormat #-}

printFormF :: String -> IO ()
printFormF :: String -> IO ()
printFormF String
xs = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
xs forall a. Monoid a => a -> a -> a
`mappend` String
" -- for -T" forall a. Monoid a => a -> a -> a
`mappend` case String
xs of { String
"cm" -> String
"cmapx" ; String
"do" -> String
"dot" ; String
"fi" -> String
"fig" ;
   String
"gi" -> String
"gif" ; String
"im" -> String
"imap" ; String
"je" -> String
"jpeg" ; String
"jp" -> String
"jpg" ; String
"js" -> String
"json" ; String
"pd" -> String
"pdf" ; String
"pn" -> String
"png" ;
      String
"ps" -> String
"ps" ; String
"sv" -> String
"svg" ; String
"sz" -> String
"svgz" ; String
"xd" -> String
"xdot" ; ~String
vvv -> String
"svg" } forall a. Monoid a => a -> a -> a
`mappend` String
"\""
{-# INLINE printFormF #-}

printGraphFilter :: String -> IO ()
printGraphFilter :: String -> IO ()
printGraphFilter String
xs = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall a. Int -> [a] -> [a]
take Int
1 String
xs) forall a. Monoid a => a -> a -> a
`mappend` String
" -- for " forall a. Monoid a => a -> a -> a
`mappend` case forall a. Int -> [a] -> [a]
take Int
1 String
xs of { String
"c" -> String
"circo" ; String
"d" -> String
"dot" ;
  String
"f" -> String
"fdp" ; String
"n" -> String
"neato" ; String
"o" -> String
"osage" ; String
"p" -> String
"patchwork" ; String
"s" -> String
"sfdp" ; String
"t" -> String
"twopi" ;
    ~String
vvv ->  String
"sfdp" }
{-# INLINE printGraphFilter #-}