module Generation.OutputGenerator(
GenerationFunction
, generateJSServer
, generateJSClient
, generatePythonClient
, generateJavaClient )
where
import Control.Monad
import Data.List
import qualified Data.Text.Lazy.IO as TL
import qualified Generation.ServiceGenerator as SG
import qualified Generation.TemplateCompiler as TC
import Paths_harmony
import System.Directory
import System.Exit (ExitCode (..))
import System.Log.Formatter ()
import System.Log.Handler ()
import System.Log.Handler.Simple ()
import System.Log.Handler.Syslog ()
import System.Log.Logger
import System.Process (system)
import qualified TypeCheck.ApiSpec as AS
type TemplateInfo = (FilePath, String)
type GenerationInfo = ([FilePath], [TemplateInfo], AS.Type -> String, AS.Type -> String)
type GenerationFunction = FilePath
-> AS.ApiSpec
-> IO ()
generateJSServer, generateJSClient, generatePythonClient, generateJavaClient :: GenerationFunction
generateJSServer = generateOutput (files, templates, fieldMapping, fieldMappingBoxedType) postOpFunc
where
files = [ ]
templates = [ ("templates/server/js/server.tpl", "js")
, ("templates/server/js/package.tpl", "json")
]
fieldMapping AS.TString = "String"
fieldMapping AS.TLong = "Number"
fieldMapping AS.TInt = "Number"
fieldMapping AS.TDouble = "Number"
fieldMapping (AS.TEnum _) = "String"
fieldMapping (AS.TStruct t) = t
fieldMapping (AS.TList t) = fieldMapping t
fieldMapping other = error $ "Javascript server generation: Type not recognized -> " ++ show other
fieldMappingBoxedType _ = error "generateJSServer: Javascript has no boxed types"
generateJSClient = error "Javascript client is not implemented yet"
generatePythonClient = generateOutput (files, templates, fieldMapping, fieldMappingBoxedType) postOpFunc
where
files = []
templates = [ ("templates/client/python/client.tpl", "py")
, ("templates/client/python/test.tpl", "py")
]
fieldMapping AS.TString = "strategy([strategy(integers_in_range(65,90)) | strategy(integers_in_range(97, 122))]).map(lambda l: map(chr, l)).map(lambda l: ''.join(l))"
fieldMapping AS.TInt = "integers_in_range(-1000,1000)"
fieldMapping AS.TLong = "integers_in_range(-1000,1000)"
fieldMapping AS.TDouble = "error:PythonNoTypes (Double)"
fieldMapping (AS.TEnum _) = "error: no directly translation from enum type to Hypothesis type"
fieldMapping (AS.TStruct name) = name ++ "Data"
fieldMapping (AS.TList t) = "[" ++ fieldMapping t ++ "]"
fieldMapping other = error $ "Python client generation: Type not recognized -> " ++ show other
fieldMappingBoxedType _ = error "generatePythonClient: Python has no boxed types"
generateJavaClient = generateOutput (files, templates, fieldMapping, fieldMappingBoxedType) postOpFunc
where
files = [ "templates/client/java/pom.xml"
, "templates/client/java/src/main/java/com/prototype/NetworkClient.java"
]
templates = [ ("templates/client/java/src/main/java/com/prototype/ServiceClient.tpl", "java") ]
fieldMapping AS.TString = "String"
fieldMapping AS.TInt = "int"
fieldMapping AS.TLong = "long"
fieldMapping AS.TDouble = "double"
fieldMapping (AS.TEnum enumName) = enumName
fieldMapping (AS.TStruct strName) = strName
fieldMapping (AS.TList t) = fieldMapping t
fieldMapping other = error $ "Java client generation: Type not recognized -> " ++ show other
fieldMappingBoxedType AS.TString = "String"
fieldMappingBoxedType AS.TInt = "Integer"
fieldMappingBoxedType AS.TLong = "Long"
fieldMappingBoxedType AS.TDouble = "Double"
fieldMappingBoxedType (AS.TEnum enumName) = enumName
fieldMappingBoxedType (AS.TStruct strName) = strName
fieldMappingBoxedType (AS.TList t) = "List<" ++ fieldMappingBoxedType t ++ ">"
fieldMappingBoxedType other = error $ "Java client generation: Boxed type not recognized -> " ++ show other
postOpFunc :: String -> FilePath -> IO ()
postOpFunc "js" = applyJsBeautify
postOpFunc "py" = applyYapf
postOpFunc "java" = removeUselessCommasAndApplyAStyle
postOpFunc _ = \_ -> return ()
applyJsBeautify :: FilePath -> IO ()
applyJsBeautify path = do
infoM "Generation.OutputGenerator" $ "Applying js-beautifier to " ++ path
outcome <- system $ "js-beautify " ++ path ++ " > tempfile && cat tempfile > " ++ path ++ " && rm tempfile"
case outcome of
ExitSuccess -> return ()
(ExitFailure _) ->
warningM "Generation.OutputGenerator" $ "There was a problem applying the Javascript beautifier, "
++ "please check it is installed and in the system's path (if "
++ "you ignore this message the Python generated files will not be properly formatted)."
applyYapf :: FilePath -> IO ()
applyYapf path = do
infoM "Generation.OutputGenerator" $ "Applying yapf to " ++ path
outcome <- system $ "yapf " ++ path ++ " > tempfile && cat tempfile > " ++ path ++ " && rm tempfile"
case outcome of
ExitSuccess -> return ()
(ExitFailure _) ->
warningM "Generation.OutputGenerator" $ "There was a problem applying the Python beautifier, "
++ "please check it is installed and in the system's path (if "
++ "you ignore this message the Python generated files will not be properly formatted)."
removeUselessCommasAndApplyAStyle :: FilePath -> IO ()
removeUselessCommasAndApplyAStyle path = do
infoM "Generation.OutputGenerator" $ "Postprocessing " ++ path
removeCommas <- system $ "sed 's/,[^,]*) {.*$/\\) {/' "
++ path ++ " > tempFile && cat tempFile > "
++ path ++ " && rm tempFile"
case removeCommas of
ExitSuccess -> return ()
(ExitFailure _) ->
error $ "Unable to apply Java postprocessing, please"
++ " open an issue in www.github.com/SantiMunin/harmony/issues"
removeCommas2 <- system $ "sed 's/, *\\().*\\)$/\\1/' "
++ path ++ " > tempFile && cat tempFile > "
++ path ++ " && rm tempFile"
case removeCommas2 of
ExitSuccess -> return ()
(ExitFailure _) ->
error $ "Unable to apply Java postprocessing, please"
++ " open an issue in www.github.com/SantiMunin/harmony/issues"
infoM "Generation.OutputGenerator" $ "Applying astyle to " ++ path
outcome <- system $ "astyle " ++ path
case outcome of
ExitSuccess -> return ()
(ExitFailure _) ->
warningM "Generation.OutputGenerator" $ "There was a problem applying the Java beautifier, "
++ "please check it is installed and in the system's path (if "
++ "you ignore this message the Java generated files will not be properly formatted)."
generateOutput :: GenerationInfo
-> (String -> FilePath -> IO ())
-> FilePath
-> AS.ApiSpec
-> IO ()
generateOutput (files, templates, fieldMapping, fieldMappingBoxedType) postOpFunc outputPath apiSpec = do
updateGlobalLogger "Generation.OutputGenerator" (setLevel INFO)
forM_ files (`copy` outputPath)
forM_ templates (generateAndWrite outputPath (SG.generateService apiSpec fieldMapping fieldMappingBoxedType) postOpFunc)
copy :: FilePath
-> FilePath
-> IO ()
copy origin dest = do
let destFile = dest ++ dropWhile (/= '/') origin
let destDir = dirName destFile
infoM "Generation.OutputGenerator" $ "Copying " ++ show destFile
cabalFilePath <- getDataFileName origin
createDirectoryIfMissing True destDir
copyFile cabalFilePath destFile
dirName :: FilePath -> FilePath
dirName file = let indices = elemIndices '/' file
in if null indices then "." else take (last indices + 1) file
generateAndWrite :: FilePath
-> TC.Service
-> (String -> FilePath -> IO ())
-> TemplateInfo
-> IO ()
generateAndWrite dest service postOpFunc (templatePath, newExt) = do
infoM "Generation.OutputGenerator" $ "Creating " ++ show destFile
output <- TC.render templatePath service
createDirectoryIfMissing True destDir
TL.writeFile destFile output
postOpFunc newExt destFile
where
destFileWithoutExt = dest ++ takeWhile (/= '.') (dropWhile (/= '/') templatePath)
destDir = dirName destFile
destFile = destFileWithoutExt ++ "." ++ newExt