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

{-|
Module      : MMSyn4
Description : The "glue" between electronic tables and GraphViz
Copyright   : (c) OleksandrZhabenko, 2017-2020
License     : MIT
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
into a visualized by GraphViz graph in the one of the supported by GraphViz graphics format. The proper GraphViz installation is required.
-}

module MMSyn4 (getFormat,process2) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
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)
import Data.Foldable (foldr)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

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

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

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

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

dropEmptyLines :: [String] -> [String]
dropEmptyLines :: [[Char]] -> [[Char]]
dropEmptyLines [] = []
dropEmptyLines ([Char]
ys:[[Char]]
yss)
 | let ts :: [Char]
ts = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSep [Char]
ys in (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isEscapeChar [Char]
ts Bool -> Bool -> Bool
|| [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ts = [[Char]] -> [[Char]]
dropEmptyLines [[Char]]
yss
 | Bool
otherwise = [Char]
ys[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]] -> [[Char]]
dropEmptyLines [[Char]]
yss

cells :: String -> Array Int [String]
cells :: [Char] -> Array Int [[Char]]
cells [Char]
xs = ([Char] -> [[Char]]) -> Array Int [Char] -> Array Int [[Char]]
forall a b i. (a -> b) -> Array i a -> Array i b
amap ((Char -> Bool) -> [Char] -> [[Char]]
divideString Char -> Bool
isSep) (Array Int [Char] -> Array Int [[Char]])
-> ([[Char]] -> Array Int [Char]) -> [[Char]] -> Array Int [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> [[Char]] -> Array Int [Char]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
l) ([[Char]] -> Array Int [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> Array Int [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
dropEmptyLines ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
rs -> if Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Char]
rs [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"\r" then [Char] -> [Char]
forall a. [a] -> [a]
init [Char]
rs else [Char]
rs) ([[Char]] -> Array Int [[Char]]) -> [[Char]] -> Array Int [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]]
yss
  where ([[Char]]
yss,Int
l) = [Char] -> ([[Char]], Int)
linesL1 [Char]
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 :: ([[Char]], Int) -> [Char] -> ([[Char]], Int)
linesL ([[Char]]
xs,Int
y) [Char]
"" = ([[Char]]
xs,Int
y)
linesL ([[Char]]
xs,Int
y) [Char]
s  = ([[Char]], Int) -> [Char] -> ([[Char]], Int)
linesL ([Char]
l[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
xs,Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (case [Char]
s' of { [] -> [] ; Char
_:[Char]
s'' -> [Char]
s'' })
  where ([Char]
l, [Char]
s') = (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') [Char]
s

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

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

processCellsG :: String -> String -> String
processCellsG :: [Char] -> [Char] -> [Char]
processCellsG [Char]
xs = [Char] -> Array Int [[Char]] -> [Char]
processCells [Char]
xs (Array Int [[Char]] -> [Char])
-> ([Char] -> Array Int [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Array Int [[Char]]
cells
{-# INLINE processCellsG #-}

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

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

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

convertLineToStrGv :: [String] -> String
convertLineToStrGv :: [[Char]] -> [Char]
convertLineToStrGv [[Char]]
xss = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (let ys :: [Char]
ys = ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\"->\"") [[Char]]
xss in Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ys Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Char]
ys) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
endOfLineGv
{-# INLINE convertLineToStrGv #-}

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

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

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

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

-- | 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 :: [Char] -> (Array Int [Char], [Char]) -> [Char]
makeRecordGv [Char]
xs (Array Int [Char]
arr1,[Char]
str2) = [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat [[Char]
"strict digraph 1 {", [Char]
endOfLineGv, [Char]
"overlap=false", [Char]
endOfLineGv, [Char]
"splines=",
  case [Char]
xs of { [Char]
"0" -> [Char]
"false" ; [Char]
"1" -> [Char]
"true" ; [Char]
"2" -> [Char]
"ortho" ; [Char]
"3" -> [Char]
"polyline" ; ~[Char]
vvv -> [Char]
"true" }, [Char]
endOfLineGv,
    [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Array Int [Char] -> [[Char]]
forall i e. Array i e -> [e]
elems Array Int [Char]
arr1 [[Char]] -> [[Char]] -> [[Char]]
forall a. Monoid a => a -> a -> a
`mappend` [[Char]
str2]), [Char]
"}", [Char]
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
-- 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 :: [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> IO ()
process2 [Char]
text [Char]
xxs [Char]
yys [Char]
bnames [Char]
splines [Char]
remAts
  | [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
text Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = do
      Integer
ts <- IO Integer
getCPUTime
      [[Char]
bnames1,[Char]
splines1] <- [Char] -> [Char] -> IO [[Char]]
proc2Params2 [Char]
bnames [Char]
splines
      if [Char]
remAts [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"y"
        then do
          let ys :: [Char]
ys = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
processCellsG [Char]
splines1 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
text in [Char] -> [Char] -> IO ()
writeFile (Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bnames1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".gv") [Char]
ys
          [Char] -> IO ()
putStrLn [Char]
"The visualization will be created without the at-sign."
          Char -> Integer -> [Char] -> [Char] -> [Char] -> IO ()
processFile Char
'n' Integer
ts [Char]
bnames1 [Char]
xxs [Char]
yys
        else do
          let ys :: [Char]
ys = [Char] -> [Char] -> [Char]
processCellsG [Char]
splines1 [Char]
text in [Char] -> [Char] -> IO ()
writeFile ([Char]
"at." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
ts [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
bnames1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".gv") [Char]
ys
          [Char] -> IO ()
putStrLn [Char]
"The visualization will be created with the at-sign preserved."
          Char -> Integer -> [Char] -> [Char] -> [Char] -> IO ()
processFile Char
'a' Integer
ts [Char]
bnames1 [Char]
xxs [Char]
yys
  | Bool
otherwise = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty text to be processed! "

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

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

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

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

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

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

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

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