Commit e2105c68 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

CPM: Deal with different paths on Windows

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