Commit 3fac4b90 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

Split CPM into separate modules

parent 34910221
definition module AbsSyn
from FilePath import :: FilePath
/**
* Datatypes
*/
:: CpmAction
= Project FilePath ProjectAction
| Module String ModuleAction
| Environment EnvironmentAction
| CpmHelp
:: ProjectAction
= CreateProject
| ShowProject
| BuildProject Bool FilePath
| ProjectPath PathAction
//| SetProjectRoot String TODO: Not yet supported by PmProject
| SetTarget String
| SetExec String
| ProjectHelp
:: PathAction
= AddPathAction String
| RemovePathAction Int
| ListPathsAction
| MovePathAction Int PathDirection
| PathHelp
:: PathDirection
= PathUp
| PathDown
| PathTop
| PathBottom
:: ModuleAction
= CreateModule ModuleType
| ModuleHelp
:: ModuleType
= ApplicationModule
| LibraryModule
:: EnvironmentAction
= ShowEnvironment
implementation module AbsSyn
module Cpm
/**
* Imports
* CPM imports
*/
import AbsSyn, CpmLogic, Parser
/**
* CleanIDE imports
*/
import CommandLine
import Environment
import Error
import File
import FilePath
import Func
import IdeState
import List
import logfile
import ParserCombinators
import Platform
import PmDriver
import PmEnvironment
import PmProject
import set_return_code
import StdBool, StdEnum, StdFile, StdFunc, StdMisc, StdTuple
import Text
import UtilIO
import UtilStrictLists
/**
* Clean Platform imports
*/
import CommandLine, Environment, Func, List, Text
/**
* Clean libraries imports
*/
import StdFile, StdString
/**
* CPM: Clean Project Management
......@@ -64,142 +61,6 @@ import UtilStrictLists
* - Make sure `EnvironmentVersion` has value `920`
*/
/**
* Datatypes
*/
:: CpmAction
= Project FilePath ProjectAction
| Module String ModuleAction
| Environment EnvironmentAction
| CpmHelp
:: ProjectAction
= CreateProject
| ShowProject
| BuildProject Bool FilePath
| ProjectPath PathAction
//| SetProjectRoot String TODO: Not yet supported by PmProject
| SetTarget String
| SetExec String
| ProjectHelp
:: PathAction
= AddPathAction String
| RemovePathAction Int
| ListPathsAction
| MovePathAction Int PathDirection
| PathHelp
:: PathDirection
= PathUp
| PathDown
| PathTop
| PathBottom
:: ModuleAction
= CreateModule ModuleType
| ModuleHelp
:: ModuleType
= ApplicationModule
| LibraryModule
:: EnvironmentAction
= ShowEnvironment
/**
* Parsers
*/
/**
* Parse one or more non-whitespace characters
*/
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))
/**
* Top-level parser for CPM commands
*/
pCpm :: CParser Char CpmAction a
pCpm = pProject <|> pModule <!> (yield CpmHelp)
/**
* Wrapper around the token parser that converts a Clean string to a list of
* charactersm for easier parsing
*/
spstrtok :: (String -> CParser Char [Char] a)
spstrtok = sptoken o fromString
/**
* Parser for boolean values
*/ // TODO: REmove?
//pBool :: CParser Char Bool a
//pBool = pConstCtr [("true", True), ("True", True), ("false", False), ("False", False)]
/**
* Parser for the project commands
*/
pProject :: CParser Char CpmAction a
pProject = spstrtok "project" &> (pProjectWithName <!> yield (Project "" ProjectHelp))
where pProjectWithName = pNotSpace <&> \pn -> pProjectAction <@ Project (toString pn)
pProjectAction = (spstrtok "create" <@ const CreateProject)
<|> (spstrtok "show" <@ const ShowProject)
<|> (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|> (spstrtok "path" &> pPathAction)
//<|> (spstrtok "projectroot" &> pNotSpace <@ SetProjectRoot o toString)
<|> (spstrtok "target" &> identifier <@ SetTarget o toString)
<|> (spstrtok "exec" &> identifier <@ SetExec o toString)
<!> (pHelp ProjectHelp)
/**
* Parser for all path-related actions
*/
pPathAction :: CParser Char ProjectAction a
pPathAction = pPathAction <@ ProjectPath
where pPathAction = (spstrtok "add" &> pNotSpace <@ AddPathAction o toString)
<|> (spstrtok "remove" &> sp nat <@ RemovePathAction)
<|> (spstrtok "list" <@ const ListPathsAction)
<|> (spstrtok "move" &> pPathDirection)
<!> (pHelp PathHelp)
pPathDirection = sp nat <&> \i -> pConstCtr dirOpts <@ MovePathAction i
dirOpts = [("up", PathUp), ("down", PathDown), ("top", PathTop), ("bottom", PathBottom)]
/**
* Parser for constant mappings between text and constructors
*/
pConstCtr :: [(String, c)] -> CParser Char c a
pConstCtr xs = choice (map (\(s, d) -> (spstrtok s <@ const d)) xs)
/**
* Parser to toggle the --force flag
*/
pForce :: CParser Char Bool a
pForce = (spstrtok "--force" <@ const True) <!> (yield False)
/**
* Parser for the argument to specify where the IDEEnvs file is
*/
pIDEEnvs :: CParser Char String a
pIDEEnvs = (spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString)
<!> (yield EnvsFileName)
/**
* Parser for module-related actions
*/
pModule :: CParser Char CpmAction a
pModule = spstrtok "module" &> (pModuleWithName <!> yield (Module "" ModuleHelp))
where pModuleWithName = pNotSpace <&> \mn -> pModuleAction <@ Module (toString mn)
pModuleAction = (spstrtok "create" &> pModuleType <@ CreateModule)
<!> (pHelp ModuleHelp)
pModuleType = (spstrtok "application" <@ const ApplicationModule)
<!> (yield LibraryModule)
/**
* Parser for the help command
*/
pHelp :: c -> CParser Char c a
pHelp c = (spstrtok "help" <@ const c) <|> (yield c)
/**
* Start function which reads the program arguments, starts the parser and
* starts processing the parse results.
......@@ -207,286 +68,10 @@ pHelp c = (spstrtok "help" <@ const c) <|> (yield c)
Start :: *World -> *World
Start world
# (cmd, world) = getCommandLine world
cl = concat (intersperse " " (tl [fromString arg \\ arg <- cmd]))
cpm = startParse (fromString cl)
(pwd, world) = accFiles GetFullApplicationPath world
(ch, world) = case getEnvironmentVariable "CLEAN_HOME" world of
(Just ch, world) -> (ch, world)
(_, world) -> (pwd, world)
= doCpmAction ch pwd cpm world
/**
* Parse the a list of characters to get the action to be executed. If parsing
* fails, CpmHelp is returned as default action so help may be displayed.
*/
startParse :: [.Char] -> CpmAction
startParse args = maybe CpmHelp snd (find (null o fst) (begin pCpm args))
/**
* Execute a general CPM action
*/
doCpmAction :: String String .CpmAction *World -> .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
doCpmAction _ _ _ world =
help "cpm <target>"
[ "Where <target> is one of the following:"
, " project <projectname> : project actions"
, " module <modulename> : module actions"
, ""
, "Execute `cpm <target> help` to get help for specific actions."] world
/**
* Default compiler options. Currently it is a simple alias for
* forwards-compatibility.
*/
compilerOptions :: CompilerOptions
compilerOptions = DefaultCompilerOptions
/**
* Execute project-specific actions
*/
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 = 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
doProjectAction cleanhome pwd pn ShowProject world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (project, world) = openProject cleanhome projectfile world
= showLines [ "Content of " +++ projectfile +++ ":"
, "ProjectRoot..: " +++ PR_GetRelativeRootDir project
, "Built........: " +++ toString (PR_Built project)
, "Target.......: " +++ PR_GetTarget project
, "Executable...: " +++ PR_GetExecPath project
, "Paths........:"
: showPaths project
] world
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = openEnvironments cleanhome envsfile world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path pwd) world
| not ok || err <> "" = error ("CPM failed while opening project: "+++.err+++."\n") world
# (ok, logfile, world) = openLogfile proj_path world
| not ok = error ("CPM failed while opening logfile.\n") world
# iniGeneral = initGeneral True compilerOptions pwd proj_path proj envs logfile
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
= gst_world
where envsfile = cleanhome </> ideenvs
proj_path = GetLongPathName pn
doProjectAction cleanhome _ pn (ProjectPath pa) world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (project, world) = openProject cleanhome projectfile world
= doProjectPathAction cleanhome projectfile project pa world
doProjectAction cleanhome pwd pn (SetTarget target) world =
withProject cleanhome pn (PR_SetTarget target) world
doProjectAction cleanhome pwd pn (SetExec exec) world =
withProject cleanhome pn (PR_SetExecPath exec) world
doProjectAction _ _ _ _ world =
help "cpm project <projectname> <action>"
[ "Where <action> is one of the following"
, " create : create a new project"
, " show : show project information"
, " build [--force] [--envs=filename] : build the project. Optionally force build (default: 'false')"
, " Optionally specify the environments file (default: 'IDEEnvs')"
, " path : manage project paths"
, " target <env> : set target environment to <env>"
, " exec <execname> : set executable name to <execname>"
] world
/**
* Modify a project
*/
withProject :: String String .(Project -> Project) *World -> .World
withProject cleanhome pn f world
# projectfile = addExtension (dropExtension pn) "prj"
# (project, world) = openProject cleanhome projectfile world
= saveProject cleanhome (f project) projectfile world
/**
* Execute path-related project actions
*/
doProjectPathAction :: .String .String Project .PathAction *World -> .World
doProjectPathAction cleanhome pn project (AddPathAction path) world =
doModPaths cleanhome pn project (\paths -> path :! paths) world
doProjectPathAction cleanhome pn project (RemovePathAction i) world =
doModPaths cleanhome pn project (rmStrictListIdx i) world
doProjectPathAction _ _ project ListPathsAction world = showLines ["Paths for project:" : showPaths project] world
doProjectPathAction cleanhome pn project (MovePathAction i pdir) world =
doModPaths cleanhome pn project (moveStrictListIdx i pdir) world
doProjectPathAction _ _ _ _ world =
help "cpm project <projectname> path <action>"
[ "Where <action> is one of the following"
, " add <path> : add a path to the project"
, " list : list all project paths and their index"
, " remove <i> : remove path <i> from the list of projects"
, " move <i> <up|down> : move path <i> up or down one position" ] world
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: Project -> .[String]
showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
where f (n, p) = " [" +++ toString n +++ "] " +++ p
/**
* 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 cleanhome pn project f world
# 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
*/
openProject :: !FilePath !FilePath !*World -> (!Project, !*World)
openProject cleanhome projectfile world
# ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world
| ok = (prj, world)
= abort err
/**
* Save a project back to its project file
*/
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
/**
* 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 0 (_ :! t) = t
rmStrictListIdx n (h :! t) | n > 0 = h :! (rmStrictListIdx (n - 1) t)
rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out of bounds")
/**
* 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 i dir xs
| i < 0 || i > (LLength xs - 1) = abort ("Index " +++ toString i +++ " out of bounds")
| otherwise = ListToStrictList (msl dir (splitAt i (StrictListToList xs)))
where msl PathUp ([], xs) = xs
msl PathUp (xs, [x:ys]) = (init xs) ++ [x : (last xs) : ys]
msl PathDown ([], [x:y:ys]) = [y:x:ys]
msl PathDown (xs, []) = xs
msl PathDown (xs, [y]) = xs ++ [y]
msl PathDown (xs, [x:y:ys]) = xs ++ [y:x:ys]
msl PathTop (xs, []) = xs
msl PathTop (xs, [y:ys]) = [y:xs] ++ ys
msl PathBottom (xs, []) = xs
msl PathBottom (xs, [y:ys]) = xs ++ ys ++ [y]
/**
* Execute module-related actions
*/
doModuleAction :: .String .String .ModuleAction *World -> .World
doModuleAction cleanhome mn (CreateModule mt) world
# (dclexists, world) = fileExists dclnm world
| dclexists = dexerr world
# (iclexists, world) = fileExists iclnm world
| iclexists = iexerr world
= writeMods mt world
where basenm = dropExtension mn
dclnm = addExtension basenm "dcl"
iclnm = addExtension basenm "icl"
mkmod mty = mty +++ "module " +++ basenm
writeMods ApplicationModule world = writeicl ApplicationModule world
writeMods LibraryModule world
# world = writeicl ApplicationModule world
= writedcl world
writeicl ApplicationModule world = writeicl` "implementation " world
writeicl LibraryModule world = writeicl` "" 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
writemod nm pref errmsg world
# (me, world) = writeFile nm (mkmod pref) world
| isError me = error errmsg world
= world
dexerr world = error ("Definition module '" +++ dclnm +++ "' already exists.") world
iexerr world = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
doModuleAction _ _ _ world =
help "cpm module <modulename> <action>"
[ "Where <action> is one of the following"
, " create [application|library] : create a new module. Optionally specify module type (default: 'library')"] world
/**
* Show an error message
*/
error :: String *World -> .World
error message world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
# world = set_return_code_world (-1) world
= world
/**
* Show a help message
*/
help :: !String ![String] !*World -> *World
help cmd lines world = showLines lines` world
where lines` = [ "CPM: Clean Project Management"
: ""
: "Usage: " +++ cmd
: lines]
/**
* Given a list of strings, concatenate them to a single string with newlines
* in between, then print that new string to console.
*/
showLines :: ![String] !*World -> *World
showLines lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
= doCpmAction ch pwd (startParse (fromString $ mkCl cmd)) world
where mkCl cmd = concat (intersperse " " (tl [fromString arg \\ arg <- cmd]))
// TODO: Use the version from BatchBuild
pinit :: .Bool *GeneralSt -> *GeneralSt
pinit force_rebuild ps
= BringProjectUptoDate force_rebuild cleanup ps
where
cleanup exepath bool1 bool2 ps
= abortLog False "" ps
definition module CpmLogic
from AbsSyn import :: CpmAction
/**
* Execute a general CPM action
*/
doCpmAction :: String String .CpmAction *World -> .World
implementation module CpmLogic
/**
* CPM imports
*/
import AbsSyn
/**
* CleanIDE imports
*/
import IdeState, logfile, PmDriver, PmEnvironment, PmProject, set_return_code, UtilIO, UtilStrictLists
/**
* Clean Platform imports
*/
import File, Error, FilePath, Func, List
/**
* Clean libraries imports
*/
import StdBool, StdEnum, StdMisc, StdTuple
/**
* Execute a general CPM action
*/
doCpmAction :: String String .CpmAction *World -> .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
doCpmAction _ _ _ world =
help "cpm <target>"
[ "Where <target> is one of the following:"
, " project <projectname> : project actions"
, " module <modulename> : module actions"
, ""
, "Execute `cpm <target> help` to get help for specific actions."] world
/**
* Default compiler options. Currently it is a simple alias for
* forwards-compatibility.
*/
compilerOptions :: CompilerOptions
compilerOptions = DefaultCompilerOptions
/**
* Execute project-specific actions
*/
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 = 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
doProjectAction cleanhome pwd pn ShowProject world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (project, world) = openProject cleanhome projectfile world
= showLines [ "Content of " +++ projectfile +++ ":"
, "ProjectRoot..: " +++ PR_GetRelativeRootDir project
, "Built........: " +++ toString (PR_Built project)
, "Target.......: " +++ PR_GetTarget project
, "Executable...: " +++ PR_GetExecPath project
, "Paths........:"
: showPaths project
] world
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = openEnvironments cleanhome envsfile world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path pwd) world
| not ok || err <> "" = error ("CPM failed while opening project: "+++.err+++."\n") world