{-|
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 teble 
into a visualized by GraphViz graph in the one of the supported by GraphViz graphics format. The proper GraphViz installation is required.
-}

module MMSyn4 (isWindows,process2) where

import Data.List (nub)
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 = (== ':')

-- | Returns @True@ if OS is Windows.
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 (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
 | otherwise = ys:dropEmptyLines yss

cells :: String -> [[String]]
cells = map (divideString isSep) . dropEmptyLines . lines

changeCell :: String -> String -> String -> String
changeCell xs ys zs
 | null zs = ys
 | otherwise = xs

isTruncated :: String -> String -> Bool
isTruncated [] (v:_) = True
isTruncated _ _ = False

toBoolList :: [String] -> [Bool]
toBoolList yss = zipWith isTruncated yss ([]:yss)

countChanged :: [Bool] -> Int
countChanged z = length (takeWhile not z)

createSecondLine :: [String] -> [String] -> [String]
createSecondLine xss yss = take (countChanged (toBoolList yss)) tss
   where tss = zipWith3 changeCell xss yss uss
         uss = tail yss ++ [""]

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 = concat . take 1 $ 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 (x:y:xs)
 | x == '\"' && y == '\"' = dropDouble (y:xs)
 | otherwise = x:dropDouble (y:xs)
dropDouble xs = xs

dropNull :: [String] -> [String]
dropNull = filter (not . null)

processCellsA :: String -> [[String]]
processCellsA = fillEmptyCells . cells

processCellsZ :: [[String]] -> [String]
processCellsZ = map (dropDouble . dropLast . changeNthLine)

takeColumn :: Int -> [[String]] -> [String]
takeColumn n xss
 | null xss = error "Empty list in takeColumn!"
 | if n < 1 then True else n > (length . head $ xss) = error "Undefined column!"
 | otherwise = map (concat . take 1 . drop (n-1)) xss

-- | m is a column number of the cell, which 'findParentCell' function returns, n is a line number of the cell, which calls 'findParentCell' function
findParentCell :: Int -> Int -> [[String]] -> String
findParentCell m n xss
 | if n < 2 then True else n > length xss = error "Undefined column!"
 | otherwise = last . dropNull . take (n - 1) . takeColumn m $ 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 = findParentCell (length . takeWhile null . lineN n $ x) n x:dropNull (lineN n x)
 | otherwise = dropNull (lineN n x)

fillEmptyCells2 :: [[String]] -> [[String]]
fillEmptyCells2 xss = map (createNthLine2 xss) [length xss,length xss - 1..1]

beginsWithAtSign :: String -> Bool
beginsWithAtSign xs = if take 1 xs == "@" then True else take 2 xs == "\"@"

findFilledWithColor :: [[String]] -> [String]
findFilledWithColor = concatMap (filter beginsWithAtSign)

endOfLineGv :: String
endOfLineGv | isWindows = "\r\n"
            | otherwise = "\n"

makeFilledWithColor :: [String] -> String
makeFilledWithColor xss = concat (nub . zipWith (++) xss $ (repeat (" [style=filled, fillcolor=\"#ffffba\"];" ++ endOfLineGv)))

processCells :: String -> String
processCells = concat . nub . processCellsZ . fillEmptyCells2 . processCellsA

combineCells :: String -> String -> String
combineCells x0 x = let (y,z) = (x,x) in concat ["strict digraph 1 {", endOfLineGv, "overlap=false", endOfLineGv, "splines=",
  getBFst' ("true", V.fromList [("0", "false"), ("1", "true"), ("2", "ortho"), ("3", "polyline")]) x0, endOfLineGv, processCells z,
    makeFilledWithColor . findFilledWithColor . fillEmptyCells2 . processCellsA $ y, endOfLineGv, "}", endOfLineGv]

-- | Process a \"1.csv\" file. 
process2 :: IO ()
process2 = do
  xs <- readFile "1.csv"
  if length xs > 0
    then do
      ts <- getCPUTime
      [zs,x2,remAt] <- processCtrl
      let x0 = take 1 x2
      if take 1 remAt == "y"
        then do
          let ys = filter (/='@') . combineCells x0 $ xs in writeFile ("new." ++ show ts ++ "." ++ zs ++ ".gv") ys
          putStrLn "The visualization will be created without the at-sign."
          processFile 'n' ts zs
          removeFile $ show ts ++ "." ++ zs ++ ".csv"
        else do
          let ys = combineCells x0 xs in writeFile (show ts ++ "." ++ zs ++ ".gv") ys
          putStrLn "The visualization will be created with the at-sign preserved."
          processFile 'a' ts zs
    else error "Epmty file 1.csv!"

processCtrl :: IO [String]
processCtrl = mapM procCtrl [1..3]

procCtrl :: Int -> IO String
procCtrl 1 = putStrLn "Please, input the basic name of the visualization file!" >> getLine
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\""
  putStrLn "2 -- for \"splines=ortho\""
  putStrLn "3 -- for \"splines=polyline\""
  putStrLn "The default one is \"splines=true\""
  getLine
procCtrl _ = putStrLn "Would you like to remove all \'@\' signs from the visualization file?" >> getLine

processFile :: Char -> Integer -> String -> IO ()
processFile w ts zs = do
  renameFile "1.csv" (show ts ++ "." ++ zs ++ ".csv")
  if all (isJust . showE) ["fdp","twopi","circo","neato","sfdp","dot","patchwork","osage"]
    then 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"
       [vs,spec] <- mapM getFormat1 [1,2]
       let u = take 1 vs in if null u || u == "\n" || u == "\x0000"
         then error "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
           callCommand $ temp u ++ (if w == 'n' then " -T" ++ q ++ " new." else " -T" ++ q ++ " ") ++ show ts ++ "." ++ zs ++ ".gv -O "
    else error "Please, install the GraphViz so that its executables are in the directories mentioned in the variable PATH!"

specFormatFile :: IO String
specFormatFile = do
  putStrLn "Please, specify the GraphViz output format for the file: "
  mapM_ printFormF ["do", "xd", "ps", "pd", "sv", "sz", "fi", "pn", "gi", "jp", "je", "js", "im", "cm"]
  putStrLn "otherwise there will be used the default -Tsvg"
  getLine

getFormat1 :: Int -> IO String
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 2 = specFormatFile

getFormat :: String -> String
getFormat = getBFst' ("svg",V.fromList [("cm", "cmapx"),("do", "dot"),("fi", "fig"),("gi", "gif"),("im", "imap"),
  ("je", "jpeg"),("js", "json"),("jp", "jpg"),("pd", "pdf"),("pn", "png"),("ps", "ps"),("sv", "svg"),("sz", "svgz"),("xd", "xdot")])

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"),("js", "json"),("jp", "jpg"),("pd", "pdf"),("pn", "png"),("ps", "ps"),("sv", "svg"),("sz", "svgz"),("xd", "xdot")]) xs ++ "\""

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)