Commit e2105c68 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

CPM: Deal with different paths on Windows

parent 37c1d25f
......@@ -37,6 +37,7 @@ Global
ExportedNames:
Paths
Path: {Project}/cpm
Path: {Project}/cpm/Posix
Path: {Application}/lib/ArgEnv
Path: {Application}/lib/Directory
Path: {Application}/lib/Generics
......
This diff is collapsed.
......@@ -37,6 +37,7 @@ Global
ExportedNames:
Paths
Path: {Project}\cpm
Path: {Project}\cpm\Windows
Path: {Application}\Libraries\ArgEnv
Path: {Application}\Libraries\Directory
Path: {Application}\Libraries\Generics
......
......@@ -3,7 +3,7 @@ implementation module CpmLogic
/**
* CPM imports
*/
import AbsSyn
import AbsSyn, CpmPaths
/**
* CleanIDE imports
......@@ -76,27 +76,28 @@ getLine 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
# world = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world
# (line, world) = getLine world
# (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
| otherwise = 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
basefilename = dropExtension pn
mainmodule = addExtension basefilename "icl"
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
# edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
//Create project file using the Clean IDE libraries
# prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
# project = PR_SetRoot mainmodule edit_options compilerOptions prj
# projectfile = mkProjectFile basefilename //addExtension basefilename "prj"
# (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
......@@ -111,16 +112,17 @@ doProjectAction cleanhome pwd pn ShowProject world
] world
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = openEnvironments cleanhome (cleanhome </> "etc" </> ideenvs) world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
| not ok || err <> "" = error ("CPM failed while opening project: " +++ err +++ "\n") world
# (console, world) = stdio world
# iniGeneral = initGeneral True compilerOptions cleanhome proj_path proj envs console
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# (envs, world) = readIDEEnvs cleanhome ideenvs world
# proj_path = GetLongPathName pn
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
| not ok || err <> "" = error ("CPM failed while opening project: " +++ err +++ "\n") world
# (console, world) = stdio world
# iniGeneral = initGeneral True compilerOptions cleanhome proj_path proj envs console
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
= gst_world
where proj_path = GetLongPathName pn
pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst
cleanup exepath bool1 bool2 ps = abortLog False "" ps
where
pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst
cleanup exepath bool1 bool2 ps = abortLog False "" ps
doProjectAction cleanhome _ pn (ProjectPath pa) world
# projectfile = mkProjectFile pn
......@@ -186,8 +188,8 @@ mkProjectFile pn = addExtension (dropExtension pn) "prj"
*/
withProject :: !String !String (Project -> Project) *World -> *World
withProject cleanhome pn f world
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
# projectfile = mkProjectFile pn
# (project, world) = openProject cleanhome projectfile world
= saveProject cleanhome (f project) projectfile world
/**
......@@ -227,10 +229,10 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
*/
doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World
doModPaths cleanhome pn project f world
# world = saveProject cleanhome prj pn world
# paths = PR_GetPaths project
# prj = PR_SetPaths False paths (f paths) project
# world = saveProject cleanhome prj pn world
= showLines ["Successfully modified project paths"] world
where paths = PR_GetPaths project
prj = PR_SetPaths False paths (f paths) project
/**
* Open a project file
......@@ -238,8 +240,8 @@ doModPaths cleanhome pn project f world
openProject :: !FilePath !FilePath !*World -> (!Project, !*World)
openProject cleanhome projectfile world
# ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world
| ok = (prj, world)
= (prj, error err world)
| ok = (prj, world)
| otherwise = (prj, error err world)
/**
* Save a project back to its project file
......@@ -247,8 +249,8 @@ openProject cleanhome projectfile world
saveProject :: !FilePath !Project !FilePath !*World -> *World
saveProject cleanhome prj projectfile world
# (ok, world) = accFiles (SaveProjectFile projectfile prj cleanhome) world
| not ok = error "Error saving project" world
= world
| not ok = error "Error saving project" world
| otherwise = world
/**
* Remove an item from a strict list at a given index. Abort execution if the
......@@ -288,28 +290,29 @@ doModuleAction _ mn (CreateModule mt) world
# (iclexists, world) = fileExists iclnm world
| iclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
= writeMods mt world
where basenm = dropExtension mn
dclnm = addExtension basenm "dcl"
iclnm = addExtension basenm "icl"
where
basenm = dropExtension mn
dclnm = addExtension basenm "dcl"
iclnm = addExtension basenm "icl"
mkmod mty = mty +++ "module " +++ basenm
mkmod mty = mty +++ "module " +++ basenm
writeMods ApplicationModule world = writeicl ApplicationModule world
writeMods LibraryModule world
# world = writeicl ApplicationModule world
= writedcl world
writeMods ApplicationModule world = writeicl ApplicationModule world
writeMods LibraryModule world
# world = writeicl ApplicationModule world
= writedcl world
writeicl ApplicationModule world = writeicl` "" world
writeicl LibraryModule world = writeicl` "implementation " 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
writeicl` pref world = writemod iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'") world
writedcl world = writemod dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'") world
writedcl world = writemod dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'") world
writemod nm pref errmsg world
# (me, world) = writeFile nm (mkmod pref) world
| isError me = error errmsg world
= world
writemod nm pref errmsg world
# (me, world) = writeFile nm (mkmod pref) world
| isError me = error errmsg world
= world
doModuleAction _ _ _ world =
help "cpm module <modulename> <action>"
......@@ -324,19 +327,20 @@ doModuleAction _ _ _ world =
*/
error :: !String !*World -> *World
error message world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
= set_return_code_world (-1) world
/**
* Show a help message
*/
help :: !String ![String] !*World -> *World
help cmd lines world = showLines lines` world
where lines` = [ "CPM: Clean Project Manager"
: ""
: "Usage: " +++ cmd
: lines]
help cmd lines world
# lines` = [ "CPM: Clean Project Manager"
: ""
: "Usage: " +++ cmd
: lines]
= showLines lines` world
/**
* Given a list of strings, concatenate them to a single string with newlines
......@@ -344,6 +348,6 @@ help cmd lines world = showLines lines` world
*/
showLines :: ![String] !*World -> *World
showLines lines world
# (console, world) = stdio world
# console = seqSt (\s -> fwrites (s +++ "\n")) lines console
# (console, world) = stdio world
# console = seqSt (\s -> fwrites (s +++ "\n")) lines console
= snd $ fclose console world
definition module CpmPaths
import PmEnvironment
readIDEEnvs :: !String !String !*World -> *([Target], *World)
implementation module CpmPaths
import PmEnvironment
import System.FilePath
readIDEEnvs :: !String !String !*World -> *([Target], *World)
readIDEEnvs cleanhome ideenvs world = openEnvironments cleanhome (cleanhome </> "etc" </> ideenvs) world
definition module CpmPaths
import PmEnvironment
readIDEEnvs :: !String !String !*World -> *([Target], *World)
implementation module CpmPaths
import PmEnvironment
import System.FilePath
readIDEEnvs :: !String !String !*World -> *([Target], *World)
readIDEEnvs cleanhome ideenvs world = openEnvironments cleanhome (cleanhome </> "Config" </> ideenvs) 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