Commit f4e5e067 authored by Michael Hanus 's avatar Michael Hanus

Add HTML.Base.formDef and add form IDs by curry2cgi

parent 62b0f3ae
......@@ -4,7 +4,8 @@ Some implementation details
This small document describes a few details about the implementation
of web forms used in this package.
The basic idea is to combine the actions generating the HTML page
The basic idea of this approach to dynamic web page programming
is to combine the actions generating the HTML page
containing the source of the forms with the event handlers processing
a submitted form in one program (see the various examples
in directory `examples`). This has the advantage that input
......@@ -16,7 +17,7 @@ features of Curry and is explained in detail in
This idea is implemented by starting the same executable for
generating and processing a form. Therefore, the `action`
attribute of a form occurring in a web page has the same URL
attribute of each form occurring in a web page has the same URL
as the original page, i.e., each form has the structure
<form method="post" action="?">
......@@ -66,4 +67,28 @@ of these imported modules must be passed to `curry2cgi`
to the generated main program. In this case, `curry2cgi` also
collects the forms in the provided imported modules.
To speed up this process for larger applications, `curry2cgi`
caches the form names of a module `M` in file `.curry/M.htmlforms`.
\ No newline at end of file
caches the form names of a module `M` in file `.curry/M.htmlforms`.
The program `curry2cgi` (implemented in `scripts/Curry2CGI.curry`)
works as follows. For each module `m` containing form definitions
do the following:
1. Read the AbstractCurry representation of `m` and collect
all public form definitions contained in `m`.
2. Generate a simple Curry program which checks whether the form IDs
are identical to the qualified names of the operations defining
the form IDs.
3. If some form IDs are not correct, transform the FlatCurry program
(in case of KiCS2, the Typed FlatCurry program) of `m` so that
correct form IDs are set in the transformed program.
After this phase, pre-compile the main module so that all
(Typed) FlatCurry files are generated. Then copy the transformed
programs into the original programs and compile the main module.
*Important note:*
Due to a problem in the front end (which unecessarily re-compiles
TypedFlatCurry files used by KiCS2), the transformation of
TypedFlatCurry programs do not always work with KiCS2.
......@@ -22,13 +22,35 @@ A form inside a web page must be defined as a
myForm = formDefWithID "Module.myForm" readData viewData
The first argument of a form definition must be the qualified name
of the operation (this will be checked by `curry2cgi`).
of the operation (this will be checked by the script `curry2cgi`
which is used to install such web scripts as CGI executables).
The second argument is an IO action to read some data
used in the form, and the third argument is the actual view
of the form which usually contains buttons with event handlers
that are invoked when a form is submitted.
For convencience, there is also the form constructor `formDef`
where the ID argument can be omitted:
myForm :: HtmlFormDef String
myForm = formDef readData viewData
If this constructor is used, the script `curry2cgi` automatically
transforms the intermediate FlatCurry program such that the correct
form ID is added.
Some simple examples for dynamic web pages can be found in the
directory `examples`.
--------------------------------------------------------------------------
Known bugs:
The automatic addition of form IDs with the script `curry2cgi`
does not work completely with KiCS2 due to a problem in the front end
which unecessarily re-compiles TypedFlatCurry files used by KiCS2.
Thus, it is safer (and more efficient) to use `formDefWithID`
to define forms.
--------------------------------------------------------------------------
......@@ -12,10 +12,10 @@ import HTML.Session
--- The data stored in the session is the number of guesses.
guessNr :: Global (SessionStore Int)
guessNr = global emptySessionStore (Persistent "guessNr")
guessNr = global emptySessionStore (Persistent (inSessionDataDir "guessNr"))
guessInputForm :: HtmlFormDef Int
guessInputForm = formDefWithID "Guess.guessInputForm" readGuesses formHtml
guessInputForm = formDef readGuesses formHtml
where
readGuesses = getSessionData guessNr 0 -- read session data
......
......@@ -7,7 +7,7 @@ import HTML.Base
-- Example: a form with a text input field and two submit buttons.
redirectForm :: HtmlFormDef String
redirectForm = formDefWithID "Redirect.redirectForm" (return "") formHtml
redirectForm = formDef (return "") formHtml
where
formHtml _ =
[ htxt "Enter a URL: ", textField ref "http://www.google.com"
......
......@@ -8,7 +8,7 @@ import HTML.Base
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = formDefWithID "RevDup.revDupForm" (return "") formHtml
revDupForm = formDef (return "") formHtml
where
formHtml _ =
[ htxt "Enter a string: ", textField ref ""
......
......@@ -6,7 +6,6 @@
-- field in order to use it for the subsequent form.
------------------------------------------------------------------------------
import FilePath ( (</>) )
import Global
import HTML.Base
......@@ -14,11 +13,11 @@ import HTML.Session
--- The data stored in a session is the string typed into the input field.
rdInput :: Global (SessionStore String)
rdInput = global emptySessionStore (Persistent ("." </> "rdInput"))
rdInput = global emptySessionStore (Persistent (inSessionDataDir "rdInput"))
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = formDefWithID "RevDupSession.revDupForm" readInfo formHtml
revDupForm = formDef readInfo formHtml
where
readInfo = getSessionData rdInput ""
......
......@@ -12,7 +12,7 @@ import TimeForm ( timeForm )
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = formDefWithID "RevDupTime.revDupForm" (return "") formHtml
revDupForm = formDef (return "") formHtml
where
formHtml _ =
[ htxt "Enter a string: ", textField ref ""
......
......@@ -8,7 +8,7 @@ import HTML.Base
-- Example: a form with button to show the current time.
timeForm :: HtmlFormDef String
timeForm = formDefWithID "TimeForm.timeForm" (return "") formHtml
timeForm = formDef (return "") formHtml
where
formHtml _ = [ button "Show time" timeHandler ]
where
......
{
"name": "html2",
"version": "0.0.1",
"version": "0.1.0",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Libraries for HTML programming with event-handler-based form processing",
"category": [ "Web" ],
"dependencies": {
"base" : ">= 1.0.0, < 2.0.0",
"abstract-curry": ">= 2.0.0",
"cryptohash" : ">= 0.0.1",
"currypath" : ">= 0.0.1",
"random" : ">= 0.0.1"
"base" : ">= 1.0.0, < 2.0.0",
"abstract-curry" : ">= 2.0.0",
"cryptohash" : ">= 0.0.1",
"currypath" : ">= 0.0.1",
"flatcurry" : ">= 2.0.0",
"flatcurry-annotated": ">= 2.0.0",
"random" : ">= 0.0.1"
},
"sourceDirs": [ "src", "scripts" ],
"exportedModules": [ "HTML.Base",
......@@ -17,8 +19,8 @@
"HTML.Parser", "HTML.Session",
"HTML.Styles.Bootstrap3", "HTML.Styles.Bootstrap4" ],
"compilerCompatibility": {
"pakcs": ">= 2.0.0",
"kics2": ">= 2.0.0"
"pakcs": ">= 2.0.0, < 3.0.0",
"kics2": ">= 2.0.0, < 3.0.0"
},
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
......
------------------------------------------------------------------------------
--- Compute infos about all `HtmlFormDef` operations occurring in a module.
--- Compute infos about all `HtmlFormDef` operations occurring in a module
--- and transform FlatCurry programs by setting correct form IDs, if
--- necessary.
---
--- @author Michael Hanus
--- @version March 2020
--- @version August 2020
------------------------------------------------------------------------------
module ExtractForms ( extractFormsInProg, showQName )
module C2C.ExtractForms ( extractFormsInProg )
where
import Directory ( doesFileExist, getModificationTime )
......@@ -16,8 +18,11 @@ import System ( exitWith, getArgs, getPID, system )
import AbstractCurry.Files
import AbstractCurry.Select
import AbstractCurry.Types
import System.CurryPath ( inCurrySubdir, lookupModuleSourceInLoadPath
, stripCurrySuffix )
import System.CurryPath ( inCurrySubdir, lookupModuleSourceInLoadPath )
import C2C.Options
import C2C.TransFlatCurryForms ( setFormIDsInFlatCurry )
import C2C.TransTypedFlatCurryForms ( setFormIDsInTypedFlatCurry )
-- The cache file for storing qualified form names of a module w.r.t.
-- a directory.
......@@ -26,8 +31,8 @@ formCacheFile mdir mname = inCurrySubdir (mdir </> mname) <.> "htmlforms"
--- Extract and check all forms defined in a Curry module (third argument).
--- Returns the qualified names of the exported forms.
extractFormsInProg :: Int -> String -> String -> IO [QName]
extractFormsInProg verb curryroot mname =
extractFormsInProg :: Options -> String -> IO (Maybe String, [QName])
extractFormsInProg opts mname =
lookupModuleSourceInLoadPath mname >>=
maybe (error $ "Module '" ++ mname ++ "' not found in load path!")
extractWithFormCache
......@@ -36,34 +41,36 @@ extractFormsInProg verb curryroot mname =
let formfile = formCacheFile mdir mname
ffexists <- doesFileExist formfile
if not ffexists
then readFormsInProg verb curryroot mname formfile
then readFormsInProg opts mname formfile
else do
ctime <- getModificationTime mfile
ftime <- getModificationTime formfile
if ctime>ftime
then readFormsInProg verb curryroot mname formfile
if ctime > ftime
then readFormsInProg opts mname formfile
else do
when (verb>1) $ putStrLn $ "Reading file '" ++ formfile ++ "'"
putStrLnInter opts $ "Reading file '" ++ formfile ++ "'"
readFile formfile >>= return . read
readFormsInProg :: Int -> String -> String -> String -> IO [QName]
readFormsInProg verb curryroot mname formfile = do
unless (verb==0) $ putStrLn $
readFormsInProg :: Options -> String -> String -> IO (Maybe String, [QName])
readFormsInProg opts mname formfile = do
putStrLnInfo opts $
"Extracting and checking forms contained in module '" ++ mname ++ "'..."
when (verb>1) $ putStr $ "Reading module '" ++ mname ++ "'..."
when (optVerb opts > 1) $ putStr $ "Reading module '" ++ mname ++ "'..."
cprog <- readCurry mname
when (verb>1) $ putStrLn "done!"
putStrLnInter opts "done!"
let (formnames,privatenames) = extractFormOps cprog
unless (null privatenames) $ putStrLn $
"WARNING: Private form operations found (and not translated):\n" ++
unwords (map snd privatenames)
unless (verb==0 || null formnames) $ putStrLn $
unless (null formnames) $ putStrLnIfNQ opts $
"Form operations found: " ++ unwords (map snd formnames)
unless (null formnames) $ checkFormIDsInProg verb curryroot mname formnames
when (verb>1) $ putStrLn $ "Writing form names to '" ++ formfile ++ "'"
mbtrans <- if null formnames
then return Nothing
else checkFormIDsInProg opts mname formnames
putStrLnInter opts $ "Writing form names to '" ++ formfile ++ "'"
-- store form names in form cache file:
catch (writeFile formfile (show formnames)) (const done)
return formnames
catch (writeFile formfile (show (mbtrans, formnames))) (const done)
return (mbtrans, formnames)
--- Extract public and private form definitions from a program.
extractFormOps :: CurryProg -> ([QName], [QName])
......@@ -73,19 +80,40 @@ extractFormOps prog =
in (map funcName fds1, map funcName fds2)
where
hasFormDefType fdecl = case typeOfQualType (funcType fdecl) of
CTApply (CTCons tc) _ -> tc == ("HTML.Base","HtmlFormDef")
CTApply (CTCons tc) _ -> tc == formDefTypeName
_ -> False
-- Test whether all `HtmlFormDef` identifiers in a module are correct,
-- i.e., are identical to the string representation of their defining
-- operations. If there are some differences, transform the
-- (Typed) FlatCurry file (depending on the Curry system).
-- The result is `Nothing` when nothing is transformed, otherwise
-- it is `Just` the module name.
checkFormIDsInProg :: Options -> String -> [QName] -> IO (Maybe String)
checkFormIDsInProg opts mname formnames = do
fidok <- testFormIDsInProg opts mname formnames
if fidok
then return Nothing
else do
putStrLnIfNQ opts $
"Some forms have non-matching IDs: setting correct form IDs..."
case optSysName opts of
"pakcs" -> setFormIDsInFlatCurry opts mname
"kics2" -> setFormIDsInTypedFlatCurry opts mname
o -> do putStrLn $ "Unknown Curry system '" ++ o ++ "'. " ++
"Cannot set correct form IDs!"
exitWith 1
return (Just mname)
-- Test whether all `HtmlFormDef` identifiers in a module are correct,
-- i.e., are identical to the string representation of their defining
-- operations.
checkFormIDsInProg :: Int -> String -> String -> [QName] -> IO ()
checkFormIDsInProg verb curryroot mname formnames = do
testFormIDsInProg :: Options -> String -> [QName] -> IO Bool
testFormIDsInProg opts mname formnames = do
pid <- getPID
let testprogname = "TESTFORMPROG_" ++ show pid
when (verb>1) $ putStrLn $
"Generating check program '" ++ testprogname ++ "':"
putStrLnInter opts $ "Generating check program '" ++ testprogname ++ "':"
let testprog = unlines
[ "import " ++ mname
, "import HTML.Base"
......@@ -94,36 +122,37 @@ checkFormIDsInProg verb curryroot mname formnames = do
, checkFormIDDefinition
, ""
, "main :: IO ()"
, "main = sequence_ [" ++
, "main = do"
, " results <- sequence [" ++
intercalate "," (map genFormCall formnames) ++ "]"
, " unless (and results) (exitWith 1)"
]
writeFile (testprogname ++ ".curry") testprog
when (verb>2) $ putStrLn testprog
when (verb>1) $ putStrLn $
"Executing check program '" ++ testprogname ++ "'..."
putStrLnDetail opts testprog
putStrLnInter opts $ "Executing check program '" ++ testprogname ++ "'..."
c <- system $ unwords
[curryroot </> "bin" </> "curry",":set v0", ":load", testprogname,
[optSystem opts </> "bin" </> "curry",":set v0", ":load", testprogname,
":eval", "main", ":quit"]
cleanProg testprogname
unless (c==0) (exitWith c)
return $ c == 0
where
cleanProg modname = do
system $ unwords [curryroot </> "bin" </> "cleancurry", modname]
system $ unwords [optSystem opts </> "bin" </> "cleancurry", modname]
system $ "/bin/rm -f " ++ modname ++ ".curry"
genFormCall qn =
let s = showQName qn
in "checkFormID (" ++ s ++ ",\"" ++ s ++ "\")"
showQName :: QName -> String
showQName (mn,fn) = mn ++ "." ++ fn
checkFormIDDefinition :: String
checkFormIDDefinition = unlines
["checkFormID :: (HtmlFormDef a, String) -> IO ()"
,"checkFormID (fd, s) = unless (formDefId fd == s)"
," (putStrLn (\"ERROR: form operation '\" ++ s ++ \"' has non-matching ID!\") >>"
," exitWith 1)"
["checkFormID :: (HtmlFormDef a, String) -> IO Bool"
,"checkFormID (fd, s) ="
," if (formDefId fd == s)"
," then return True"
," else do"
," putStrLn (\"Warning: Form definition '\" ++ s ++ \"' has non-matching ID\")"
," return False"
]
{-
......@@ -134,10 +163,14 @@ checkFormIDDefinition = unlines
import System ( exitWith )
import HTML.Base
checkFormID :: (HtmlFormDef a, String) -> IO ()
checkFormID :: (HtmlFormDef a, String) -> IO Bool
checkFormID (fd, s) =
unless (formDefId fd == s) $ do
putStrLn $ "ERROR: form operation '" ++ s ++ "' has non-matching ID!"
exitWith 1
if (formDefId fd == s)
then return True
else do
putStrLn $ "Warning: Form definition '" ++ s ++ "' has non-matching ID."
return False
-}
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Option process for the `curry2cgi` script.
---
--- @author Michael Hanus
--- @version August 2020
------------------------------------------------------------------------------
module C2C.Options
where
import Distribution ( installDir )
import GetOpt
import List ( nub )
import ReadNumeric ( readNat )
import System ( exitWith, system )
import AbstractCurry.Types ( QName )
import System.CurryPath ( stripCurrySuffix )
------------------------------------------------------------------------
--- The script banner.
banner :: String
banner = unlines [bannerLine,bannerText,bannerLine]
where
bannerText = "Compile Curry programs with HTML forms to CGI executables " ++
"(Version of 18/08/20)"
bannerLine = take (length bannerText) (repeat '=')
------------------------------------------------------------------------------
-- Option processing for the script.
data Options = Options
{ optVerb :: Int -- verbosity (0: quiet, 1: status, 2: interm, 3: all)
, optHelp :: Bool -- if help info should be printed
, optOutput :: String -- name of the cgi program file (with suffix .cgi)
, optMain :: String -- the main expression
, optForms :: [QName] -- qualified names of form operations
, optFormMods :: [String] -- names of modules containing form operations
, optSystem :: String -- path to root of Curry system
, optSysName :: String -- name of the Curry system ("pakcs", "kics2")
, optCPM :: String -- command to invoke Curry Package Manager
, optCurryRC :: [String] -- curryrc options
, optCurryOpts :: [String] -- options passed to the Curry compiler
, optLimit :: String -- ulimit settings for the cgi program
}
defaultOptions :: Options
defaultOptions =
Options 1 False "" "" [] [] installDir "" "cypm exec"
[] [":set -time", ":set -interactive"]
"-t 120"
--- Process the actual command line argument and return the options
--- and the name of the main program.
processOptions :: [String] -> IO (Options,String)
processOptions argv = do
let (funopts, args, opterrors) = getOpt Permute options argv
opts = foldl (flip id) defaultOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> printUsage >> exitWith 1)
when (optHelp opts) (printUsage >> exitWith 0)
case args of
[p] -> let mname = stripCurrySuffix p
opts1 = opts { optFormMods = nub (optFormMods opts ++ [mname])
, optMain = if null (optMain opts)
then mname ++ ".main"
else optMain opts }
in return (opts1, mname)
[] -> error $ "Name of main module missing!"
_ -> error $ "Please provide only one main module!"
where
printUsage = putStrLn (banner ++ "\n" ++ usageText)
-- Usage text
usageText :: String
usageText =
usageInfo ("Usage: curry2cgi [options] <module name>\n") options
-- Definition of actual command line options.
options :: [OptDescr (Options -> Options)]
options =
[ Option "h?" ["help"]
(NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "q" ["quiet"]
(NoArg (\opts -> opts { optVerb = 0 }))
"run quietly (no output, only exit code)"
, Option "v" ["verb"]
(OptArg (maybe (checkVerb 2) (safeReadNat checkVerb)) "<n>")
"verbosity level:\n0: quiet (same as `-q')\n1: show status messages (default)\n2: show intermediate results (same as `-v')\n3: show all details"
, Option "m" ["main"]
(ReqArg (\s opts -> opts { optMain = s }) "<m>")
("Curry expression (of type IO HtmlPage) computing\n" ++
"the HTML page\n(default: main)")
, Option "o" ["output"]
(ReqArg (\s opts -> opts { optOutput = s }) "<o>")
("name of the file (with suffix .cgi) where the cgi\n" ++
"program should be stored (default: <curry>.cgi)")
, Option "i" ["include"]
(ReqArg (\s opts -> opts { optFormMods = optFormMods opts ++ [s] })
"<i>")
("Additional Curry module for which all public\n" ++
"form handlers should be generated")
, Option "s" ["system"]
(ReqArg (\s opts -> opts { optSystem = s }) "<s>")
("set path to the root of Curry system\n" ++
"(then 'path/bin/curry' is invoked to compile script)")
, Option "" ["cpmexec"]
(ReqArg (\s opts -> opts { optCPM = s }) "<c>")
("set the command to execute programs with the\n" ++
"Curry Package Manager (default: 'cypm exec')")
, Option "D" []
(ReqArg (\s opts -> opts { optCurryRC = optCurryRC opts ++ [s] })
"name=val")
"define (curry)rc property 'name' as 'val'"
, Option "u" ["ulimit"]
(ReqArg (\s opts -> opts { optLimit = s }) "<l>")
("set 'ulimit <l>' when executing the cgi program\n" ++
"(default: '-t 120')")
]
where
safeReadNat opttrans s opts =
let numError = error "Illegal number argument (try `-h' for help)"
in maybe numError
(\ (n,rs) -> if null rs then opttrans n opts else numError)
(readNat s)
checkVerb n opts = if n>=0 && n<4
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
putStrLnIfNQ :: Options -> String -> IO ()
putStrLnIfNQ opts s = unless (optVerb opts == 0) $ putStrLn s
putStrLnInfo :: Options -> String -> IO ()
putStrLnInfo opts s = when (optVerb opts > 0) $ putStrLn s
putStrLnInter :: Options -> String -> IO ()
putStrLnInter opts s = when (optVerb opts > 1) $ putStrLn s
putStrLnDetail :: Options -> String -> IO ()
putStrLnDetail opts s = when (optVerb opts > 2) $ putStrLn s
line :: String
line = take 78 (repeat '-')
------------------------------------------------------------------------------
-- Some auxiliaries.
--- The name of the form definition type.
formDefTypeName :: (String,String)
formDefTypeName = ("HTML.Base","HtmlFormDef")
--- Shows a qualified name.
showQName :: (String,String) -> String
showQName (mn,fn) = mn ++ "." ++ fn
--- Executes a command and show the command if verbosity is detailed.
execVerbCommand :: Options -> String -> IO Int
execVerbCommand opts cmd = do
when (optVerb opts > 2) $ putStrLn $ "EXECUTING: " ++ cmd
system cmd
-------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Transforms a FlatCurry file by setting correct IDs in all form definitions.
---
--- @author Michael Hanus
--- @version August 2020
------------------------------------------------------------------------------
module C2C.TransFlatCurryForms ( setFormIDsInFlatCurry, copyTransFlatCurry )
where
import FilePath ( (</>) )
import System ( exitWith, system )
import FlatCurry.Files
import FlatCurry.Types hiding ( showQName )
import System.CurryPath ( lookupModuleSourceInLoadPath )
import C2C.Options
------------------------------------------------------------------------------
--- Transforms a FlatCurry file by setting IDs in all form definitions.
setFormIDsInFlatCurry :: Options -> String -> IO ()
setFormIDsInFlatCurry opts mname = do
lookupModuleSourceInLoadPath mname >>=
maybe (error $ "Module '" ++ mname ++ "' not found in load path!")
attachFormIDsInProg
where
attachFormIDsInProg (mdir,_) = do
when (optVerb opts > 1) $
putStr $ "Reading FlatCurry of module '" ++ mname ++ "'..."
(Prog name imps types funcs ops) <- readFlatCurry mname
putStrLnInter opts "done!"
let newflatname = flatCurryFileName (mdir </> mname) ++ transSuffix
tprog = Prog name imps types (map transFunc funcs) ops
putStrLnInter opts $ "Writing transformed FlatCurry file..."
writeFlatCurryFile newflatname tprog
copyFlatCurryInDir opts mdir mname
transFunc fd@(Func fn ar vis te rl) =
if isFormDefType te
then Func fn ar vis te (addID rl)
else fd
where
addID (External _) = error "Externally defined HTML form!"
addID (Rule vs exp) =
Rule vs (Comb FuncCall ("HTML.Base","setFormDefId")
[string2FC (showQName fn), exp])
isFormDefType texp = case texp of
TCons tc [_] -> tc == formDefTypeName
_ -> False
string2FC :: String -> Expr
string2FC [] = Comb ConsCall ("Prelude","[]") []
string2FC (c:cs) =
Comb ConsCall ("Prelude",":") [Lit (Charc c), string2FC cs]
--- Copies transformed FlatCurry files.
copyTransFlatCurry :: Options -> String -> IO ()
copyTransFlatCurry opts mname = do
lookupModuleSourceInLoadPath mname >>=
maybe (error $ "Module '" ++ mname ++ "' not found in load path!")
(\ (mdir,_) -> copyFlatCurryInDir opts mdir mname)
copyFlatCurryInDir :: Options -> String -> String -> IO ()
copyFlatCurryInDir opts mdir mname = do
let flatname = flatCurryFileName (mdir </> mname)
newflatname = flatCurryFileName (mdir </> mname) ++ transSuffix
putStrLnInter opts $ "Replacing original FlatCurry file..."
rc <- execVerbCommand opts $
"/bin/cp \"" ++ newflatname ++ "\" \"" ++ flatname ++ "\""
unless (rc == 0) $ exitWith 1
transSuffix :: String
transSuffix = ":SETFORMIDS"
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Transforms a Typed FlatCurry file by setting correct IDs
--- in all form definitions.
---
--- @author Michael Hanus
--- @version August 2020
------------------------------------------------------------------------------
module C2C.TransTypedFlatCurryForms
( setFormIDsInTypedFlatCurry, copyTransTypedFlatCurry )
where
import FilePath ( (</>), (<.>) )
import System ( exitWith, system )
import FlatCurry.Annotated.Files
import FlatCurry.Annotated.Types
import System.CurryPath ( lookupModuleSourceInLoadPath )
import C2C.Options
------------------------------------------------------------------------------
--- Transforms a FlatCurry file by setting IDs in all form definitions.
setFormIDsInTypedFlatCurry :: Options -> String -> IO ()
setFormIDsInTypedFlatCurry opts mname = do
lookupModuleSourceInLoadPath mname >>=