{-|
Module      : Main
Description : The "glue" between electronic tables and GraphViz
Copyright   : (c) OleksandrZhabenko, 2017-2019
License     : MIT
Maintainer  : olexandr543@yahoo.com
Stability   : experimental

The 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 @.svg@ format. The proper GraphViz installation is required.
-}

module Main (main) 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 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 xs ys zs | not . null $ ys = ys
                    | null ys && (not . null $ zs) = xs
                    | otherwise = []

isTruncated :: String -> String -> Bool
isTruncated ws vs = null ws && not (null vs)

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 | null xs = False
                    | length xs < 2 = False
                    | take 1 xs == "@" = True
                    | take 1 xs == "\"" && (drop 1 . take 2 $ xs) == "@" = True
                    | otherwise = False

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

{-| Usage
1. After installation the executable mmsyn4 is created. Afterwards, it is used to process files. So, open an office spreadsheet program, e. g. LibreOffice Calc.
2. Begin to enter the text in the cells. You can use Unicode characters. No quotation marks should be used, instead use some special delimiter except '@' sign.
3. Do not use colons, instead when needed switch to the nearest cell to the right. 
4. To make a text visually highlighted (yellowish), start the cell with an ’@’ sign.
5. Lines in the table create different chains in the resulting graph. To produce an arrow to the text in the cell, enter it in the next cell in the row to the right.
6. To make several arrows from the cell, switch to the next cell to the right for this parent one (the cell that will be a parent for several other cells), enter needed new texts there and in the located below cells.
7. Usually, you can search the needed text with Ctrl+F if needed.
8. Empty lines in the table do not influence the resulting visualization. Above each line, except the first one, there must be at least one filled cell. It must be located above the text on the new line or even further to the right above. Otherwise, the program will produce no reasonably useful output.
9. After entering all the text, export the sheet as an 1.csv file using colons (':') as separator in the working directory. Otherwise, the program won’t work.
10. Run the apprapriate executable mmsyn4 in the terminal or from the command line while being in the directory with the 1.csv file. Enter a word name of the .csv file to be saved. DO use alphanumeric symbols and dashes if needed. Then specify the needed visualization scheme by specifying the appropriate character in the terminal.
11. Your first visualization is then created. 
12. Save the spreadsheet document as a spreadsheet file.
13. Repeat the steps from 2 to 12 as needed to produce more visualizations. 
14. Afterwards, you have a list of svg files, a list of .gv files -- source files for Graphviz -- and a list of csv files, and a saved spreadsheet file. Then you can use the produced visualizations for some other documents.

-}
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
                  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\""
                  x2 <- getLine
                  let x0 = take 1 x2
                  putStrLn "Would you like to remove all \'@\' signs from the visualization file?"
                  remAt <- getLine
                  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!"

processFile :: Char -> Integer -> String -> IO ()
processFile w ts zs = do
  renameFile "1.csv" (show ts ++ "." ++ zs ++ ".csv")
  let x1 = showE "fdp"
      x2 = showE "twopi"
      x3 = showE "circo"
      x4 = showE "neato"
      x5 = showE "sfdp"
      x6 = showE "dot"
  if all isJust [x1,x2,x3,x4,x5,x6]
    then do
       putStrLn "Please, specify the GraphViz command: "
       putStrLn "\'d\' -- for dot"
       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 sfdp"
       vs <- getLine
       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"), ("s", showE "sfdp"), ("t", showE "twopi")])) in callCommand $ temp u ++ (if w == 'n' then " -Tsvg new." else " -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!"