Commit 41163dd6 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

Add cpm: Clean Project Management

parent a0049718
module Cpm
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 StdEnv
import Text
import UtilIO
import UtilStrictLists
:: CloptAction
= Project FilePath ProjectAction
| Module String ModuleAction
| Help
:: ProjectAction
= CreateProject
| ShowProject
| BuildProject Bool FilePath
| ProjectPath PathAction
| ProjectHelp
:: PathAction
= AddPathAction String
| RemovePathAction String
:: ModuleAction
= CreateModule
| ModuleHelp
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))
pClopt :: CParser Char CloptAction a
pClopt = pProject <|> pModule <!> yield Help
spstrtok :: (String -> CParser Char [Char] a)
spstrtok = sptoken o fromString
pProject :: CParser Char CloptAction a
pProject = spstrtok "project" &> pNotSpace <&> \pn -> pProjectAction <@ Project (toString pn)
where pProjectAction = spstrtok "create" <@ const CreateProject
<|> spstrtok "show" <@ const ShowProject
<|> spstrtok "build" &> pForce <&> \ f-> pIDEEnvs <@ BuildProject f
<|> spstrtok "path" &> pPathAction <@ ProjectPath
<!> yield ProjectHelp
pPathAction = spstrtok "add" &> pNotSpace <@ AddPathAction o toString
<|> spstrtok "remove" &> pNotSpace <@ RemovePathAction o toString
pForce :: CParser Char Bool a
pForce = spstrtok "--force" <@ const True <|> yield False
pIDEEnvs :: CParser Char String a
pIDEEnvs = spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString <!> yield EnvsFileName
pModule :: CParser Char CloptAction a
pModule = spstrtok "module" &> pNotSpace <&> \mn -> pModuleAction <@ Module (toString mn)
where pModuleAction = spstrtok "create" <@ const CreateModule
<!> yield ModuleHelp
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)
= doCloptAction world ch pwd cpm
startParse :: [.Char] -> CloptAction
startParse args = case filter (\(xs, _) -> xs == []) (begin pClopt args) of
[(_, as):_] -> as
_ -> Help
doCloptAction :: *World String String .CloptAction -> .World
doCloptAction world cleanhome pwd (Project pn pa) = doProjectAction world cleanhome pwd pn pa
doCloptAction world cleanhome pwd (Module mn ma) = doModuleAction world cleanhome mn ma
doCloptAction world _ _ _ =
help [ "CPM: Clean Project Management"
, ""
, "Usage: cpm <action>"
, "Where <action> is one of the following:"
, " project : project actions"
, " module : module action"
, ""
, "Execute `cpm <action> help` to get help for specific actions."] world
doProjectAction :: *World .String .String .String .ProjectAction -> .World
doProjectAction world cleanhome pwd pn CreateProject
# basefilename = dropExtension pn
# mainmodule = addExtension basefilename "icl"
# projectfile = addExtension basefilename "prj"
//Check if main module exists
# (exists,world) = fileExists mainmodule world
| not exists = error ("Main module " +++ mainmodule +++ " does not exist.") world
//Create project file using the Clean IDE libraries
# edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
# compiler_options = DefaultCompilerOptions;
# project = PR_NewProject mainmodule edit_options compiler_options DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
# project = PR_SetRoot mainmodule edit_options compiler_options project
# (err,world) = accFiles (SaveProjectFile projectfile project cleanhome) world
| err = error ("Could not create project file " +++ projectfile) world
= world
doProjectAction world cleanhome pwd pn ShowProject
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (mbProj ,world) = openProject cleanhome projectfile world
= case mbProj of
Error e -> error e world
Ok project -> show [ "Content of " +++ projectfile
, "Target: " +++ PR_GetTarget project
, "Executable: " +++ PR_GetExecPath project
, "Paths:"
: [toString p \\ p <- StrictListToList (PR_GetPaths project)]
] world
doProjectAction world cleanhome pwd pn (BuildProject force ideenvs)
# envsfile = application_path ideenvs
# (envs, world) = openEnvironments cleanhome envsfile world
# ((proj, ok, err), world) = accFiles (ReadProjectFile pn cleanhome) world
| not ok || err <> "" = error ("BatchBuild failed while opening project: "+++.err+++."\n") world
# (ok, logfile, world) = openLogfile pn world
| not ok = error ("BatchBuild failed while opening logfile.\n") world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options cleanhome pn proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls, gst_world} = pinit force ps
= gst_world
doProjectAction world cleanhome _ pn (ProjectPath pa) = doProjectPathAction world cleanhome pn pa
doProjectAction world _ _ _ _ =
help [ "create : create a new project"
, "show : show project information"
, "build [--force] : build the project. Optionally force build (default: 'false')"
, "path <add|remove> : add or remove a path from the project"
, "help : show this help message"] world
doProjectPathAction :: *World .String .String .PathAction -> .World
doProjectPathAction world cleanhome pn (AddPathAction path)
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (mbProj, world) = openProject cleanhome projectfile world
= case mbProj of
Error e = error e world
Ok project
# paths = StrictListToList (PR_GetPaths project)
= help ["Paths" +++ toString (length paths)] world
doProjectPathAction world cleanhome pn (RemovePathAction path) = undef
openProject :: !FilePath !FilePath !*World -> (!MaybeErrorString Project,!*World)
openProject cleanhome projectfile world
# ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world
| ok = (Ok prj, world)
= (Error err, world)
doModuleAction :: *World .String .String .ModuleAction -> .World
doModuleAction world cleanhome mn CreateModule
# basenm = dropExtension mn
# dclnm = addExtension basenm "dcl"
# iclnm = addExtension basenm "icl"
# (dclexists, world) = fileExists dclnm world
| dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world
# (iclexists, world) = fileExists iclnm world
| dclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
= undef
doModuleAction world _ _ _ =
help [ "create [application|library] : create a new module. Optionally specify module type (default: 'library')"
, "help : show this help message"] world
error :: {#.Char} *World -> .World
error message world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
# world = set_return_code_world (-1) world
= world
help :: ![String] !*World -> *World
help lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
show :: ![String] !*World -> *World
show ls w = help ls w
// 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
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