FinalIO.hs

{-# LANGUAGE OverloadedStrings #-}

{-|
Module : FinalIO
Description : The Final Functions for the end user. Writes many files.
Copyright : (c) Hans-Jürgen Guth, 2014
License : LGPL
Maintainer : juergen.software@freea2a.de
Stability : experimental

This Functions generate the testcases as executables and as visualisation.
-}

module FinalIO (printTestcases, printTestgraph, printTestgraphP) where

import TestExplode.DirGraphCombine (VizGraph)
import TestExplode.TestExplode  (TGDocuInfo)

import Data.List

import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.GraphViz

import qualified Data.Text.Lazy as L

import System.IO
import System.Process
import System.Environment
import System.Directory

-- | Change this function, if you need or like
induvidualizeTestcase :: L.Text   -- ^ the filename of the testcase 
                         -> (Int, L.Text) -- ^ (number of the testcase, 
                                          --    testcase)
                         -> (Int, L.Text) -- ^ (number of the testcase,
                                          --    testcase with header and footer) 
induvidualizeTestcase  filename (n, str) =
    (n, L.concat["# Testcase ", L.pack (show n), "\n",
                 str,
                 L.pack "\ngenerate(\"",
                 filename, "_", L.pack (show n), ".ssd\");"])


-- | here you can change the extension of the filename of the testcase        
mkFile :: L.Text -> (Int, L.Text) -> IO ()  
mkFile filename (n, str) = do
    outFile <- openFile (L.unpack((L.concat[filename,"_", L.pack (show n), ".rb"]))) WriteMode
    hPutStr outFile (L.unpack str)
    hClose outFile   
    

-- | Takes the testcases in '[String]' and prints the
-- strings in a subdirectory called as the executable, which
-- calls this function, the name stripped after the first ".".    
printTestcases :: [L.Text] -> IO ()
printTestcases testcases = do 
    putStr $ show (length testcases) ++ " testcases\n"
    -- mapAccumL is a bit complicated,
    -- numberedTestcases is a structure of [(1, testcase 1), 
    --                                      (2, testcase 2),
    --                                       ..
    --                                      (n, testcase n)] 
    let numberedTestcases = snd $ mapAccumL (\ n str -> (n+1, (n,str))) 1 testcases
    testgraphnameCompl <- getProgName
    let testgraphname = L.pack $ takeWhile (/='.') testgraphnameCompl
    let idTestcases = map (induvidualizeTestcase testgraphname) numberedTestcases
    createDirectoryIfMissing False (L.unpack testgraphname)
    let testgraphpath = L.concat [testgraphname,"/",testgraphname]
    mapM_ (mkFile testgraphpath ) idTestcases

-- | Prints the testgraph as *.dot and *.svg  in the subdirectory  
printTestgraph :: GraphvizParams Node (Maybe a, Maybe TGDocuInfo) () () (Maybe a, Maybe TGDocuInfo) -- ^ The GraphvizParams
                 -> (VizGraph a) -- ^ The VizGraph as input
                 -> IO ()        -- ^ the result is 'IO'
printTestgraph view vizGraph = do
    let myVis = \graph -> graphToDot view graph
    let code = L.unpack $ printDotGraph (myVis vizGraph)
    testgraphnameCompl <- getProgName
    let testgraphname = fst $ span  (/='.') testgraphnameCompl
    let testgraphpath = testgraphname ++ "/" ++ testgraphname
    outGraphFile <- openFile (testgraphpath ++".dot") WriteMode
    hPutStr  outGraphFile code 
    hClose outGraphFile
    callCommand ( "dot -Tsvg -o " ++ testgraphpath ++".svg " ++
                                    testgraphpath ++".dot")
                                    
-- | prints the testgraph as *.dot and *.svg with name and path
printTestgraphP :: GraphvizParams Node (Maybe a, Maybe TGDocuInfo) () () (Maybe a, Maybe TGDocuInfo) -- ^ The GraphvizParams
                  -> (VizGraph a) -- ^ The VizGraph as input
                  -> String -- ^ the path to the file that shall be generated
                  -> String -- ^ the filename of the file that shall be generated
                  -> IO ()  -- ^ the result is 'IO'
printTestgraphP view vizGraph path name = do
    let myVis = \graph -> graphToDot view graph
    let code = L.unpack $ printDotGraph (myVis vizGraph)
    let testgraphpath = path ++ "/" ++ name
    createDirectoryIfMissing True path
    outGraphFile <- openFile (testgraphpath ++".dot") WriteMode
    hPutStr  outGraphFile code 
    hClose outGraphFile
    callCommand ( "dot -Tsvg -o " ++ testgraphpath ++".svg " ++
                                    testgraphpath ++".dot")