{- 

Author: Wishnu Prasetya

Copyright 2010 Wishnu Prasetya

The use of this sofware is free under the GNU General Public License
(GPL) version 3.

-}

{- | This module provides the utitlity to translate a test-suite 
generated by CTy to concrete test-cases in some target language. 

Since this translation depends on the target language, the translator
takes an option representing the choice of the target language. This
is implemented via a class, that provides several functions
representing the parts of the translation that are target-language
dependent. To make a translator to language X, we instantiate these
functions for X.

-}

module CTy.Concretization where

import CTy.CRule
import CTy.TestVal
import CTy.DSL
import CTy.TCgen
import qualified Data.Map as Map
import Data.List
import Data.Maybe

-- | A class, providing a common interface towards different parts of the translator
-- which are language dependent. The type t here represents the choice of the target
-- language.
class TargetLang targetLang where

   langName :: targetLang -> String

   -- | To translate a single test-value
   showParam  :: targetLang -> TestVal -> String
   -- | To translate API-name and parameters' values to API call. The second string is
   -- an optional comment. 
   showAPIcall :: targetLang -> String -> Maybe String -> [TestVal] -> String

   mkModuleHeader :: targetLang -> String -> String

   mkSuite :: targetLang -> [String] -> String

   templateMarker :: targetLang -> String

-- | Representing Haskell as the target language.   
data HaskellTargetLang = HaskellTargetLang deriving Show

-- | The instantiation of the translator for Haskell.
instance TargetLang HaskellTargetLang where

   langName _ = "Haskell"

   showParam _ v = "(" ++ tv2haskell v ++ ")"

   showAPIcall _ fname comment params 
             = 
             "TestCase (assertEqual  " ++ show comment_
             ++ "\n            (" ++ fname ++ "  "  ++ params_ ++ ")"
             ++ "\n            undefined"
             ++ "\n            )"
       where
       params_  = concat . intersperse "  " . map (showParam HaskellTargetLang) $ params
       comment_ = if isNothing comment then "<description>" else fromJust comment 

   templateMarker _ = "-- !!"

   mkModuleHeader _ moduleName = "module " ++ moduleName ++ " where\n\n"

   mkSuite _ testcases = "-- start generated code" 
                         ++ (concat . map f $ (zip [1..] testcases))
                         ++
                         "\n\n-- to run the whole suite do: runTestTT suite \n\n" ++ suitecall 
                         ++ "\n\n-- end generated code"
      where
      f (k,tc)  = "\n\ntc" ++ show k ++ "  =  " ++ tc
      suitecall =  "suite  =  TestList ["  ++ (concat . intersperse ", " . map g $ [1..(length testcases)]) ++ "]"
          where
          g k = "tc" ++ show k

type APIName = String

-- | Translate a test-case to an API call, and also produce comment. 
-- We assume the test-case is complete, is in the correct order,
-- and has been stripped.
--
translateTC :: TargetLang tlang => tlang -> APIName -> [(String,TestVal)] -> String
translateTC tlang api tc = showAPIcall tlang api (Just comment) params
   where
   params  = map snd tc
   comment = "** Case " ++ (concat . intersperse ", " . map fst $ tc)


parseTemplateFile marker s = (prefix,apiName,sufix)
   where
   apiName = getAPIname rest 
   (prefix,rest) = getPrefix s
   sufix = dropWhile (not . isNewLine) . drop (length marker + length apiName) $ rest
   getPrefix [] = ("","")
   getPrefix s@(x:t) = 
      if marker `isPrefixOf` s then ("",s) else (x:p,r)
      where
      (p,r) = getPrefix t 

   getAPIname s = takeWhile (not . isWhite) . drop (length marker) $ s

   isWhite c   = c `elem` " \t\n"
   isNewLine c = c == '\n'

readTemplateFile :: TargetLang t => t -> String -> IO(String,String,String)
readTemplateFile tlang fn = do {
      content <- readFile fn ;
      return . parseTemplateFile (templateMarker tlang) $ content
   }

-- | This will produce the translation.
translate :: TargetLang tlang => tlang -> [[(String,TestVal)]] -> String -> String -> String -> IO()
translate tlang suite templateFile outFile moduleName = do {
     putStrLn "" ;
     putStrLn ("** #Suite : " ++ show (length suite)) ;
     putStrLn ("** Target language : " ++ langName tlang) ;
     (prefix,api,sufix) <- readTemplateFile tlang templateFile ;
     translated <- return (translate_ tlang suite api) ;
     writeFile outFile (mkModuleHeader tlang moduleName) ;
     appendFile outFile prefix ;
     appendFile outFile translated ;
     appendFile outFile sufix ;
     putStrLn ("** Done. Saved in  : " ++ outFile) ;
     putStrLn "" 
   }


translate_ :: TargetLang tlang => tlang -> [[(String,TestVal)]] -> APIName -> String
translate_ tlang suite api 
    = 
    mkSuite tlang . map (translateTC tlang api) $ suite 

--
-- example

suiteEx8cc = ex01 $$ rule (incl ["kid1"] &&* incl "insType")
                   >>= paddingf
                   >>= psort
                   >>= lift_ . take 3
                   >>= fixorder
                   >>= lift_ . strip2

dirx = "d:/workshop/PROJECTS/CTy/v2/src/CTy/"

genEx8cc = translate HaskellTargetLang suiteEx8cc 
		(dirx ++ "TemplateExample0")
		(dirx ++  "Example0Test.hs")
		 "CTy.Example0Test"