Commit 86f5c80e authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

CPM: Add possibility to create main module on project creation

parent 885bffea
......@@ -13,27 +13,27 @@ from PmProject import :: Project
/**
* Execute a general CPM action
*/
doCpmAction :: String String !.CpmAction !*World -> .World
doCpmAction :: String String !CpmAction !*World -> *World
/**
* Find all project files in the current working directory and build them
*/
doMake :: String !String !*World -> .World
doMake :: String !String !*World -> *World
/**
* Execute project-specific actions
*/
doProjectAction :: .String .String .String .ProjectAction *World -> .World
doProjectAction :: String String String ProjectAction *World -> *World
/**
* Execute path-related project actions
*/
doProjectPathAction :: .String .String Project .PathAction *World -> .World
doProjectPathAction :: String String Project PathAction *World -> *World
/**
* Execute module-related actions
*/
doModuleAction :: .String !.String !.ModuleAction !*World -> .World
doModuleAction :: String !String !ModuleAction !*World -> *World
/**
* Turn a project name into a project filename
......@@ -43,19 +43,19 @@ mkProjectFile :: !String -> String
/**
* Modify a project
*/
withProject :: !String !String .(Project -> Project) *World -> .World
withProject :: !String !String (Project -> Project) *World -> *World
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: !Project -> .[String]
showPaths :: !Project -> [String]
/**
* Modify the list of paths in a project given a modification function which
* takes a strict list of project paths and returns a strict list of project
* paths.
*/
doModPaths :: !String !String !Project .([!String!] -> [!String!]) *World -> .World
doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World
/**
* Open a project file
......@@ -71,18 +71,18 @@ saveProject :: !FilePath !Project !FilePath !*World -> *World
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: !Int u:[!.a!] -> v:[!.a!], [u <= v]
rmStrictListIdx :: !Int [!a!] -> [!a!]
/**
* Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds.
*/
moveStrictListIdx :: !.Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!]
/**
* Show an error message
*/
error :: !String !*World -> .World
error :: !String !*World -> *World
/**
* Show a help message
......
......@@ -20,12 +20,12 @@ import System.Directory, System.File, System.FilePath
/**
* Clean libraries imports
*/
import StdBool, StdEnum, StdMisc, StdTuple
import StdBool, StdEnum, StdMisc, StdTuple, StdArray
/**
* Execute a general CPM action
*/
doCpmAction :: String String !.CpmAction !*World -> .World
doCpmAction :: String String !CpmAction !*World -> *World
doCpmAction cleanhome pwd CpmMake world = doMake cleanhome pwd world
doCpmAction cleanhome pwd (Project pn pa) world = doProjectAction cleanhome pwd pn pa world
doCpmAction cleanhome pwd (Module mn ma) world = doModuleAction cleanhome mn ma world
......@@ -46,7 +46,7 @@ doCpmAction _ _ _ world =
/**
* Find all project files in the current working directory and build them
*/
doMake :: String !String !*World -> .World
doMake :: String !String !*World -> *World
doMake cleanhome pwd world
# (mbErr, world) = readDirectory pwd world
= case mbErr of
......@@ -62,25 +62,42 @@ doMake cleanhome pwd world
compilerOptions :: CompilerOptions
compilerOptions = DefaultCompilerOptions
getLine :: *World -> *(String, *World)
getLine world
# (console, world) = stdio world
# (line, console) = freadline console
# (_, world) = fclose console world
= (line, world)
/**
* Execute project-specific actions
*/
doProjectAction :: .String .String .String .ProjectAction *World -> .World
doProjectAction :: String String String ProjectAction *World -> *World
doProjectAction cleanhome pwd pn CreateProject world
//Check if main module exists
# (exists,world) = fileExists mainmodule world
| not exists = error ("Main module " +++ mainmodule +++ " does not exist.") world
# (prjok, world) = accFiles (SaveProjectFile projectfile project cleanhome) world
| not prjok = error ("Could not create project file " +++ projectfile) world
= world
where basefilename = dropExtension pn
mainmodule = addExtension basefilename "icl"
projectfile = mkProjectFile basefilename //addExtension basefilename "prj"
edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
project = PR_SetRoot mainmodule edit_options compilerOptions prj
//Create project file using the Clean IDE libraries
where prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
# (exists,world) = fileExists mainmodule world
| not exists // = error ("Main module " +++ mainmodule +++ " does not exist.") world
# world = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world
# (line, world) = getLine world
= if (line.[0] == 'y') (mkMainAndProject world) (error ("Failed to create project. Need " +++ mainmodule) world)
= mkProject world
where
basefilename = dropExtension pn
mainmodule = addExtension basefilename "icl"
projectfile = mkProjectFile basefilename //addExtension basefilename "prj"
edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
project = PR_SetRoot mainmodule edit_options compilerOptions prj
//Create project file using the Clean IDE libraries
where prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
mkMainAndProject world
# world = doModuleAction "" mainmodule (CreateModule ApplicationModule) world
= mkProject world
mkProject world
# (prjok, world) = accFiles (SaveProjectFile projectfile project cleanhome) world
| not prjok = error ("Could not create project file " +++ projectfile) world
= world
doProjectAction cleanhome pwd pn ShowProject world
# projectfile = mkProjectFile pn
......@@ -134,7 +151,7 @@ doProjectAction _ _ _ _ world =
/**
* Execute environment-specific actions
*/
doEnvironmentAction :: .String .String .EnvironmentAction *World -> .World
doEnvironmentAction :: String String EnvironmentAction *World -> *World
doEnvironmentAction cleanhome pwd ListEnvironments world = error ("Not implemented") world
doEnvironmentAction cleanhome pwd (ImportEnvironment ef) world = error ("Not implemented") world
doEnvironmentAction cleanhome pwd (RemoveEnvironment en) world = error ("Not implemented") world
......@@ -167,7 +184,7 @@ mkProjectFile pn = addExtension (dropExtension pn) "prj"
/**
* Modify a project
*/
withProject :: !String !String .(Project -> Project) *World -> .World
withProject :: !String !String (Project -> Project) *World -> *World
withProject cleanhome pn f world
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
......@@ -176,7 +193,7 @@ withProject cleanhome pn f world
/**
* Execute path-related project actions
*/
doProjectPathAction :: .String .String Project .PathAction *World -> .World
doProjectPathAction :: String String Project PathAction *World -> *World
doProjectPathAction cleanhome pn project (AddPathAction path) world =
doModPaths cleanhome pn project ((:!) path) world
......@@ -199,7 +216,7 @@ doProjectPathAction _ _ _ _ world =
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: !Project -> .[String]
showPaths :: !Project -> [String]
showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
where f (n, p) = " [" +++ toString n +++ "] " +++ p
......@@ -208,7 +225,7 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
* takes a strict list of project paths and returns a strict list of project
* paths.
*/
doModPaths :: !String !String !Project .([!String!] -> [!String!]) *World -> .World
doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World
doModPaths cleanhome pn project f world
# world = saveProject cleanhome prj pn world
= showLines ["Successfully modified project paths"] world
......@@ -237,7 +254,7 @@ saveProject cleanhome prj projectfile world
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: !Int u:[!.a!] -> v:[!.a!], [u <= v]
rmStrictListIdx :: !Int [!a!] -> [!a!]
rmStrictListIdx 0 (_ :! t) = t
rmStrictListIdx n (h :! t) | n > 0 = h :! (rmStrictListIdx (n - 1) t)
rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out of bounds")
......@@ -246,7 +263,7 @@ rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out
* Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds.
*/
moveStrictListIdx :: !.Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!]
moveStrictListIdx i dir xs
| i < 0 || i > (LLength xs - 1) = abort ("Index " +++ toString i +++ " out of bounds")
| otherwise = ListToStrictList (msl dir (splitAt i (StrictListToList xs)))
......@@ -264,7 +281,7 @@ moveStrictListIdx i dir xs
/**
* Execute module-related actions
*/
doModuleAction :: .String !.String !.ModuleAction !*World -> .World
doModuleAction :: String !String !ModuleAction !*World -> *World
doModuleAction _ mn (CreateModule mt) world
# (dclexists, world) = fileExists dclnm world
| dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world
......@@ -282,9 +299,8 @@ doModuleAction _ mn (CreateModule mt) world
# world = writeicl ApplicationModule world
= writedcl world
writeicl ApplicationModule world = writeicl` "implementation " world
writeicl LibraryModule world = writeicl` "" world
writeicl ApplicationModule world = writeicl` "" world
writeicl LibraryModule world = writeicl` "implementation " world
writeicl` pref world = writemod iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'") world
......@@ -306,7 +322,7 @@ doModuleAction _ _ _ world =
/**
* Show an error message
*/
error :: !String !*World -> .World
error :: !String !*World -> *World
error message world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment