{-|
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.
-}

{-# LANGUAGE CPP #-}

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 CaseBi (getBFst')
import qualified Data.Vector as V
import EndOfExe (showE)
import Data.Maybe (isJust,fromJust)

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

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:(if null ys then [""] else 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 -> V.Vector [String]
cells = V.map (divideString isSep) . V.fromList . dropEmptyLines . map (\rs -> if drop (length rs - 1) rs == "\r" then init rs else rs) . lines

processCells :: String -> V.Vector [String] -> String
processCells xs v = makeRecordGv xs . convertElemsToStringGv . filterNeeded . changeNeededCells $ v

processCellsG :: String -> String -> String
processCellsG xs = processCells xs . cells

-- | Do not change the lengths of element lists
changeNeededCells :: V.Vector [String] -> V.Vector [String]
changeNeededCells v = V.generate (V.length v) (\i -> changeLine i v)

-- | 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 'V.Vector'. 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 -> V.Vector [String] -> [String]
changeLine i v =
  let n = length . takeWhile null . V.unsafeIndex v $ i
      xs = parentCellContents n i v in if null xs then drop n . V.unsafeIndex v $ i else xs:(drop n . V.unsafeIndex v $ i)

parentCellContents :: Int -> Int -> V.Vector [String] -> String
parentCellContents n i v
 | n == 0 || i == 0 = []
 | otherwise = V.unsafeLast . V.filter (not . null) . (\v1 -> V.unsafeSlice 0 i v1) . V.map (!! (n - 1)) $ v

-- | Change the lengths of element lists by dropping the last empty strings in every element.
filterNeeded :: V.Vector [String] -> V.Vector [String]
filterNeeded = V.map (takeWhile (not . null))

-- | Makes conversion for every line 
convertElemsToStringGv :: V.Vector [String] -> V.Vector String
convertElemsToStringGv v = (V.map convertLineToStrGv v) V.++ (findAndMakeFilledWithClr v)

convertLineToStrGv :: [String] -> String
convertLineToStrGv xss = "\"" ++ (let ys = concatMap (++"\"->\"") xss in take (length ys - 3) ys) ++ endOfLineGv

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

findAndMakeFilledWithClr :: V.Vector [String] -> V.Vector String
findAndMakeFilledWithClr =
  V.singleton . concatMap (('\"':) . (++ "\" [style=filled, fillcolor=\"#ffffba\"];" ++ endOfLineGv)) . nub . mconcat . V.toList . V.map lineWithAtSign

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

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

-- | Makes all needed additions and synthesizes into a single String ready to be recorded to the .gv file.
makeRecordGv :: String -> V.Vector String -> String
makeRecordGv xs v = mconcat ["strict digraph 1 {", endOfLineGv, "overlap=false", endOfLineGv, "splines=",
  getBFst' ("true", V.fromList [("0", "false"), ("1", "true"), ("2", "ortho"), ("3", "polyline")]) xs, endOfLineGv,
    mconcat . V.toList $ v, "}", endOfLineGv]

-- | 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 text xxs yys bnames splines remAts
  | length text > 0 = do
      ts <- getCPUTime
      [bnames,splines] <- proc2Params2 bnames splines
      if remAts == "y"
        then do
          let ys = filter (/='@') . processCellsG splines $ text in writeFile (show ts ++ "." ++ bnames ++ ".gv") ys
          putStrLn "The visualization will be created without the at-sign."
          processFile 'n' ts bnames xxs yys
        else do
          let ys = processCellsG splines text in writeFile ("at." ++ show ts ++ "." ++ bnames ++ ".gv") ys
          putStrLn "The visualization will be created with the at-sign preserved."
          processFile 'a' ts bnames xxs yys
  | otherwise = error "Empty text to be processed! "

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 -> String -> String -> IO ()
processFile w t zs xxs yys = do
  if all (isJust . showE) ["fdp","twopi","circo","neato","sfdp","dot","patchwork","osage"]
    then processFile1 w t zs xxs yys
    else error "MMSyn4.processFile: Please, install the GraphViz so that its executables are in the directories mentioned in the variable PATH!"

processFile1 :: Char -> Integer -> String -> String -> String -> IO ()
processFile1 w t zs xxs yys = do
  [vs,spec] <- proc2Params xxs yys
  let u = take 1 vs
  if null u || u == "\n" || u == "\x0000"
    then error "MMSyn4.processFile1: 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 ++ " " else " -T" ++ q ++ " at.") ++ show t ++ "." ++ zs ++ ".gv -O "

proc2Params :: String -> String -> IO [String]
proc2Params xxs yys
 | null xxs = if null yys then mapM getFormat1 [1,2] else do { vs <- getFormat1 1 ; return [vs,yys] }
 | null yys = do { spec <- getFormat1 2 ; return [xxs,spec] }
 | otherwise = return [xxs,yys]

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

proc2Params2 :: String -> String -> IO [String]
proc2Params2 bnames splines
 | null bnames = if null splines then mapM procCtrl [1,2] else do { bnames <- procCtrl 1 ; return [bnames,splines] }
 | null splines = do { splines <- procCtrl 2 ; return [bnames,splines] }
 | otherwise = return [bnames,splines]

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 _ = specFormatFile

-- | 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 = getBFst' ("svg",V.fromList [("cm", "cmapx"),("do", "dot"),("fi", "fig"),("gi", "gif"),("im", "imap"),
  ("je", "jpeg"),("jp", "jpg"),("js", "json"),("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"),("jp", "jpg"),("js", "json"),("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)