{- 

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 abstract
test-cases generated by the Combinations module 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 Sequenic.CTy.Concretization where

import Sequenic.CTy.Types
import Sequenic.CTy.Combinations
import qualified Data.Map as Map
import Data.List
import Data.Maybe

-- | Type to represent concrete test-value.

data TestValue = BOOL Bool
        | INT Int
        | FLOAT Float
        | DOUBLE Double
        | STRING String
        | INLINE String

-- | A common interface to translate a list of test-values to an API call
-- in some target language.

-- | 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 Translator t where
   -- | To translate a single test-value
   showParam   :: t -> TestValue -> String
   -- | To translate API-name and parameters' values to API call. The second string is
   -- an optional comment. 
   showAPIcall :: t -> String -> Maybe String -> [TestValue] -> String

   mkSuite :: t -> [String] -> String

   templateMarker :: t -> String

-- | Representing Haskell as the target language.   
data HaskellTranslator = HaskellTranslator

showNum x = if x<0 then "(" ++ show x ++ ")" else show x  

-- | The instantiation of the translator for Haskell.
instance Translator HaskellTranslator where
   showParam _ (BOOL x)   = show x
   showParam _ (INT x)    = showNum x
   showParam _ (FLOAT x)  = showNum x
   showParam _ (DOUBLE x) = showNum x
   showParam _ (STRING x) = show x
   showParam _ (INLINE x) = "(" ++ x ++ ")"

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

   templateMarker _ = "-- !!"

   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

-- | The type of the class mapping; it maps class-name to concrete value. The
-- tester has to provide this mapping in order to covert abstract test suite to
-- concrete one.
type ClassMapping  = [(Class,TestValue)]

-- Internal representation of the class mapping
type ClassMapping_ = Map.Map String TestValue

-- | Translate a test-case to an API call, and also produce comment.
--
translateTC :: Translator t => t -> ClassMapping_ -> APIName -> TestCase -> String
translateTC tr m api tc = showAPIcall tr api (Just comment) params
   where
   params = map f1 tc
   f1 (C_ _ classname) = m Map.! classname
   f2 (C_ _ classname) = classname
   comment = "Case " ++ (concat . intersperse ", " . map f2 $ tc)
   

-- will check if the class mapping is complete wrt the given classification tree
checkClassMapping :: CTree -> ClassMapping -> Bool
checkClassMapping ct m = classes1 `subsetOf` classes2
  where
  classes1 = concat . map getClasses $ ct
  classes2 = map fst m

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 :: Translator t => t -> String -> IO(String,String,String)
readTemplateFile tr fn = do {
      content <- readFile fn ;
      return . parseTemplateFile (templateMarker tr) $ content
   }


-- | This will produce the translation.
translate :: Translator t => t -> CTree -> ClassMapping -> Suite -> String -> String -> IO()
translate tr ct m suite templateFile outFile = do {
     (prefix,api,sufix) <- readTemplateFile tr templateFile ;
     case translate_ tr ct m suite api of
       Nothing         -> error "Class mapping is incomplete."
       Just translated -> do {
         writeFile outFile prefix ;
         appendFile outFile translated ;
         appendFile outFile sufix 
       }
   }


translate_ :: Translator t => t -> CTree -> ClassMapping -> Suite -> APIName -> Maybe String
translate_ tr ct m suite api 
    = 
    case checkClassMapping ct m of
      True  -> Just . mkSuite tr . map (translateTC tr mapping api) $ suite 
      False -> Nothing
    where
    mapping :: Map.Map String TestValue
    mapping = Map.fromList m


-- example

ctx0 :: CTree
ctx0 = [ "Income"       <== ["negative income", "very small income", "small income"],
         "Monthly Cost" <== ["negative cost", "positive cost"], 
         "Wage Type"    <== ["wage labor", "self employed"] ]


suite0 = fullComb ctx0
suite1 = minComb ctx0
   
ctxMapping = [ "negative income"   --> INT (-10),
               "very small income" --> INT 10,
               "small income"      --> INT 10000,
               "wage labor"        --> BOOL True,
               "self employed"     --> BOOL False,
               "negative cost"     --> INT (-10),
               "positive cost"     --> INT 100 ]
  
dirx = "d:/workshop/projects/cty/v1/src/sequenic/cty/"

genCtx01 = translate HaskellTranslator ctx0 ctxMapping suite1 
                     (dirx ++ "Template.hsx")
                     (dirx ++ "Template.hs")