module Main (main) where
import System.Info (os)
import System.Directory
import System.CPUTime (getCPUTime)
import System.Process (callCommand)
import CaseBi (getBFst')
import qualified Data.Vector as V
import EndOfExe (showE)
import Data.Maybe (isJust,fromJust)
isSep :: Char -> Bool
isSep c = c == ':'
isWindows :: Bool
isWindows = take 5 os == "mingw"
divideString :: (Char -> Bool) -> String -> [String]
divideString p xs | null xs = []
| otherwise = let (zs,ys) = break p xs in zs:divideString p (if null ys then ys else tail ys)
isEscapeChar :: Char -> Bool
isEscapeChar xs = xs `elem` "\n\r"
dropEmptyLines :: [String] -> [String]
dropEmptyLines [] = []
dropEmptyLines (ys:yss) | let ts = dropWhile isSep ys in all isEscapeChar ts || null ts = dropEmptyLines yss
| otherwise = ys:dropEmptyLines yss
cells :: String -> [[String]]
cells x = map (divideString isSep) (dropEmptyLines (lines x))
changeCell :: String -> String -> String -> String
changeCell x y z | not . null $ y = y
| null y && (not . null $ z) = x
| otherwise = []
isTruncated :: String -> String -> Bool
isTruncated w w' = null w && not (null w')
toBoolList :: [String] -> [Bool]
toBoolList y = zipWith isTruncated y ([]:y)
countChanged :: [Bool] -> Int
countChanged z = length (takeWhile not z)
createSecondLine :: [String] -> [String] -> [String]
createSecondLine x y = take (countChanged (toBoolList y)) t
where t = zipWith3 changeCell x y u
u = tail y ++ [[]]
lineN :: Int -> [[String]] -> [String]
lineN n xss = last $! take n xss
lineN' :: Int -> [[String]] -> [String]
lineN' n xss = last $! take (n-1) xss
createNthLine :: [[String]] -> Int -> [String]
createNthLine xss n | n < 1 || n > length xss = error "Undefined line!"
| n == 1 = head xss
| otherwise = createSecondLine (lineN' n xss) (lineN n xss)
fillEmptyCells :: [[String]] -> [[String]]
fillEmptyCells xss = map (createNthLine xss) [1..length xss]
changeNthLine :: [String] -> String
changeNthLine xs = "\"" ++ concatMap (++"\"->\"") xs ++ endOfLineGv
dropLast :: String -> String
dropLast xs | isWindows = if drop (length xs - 5) xs == "->\"\r\n"
then dropLast (take (length xs - 5) xs)
else xs ++ ";\r\n"
| drop (length xs - 4) xs == "->\"\n" = dropLast (take (length xs - 4) xs)
| otherwise = xs ++ ";\n"
dropDouble :: String -> String
dropDouble xs | length xs > 1 =
if head xs == '\"' && head (tail xs) == '\"'
then dropDouble (tail xs)
else head xs:dropDouble (tail xs)
| otherwise = xs
dropNull :: [String] -> [String]
dropNull = filter (not . null)
processCellsA :: String -> [[String]]
processCellsA = fillEmptyCells . cells
processCellsZ :: [[String]] -> String
processCellsZ = concatMap (dropDouble . dropLast . changeNthLine)
takeColumn :: Int -> [[String]] -> [String]
takeColumn n xss | if n < 1 then True else n > length (head xss) = error "Undefined column!"
| otherwise = map (head . drop (n-1)) xss
findLastX :: Int -> Int -> [[String]] -> String
findLastX n m xss | if m < 2 then True else m > length xss = error "Undefined column!"
| otherwise = last . dropNull . take (m - 1) $ takeColumn n xss
createNthLine2 :: [[String]] -> Int -> [String]
createNthLine2 x n | if n < 1 then True else n > length x = error "Undefined line!"
| n == 1 = dropNull . head $ x
| null . head . lineN n $ x = findLastX (length . takeWhile null . lineN n $ x) n x:dropNull (lineN n x)
| otherwise = dropNull (lineN n x)
fillEmptyCells2 :: [[String]] -> [[String]]
fillEmptyCells2 x = map (createNthLine2 x) (reverse [1..length x])
beginsWithAtSign :: String -> Bool
beginsWithAtSign xs | length xs < 2 = False
| head xs == '@' = True
| head xs == '\"' && (head . tail $ xs) == '@' = True
| otherwise = False
findFilledWithColor :: [[String]] -> [String]
findFilledWithColor = concatMap (filter beginsWithAtSign)
(+++) :: String -> String -> String -> String
(+++) x y z = x ++ y ++ z
endOfLineGv :: String
endOfLineGv | isWindows = "\r\n"
| otherwise = "\n"
makeFilledWithColor :: [String] -> String
makeFilledWithColor xs = concat (zipWith3 (+++) (repeat "\"") xs (repeat ("\" [style=filled, fillcolor=\"#ffffba\"];" ++ endOfLineGv)))
processCells :: String -> String
processCells = processCellsZ . fillEmptyCells2 . processCellsA
combineCells :: String -> String
combineCells x = let (y,z) = (x,x) in concat ["strict digraph 1 {", endOfLineGv, "overlap=false", endOfLineGv, processCells z,
makeFilledWithColor . findFilledWithColor . fillEmptyCells2 . processCellsA $ y, endOfLineGv, "}", endOfLineGv]
main :: IO ()
main = do
xs <- readFile "1.csv"
if length xs > 0
then do
putStrLn "Please, input the basic name of the visualization file!"
zs <- getLine
ts <- getCPUTime
let ys = combineCells xs in writeFile (show ts ++ "." ++ zs ++ ".gv") ys
renameFile "1.csv" (show ts ++ "." ++ zs ++ ".csv")
let x1 = showE "fdp"
x2 = showE "twopi"
x3 = showE "circo"
x4 = showE "neato"
x5 = showE "sfdp"
if foldl1 (&&) (map isJust [x1,x2,x3,x4,x5])
then do
putStrLn "Please, specify the GraphViz command: "
putStrLn "\'f\' -- for fdp"
putStrLn "\'t\' -- for twopi"
putStrLn "\'c\' -- for circo"
putStrLn "\'n\' -- for neato"
putStrLn "\'s\' -- for sfdp"
putStrLn "otherwise there will be used the default neato"
u <- getChar
let temp r = getBFst' (fromJust (showE "neato"), V.fromList (map (\(x, y) -> (x, fromJust y)) [('c', showE "circo"), ('f', showE "fdp"), ('n', showE "neato"), ('s', showE "sfdp"), ('t', showE "twopi")])) r
callCommand $ temp u ++ " -Tsvg " ++ show ts ++ "." ++ zs ++ ".gv -O "
else error "Please, install the GraphViz so that its executables are in the directories mentioned in the variable PATH!"
else error "Epmty file 1.csv!"