|
definition:
|
runTool :: [String] -> [FunctionLayout] -> IO ()
runTool args fls = do
putStrLn toolBanner
(opts, prog) <- processOptions args
case prog of
[] -> putStrLn "No modules specified!\nUsage information: `--help'"
>> exitWith 1
ps -> do
mapM_ (runModuleAction (tryTransform opts) . stripCurrySuffix) ps
if optGenOpsFile opts
then do
putStrLn $ "\nGenerating parameterized read and write operations"
let generatedProg = generateOperations opts
modcmt = ["This module contains parameterized read/write operations",
"which allows to influence the form of generated",
"compact data (alphabet length, string length).\n"]
writeProg opts "." modcmt "" generatedProg
putStrLn $ "Generated module: " ++ show (progName generatedProg)
else return ()
where
tryTransform opts modname =
lookupModuleSourceInLoadPath modname >>=
maybe (putStrLn ("Module '" ++ modname ++ "' not found!") >> exitWith 1)
(\(dir,_) -> transform opts dir modname)
transform opts basedir modname = do
prog <- flatProgToAbstract <$> FCF.readFlatCurry modname
putStrLn $ "\nGenerating ReadWrite instances for '" ++ progName prog ++ "'"
let resultRWM = runRWM gen (Runtime (progName prog ++ "RW") fls prog [] [])
let generatedProg = fst resultRWM
let predefineds = map pre ["Int", "Float", "Char", "Bool", "[]", "Either",
"Maybe", "Ordering", "()", "(,)", "(,,)", "(,,,)"]
missing = (allDataUsed prog \\ allDataDefs prog) \\ predefineds
modcmt = ["This module has been generated by the tool `curry-rw-data`.",
"It contains instances of class `ReadWrite` for all types",
"defined in module `" ++ progName prog ++ "`.\n"]
warnopts = "-Wno-incomplete-patterns"
writeProg opts basedir modcmt warnopts generatedProg
putStrLn $ "ReadWrite instances generated for: " ++ ppData (allDataDefs prog)
putStrLn $ "Module 'RW.Base' defines instances for:\n" ++
ppData predefineds
unless (null missing) $
do putStrLn $
"\nMissing data definitions: " ++ show (ppData missing) ++
"\nPlease provide the definitions for the missing data types,\n" ++
"either by manually inserting them or by running this tool on\n" ++
"the following module(s) and then importing the resulting module(s):"
putStrLn $ " " ++ unwords (modules missing) ++ "\n"
let cfs = filter containsFunction (types prog)
unless (null cfs) $ putStrLn $
"Warning: The following data definitions contain function types: " ++
show (ppData $ map typeName cfs) ++
" Functions cannot be read or written."
unless (null $ getIllTypedDefinitions (snd resultRWM)) $ putStrLn $
"Warning: Typing of the following polymorphic type declarations " ++
"might be incomplete:\n" ++
show (intercalate ", " (getIllTypedDefinitions (snd resultRWM)))
mapM_ putStrLn (getErrors $ snd resultRWM)
-- Writes the generated program to a file.
-- For an input file path `a/b/foo.curry`, the output file will be
-- `a/b/fooRW.curry`.
writeProg opts basedir modcmt frontendopts p = do
let modids = splitModuleIdentifiers (progName p)
let fn = if null (optOutDir opts)
then (if basedir `elem` [".","./"] then id else (basedir </>))
(foldr1 (</>) modids ++ ".curry")
else optOutDir opts </> last modids ++ ".curry"
putStrLn $ "as module '" ++ progName p ++ "' stored in file '" ++
fn ++ "'..."
writeFile fn $
unlines (map ("-- "++) modcmt) ++
(if null frontendopts
then ""
else "{-# OPTIONS_FRONTEND " ++ frontendopts ++ " #-}\n\n") ++
showProg p ++ "\n"
ppData = intercalate ", " . map snd
-- 'setShowLocalSigs' is used to show the type signatures of local functions
-- in the generated RW module. This is necessary for 'typeOf'.
showProg = prettyCurryProg
(setNoQualification (setShowLocalSigs True defaultOptions))
|