Commit 3bac5bd2 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Initial compiling result of adding project management capabilities to

batchbuild
parent beadf78a
module BatchBuild
import ArgEnv
from File import fileExists
import FilePath
import Func
import GenEq
import IdeState
import ParserCombinators
......@@ -10,11 +13,17 @@ import PmEnvironment, logfile, set_return_code
import PmProject
import StdEnv
import StdListExtensions
import Tuple
from UtilIO import GetFullApplicationPath,GetLongPathName
// TODO: Remove MaybeError(String) and import from platform
:: MaybeError a b = Error a | Ok b
:: MaybeErrorString a :== MaybeError String a
:: BBArgs =
{ force_rebuild :: Bool
, proj_path :: Maybe String
, filename :: Maybe String
, args :: [BBArg] }
:: BBArg = BBBool String | BBString String String | BBInt String Int
......@@ -23,36 +32,113 @@ derive gEq BBArg
Start :: *World -> *World
Start world
# commandline = getCommandLine
cl = intersperse " " (tl [arg \\ arg <-: commandline])
args = concat [fromString c \\ c <- cl]
{force_rebuild=force_rebuild, proj_path=proj_path, args=args} = startPBB args
| isNothing proj_path = wAbort ("BatchBuild\nUse as: 'BatchBuild [--force] projectname.prj [--envsdir=ARG] [--action=ARG]'\n") world
# (startup,world) = accFiles GetFullApplicationPath world
# envsdir = case getStringArg "envsdir" args of
Nothing -> application_path EnvsFileName
(Just p) -> application_path p
# (envs,world) = openEnvironments startup envsdir world
# ((proj,ok,err),world) = accFiles (ReadProjectFile (fromJust proj_path) startup) world
| not ok || err <> "" = wAbort ("BatchBuild failed while opening project: "+++.err+++."\n") world
# (ok,logfile,world) = openLogfile (fromJust proj_path) world
| not ok = wAbort ("BatchBuild failed while opening logfile.\n") world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options startup (fromJust proj_path) proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls,gst_world} = pinit (force_rebuild || hasFlag "force" args) ps
= finish gst_world
# commandline = getCommandLine
# cleanhome = case getEnvironmentVariable "CLEAN_HOME" of
EnvironmentVariableUndefined -> "."
(EnvironmentVariable ch) -> ch
cl = intersperse " " (tl [arg \\ arg <-: commandline])
argsrec = startPBB (concat [fromString c \\ c <- cl])
| isNothing argsrec.filename = wAbort ("BatchBuild\nUse as: 'BatchBuild [--force] filename [--action=ARG] [--envsdir=ARG]'\n") world
# world = case getStringArg "action" of
"create" -> createProject world argsrec.filename cleanhome
"show" -> showProject world argsrec.filename cleanhome
"addpath" -> addPath world argsrec.filename cleanhome
"removepath" -> removePath world argsrec cleanhome
_ -> buildProject world argsrec
buildProject :: *World BBArgs -> *World
buildProject world {force_rebuild=force_rebuild, filename=filename, args=args}
# (startup,world) = accFiles GetFullApplicationPath world
# envsdir = case getStringArg "envsdir" args of
Nothing -> application_path EnvsFileName
(Just p) -> application_path p
# (envs,world) = openEnvironments startup envsdir world
# ((proj,ok,err),world) = accFiles (ReadProjectFile (fromJust filename) startup) world
| not ok || err <> "" = wAbort ("BatchBuild failed while opening project: "+++.err+++."\n") world
# (ok,logfile,world) = openLogfile (fromJust filename) world
| not ok = wAbort ("BatchBuild failed while opening logfile.\n") world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options startup (fromJust filename) proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls,gst_world} = pinit (force_rebuild || hasFlag "force" args) ps
= finish gst_world
createProject :: *World (Maybe String) String -> *World
createProject world Nothing _ = wAbort ("No file specified") world
createProject world (Just filename) cleanhome
//Figure out the file names
# basefilename = dropExtension filename
# mainmodule = addExtension basefilename "icl"
# projectfile = addExtension basefilename "prj"
//Check if main module exists
# (exists,world) = fileExists mainmodule world
| not exists = wAbort ("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 = wAbort ("Could not create project file " +++ projectfile) world
= world
showProject :: *World (Maybe String) String -> *World
showProject world Nothing _ = wAbort ("No file specified") world
showProject world (Just filename) cleanhome
# projectfile = addExtension (dropExtension filename) "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
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)
show :: ![String] !*World -> *World
show lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console world
= world
error :: !String !*World -> *World
error msg world = show ["Error: " +++ msg] world
addPath :: *World (Maybe String) String -> *World
addPath world Nothing _ = wAbort "No filename" world
addPath world (Just filename) cleanhome
# projectfile = addExtension (dropExtension filename) "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)
= show ["Paths" +++ toString (length paths)] world
removePath :: *World BBArgs String -> *World
removePath world {filename=filename, args=args} cleanhome = error "Not implemented" world
concat :: [[.a]] -> [.a]
concat xss = foldr (++) [] xss
startPBB :: [.Char] -> BBArgs
startPBB args = case filter (\(xs, _) -> xs == []) (begin pBB args) of
[] -> {force_rebuild = False, proj_path = Nothing, args = [] }
[] -> {force_rebuild = False, filename = Nothing, args = [] }
[(_, as):_] -> as
pBB :: CParser Char BBArgs BBArgs
pBB = pForce <&> \f -> pFilename <&> \p -> <*> (sp pArgs) <@ \fs -> {force_rebuild = f, proj_path = p, args = fs}
pBB = pForce <&> \f -> pFilename <&> \p -> <*> (sp pArgs) <@ \fs -> {force_rebuild = f, filename = p, args = fs}
pForce :: CParser Char Bool BBArgs
pForce = pBoolLongOpt "force" <@ const True <|> yield False
......@@ -88,39 +174,37 @@ pNotSpace = sp (<+> (satisfy (not o isWhite)))
pBoolLongOpt long = pLongOpt long <@ const (BBBool long)
pBoolShortOpt short = pShortOpt short <@ const (BBBool short)
pIntOpt long short = pIntLongOpt long <|> pIntShortOpt short
//pBoolShortOpt short = pShortOpt short <@ const (BBBool short)
pIntLongOpt long = pLongOpt long &> sp int <@ BBInt long
pIntShortOpt short = pShortOpt short &> sp int <@ BBInt short
//pIntShortOpt short = pShortOpt short &> sp int <@ BBInt short
pStringLongOpt long = pLongOpt long &> sp pNotSpace <@ \s -> BBString long (toString s)
pStringShortOpt short = pShortOpt short &> sp pNotSpace <@ BBString short o toString
//pStringShortOpt short = pShortOpt short &> sp pNotSpace <@ BBString short o toString
pLongOpt long = sptoken (fromString "--") &> token (fromString long) <& (<?> (spsymbol '='))
pShortOpt short = spsymbol '-' &> token (fromString short) <& (<?> (spsymbol '='))
//pShortOpt short = spsymbol '-' &> token (fromString short) <& (<?> (spsymbol '='))
pinit :: .Bool *GeneralSt -> *GeneralSt
pinit force_rebuild ps
= BringProjectUptoDate force_rebuild cleanup ps
= BringProjectUptoDate force_rebuild cleanup ps
where
cleanup exepath bool1 bool2 ps
= abortLog False "" ps
cleanup exepath bool1 bool2 ps
= abortLog False "" ps
wAbort :: {#.Char} *World -> .World
wAbort message world
// # (console,world) = stdio world
// # console = console <<< message
// # (_,world) = fclose console world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
# world = set_return_code_world (-1) world
= finish world
// # (console,world) = stdio world
// # console = console <<< message
// # (_,world) = fclose console world
# stderr = fwrites message stderr
# (ok,world) = fclose stderr world
# world = set_return_code_world (-1) world
= finish world
//finish :: !*World -> String
//finish _ = ""
......
Supports Markdown
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