Commit a0049718 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Revert changes to BatchBuild.icl in favour of a separate tool (to be committed)

parent 96b18ae0
module BatchBuild
import StdEnv
import ArgEnv
from File import fileExists
import FilePath
import Func
import GenEq
import IdeState
import ParserCombinators
from Platform import application_path
import PmDriver
import PmEnvironment, logfile, set_return_code
import PmProject
import StdEnv
import StdListExtensions
import Tuple
import IdeState
from UtilIO import GetFullApplicationPath,GetLongPathName
import PmEnvironment, logfile, set_return_code
from Platform import application_path
// TODO: Remove MaybeError(String) and import from platform
:: MaybeError a b = Error a | Ok b
:: MaybeErrorString a :== MaybeError String a
// END TODO
:: BBArgs =
{ force_rebuild :: Bool
, filename :: Maybe String
, args :: [BBArg] }
:: BBArg = BBBool String | BBString String String | BBInt String Int
derive gEq BBArg
Start :: *World -> *World
Start world
# commandline = getCommandLine
cl = intersperse " " (tl [arg \\ arg <-: commandline])
argsrec = startPBB (concat [fromString c \\ c <- cl])
# (pwd, world) = accFiles GetFullApplicationPath world
# cleanhome = case getStringArg "cleanhome" argsrec.args of
(Just nm) -> nm
Nothing -> case getEnvironmentVariable "CLEAN_HOME" of
(EnvironmentVariable ch) -> ch
_ -> pwd
| isNothing argsrec.filename = showUsage world
= case getStringArg "action" argsrec.args of
(Just "create") -> createProject world argsrec.filename cleanhome
(Just "show") -> showProject world argsrec.filename cleanhome
//(Just "addpath") -> addPath world argsrec.filename cleanhome
//(Just "removepath") -> removePath world argsrec cleanhome
_ -> buildProject world argsrec cleanhome
showUsage :: !*World -> *World
showUsage world = show
[ "BatchBuild"
, "Usage: BatchBuild [--force] filename [--action=ARG] [--envsfile=ARG] [--cleanhome=ARG]"
, " --action : Execute a specific action. Possible actions:"
, " build : Build a project (default)."
, " create : Create a basic project file for a module."
, " show : Summarize the contents of a project file."
, " --envsfile : Specify an environments file (defaults to 'IDEEnvs')"
, " --cleanhome : Specify the Clean directory (defaults to '.')."
, " Alternatively, specify $CLEAN_HOME in your environment."
] world
buildProject :: *World BBArgs String -> *World
buildProject world {force_rebuild=force_rebuild, filename=filename, args=args} cleanhome
# envsfile = case getStringArg "envsfile" args of
(Just p) -> application_path p
_ -> application_path EnvsFileName
# (envs, world) = openEnvironments cleanhome envsfile world
# ((proj, ok, err), world) = accFiles (ReadProjectFile (fromJust filename) cleanhome) 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 cleanhome (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
# commandline = getCommandLine
args = [arg \\ arg <-: commandline]
(path_ok,force_rebuild,proj_path)
= case args of
[_,prj]
-> (True,False,GetLongPathName prj)
[_,"--force",prj]
-> (True,True,GetLongPathName prj)
_
-> (False,False,"")
# (startup,world) = accFiles GetFullApplicationPath world
# envspath = application_path EnvsFileName
# (envs,world) = openEnvironments startup envspath world
// | not ok = wAbort ("Unable to read environments\n") world
| not path_ok = wAbort ("BatchBuild\nUse as: 'BatchBuild [--force] projectname.prj'\n") world
# ((proj,ok,err),world) = accFiles (ReadProjectFile proj_path startup) world
| not ok || err <> "" = wAbort ("BatchBuild failed while opening project: "+++.err+++."\n") world
# (ok,logfile,world) = openLogfile proj_path world
| not ok = wAbort ("BatchBuild failed while opening logfile.\n") world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options startup proj_path proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls,gst_world} = pinit force_rebuild ps
= finish gst_world
startPBB :: [.Char] -> BBArgs
startPBB args = case filter (\(xs, _) -> xs == []) (begin pBB args) of
[(_, as):_] -> as
_ -> {force_rebuild = False, filename = Nothing, args = [] }
pBB :: CParser Char BBArgs BBArgs
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
pFilename :: CParser Char (Maybe String) BBArgs
pFilename = (pNotSpace <@ Just o toString) <!> yield Nothing
pArgs :: CParser Char BBArg BBArgs
pArgs = pStringLongOpt "envsfile"
<|> pBoolLongOpt "force"
<|> pStringLongOpt "action"
<|> pStringLongOpt "cleanhome"
hasFlag :: String [BBArg] -> Bool
hasFlag _ [] = False
hasFlag flag [(BBBool x):xs] = flag === x || hasFlag flag xs
hasFlag flag [_:xs] = hasFlag flag xs
getStringArg :: String [BBArg] -> Maybe String
getStringArg _ [] = Nothing
getStringArg arg [BBString x v:xs]
| arg === x = Just v
getStringArg arg [_:xs] = getStringArg arg xs
getIntArg :: String [BBArg] -> Maybe Int
getIntArg _ [] = Nothing
getIntArg arg [BBInt x v:xs]
| arg === x = Just v
getIntArg arg [_:xs] = getIntArg arg xs
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))
pBoolLongOpt :: String -> CParser Char BBArg a
pBoolLongOpt long = pLongOpt long <@ const (BBBool long)
pBoolShortOpt :: String -> CParser Char BBArg a
pBoolShortOpt short = pShortOpt short <@ const (BBBool short)
pIntLongOpt :: String -> CParser Char BBArg a
pIntLongOpt long = pLongOpt long &> sp int <@ BBInt long
pIntShortOpt :: String -> CParser Char BBArg a
pIntShortOpt short = pShortOpt short &> sp int <@ BBInt short
pStringLongOpt :: String -> CParser Char BBArg a
pStringLongOpt long = pLongOpt long &> sp pNotSpace <@ BBString long o toString
pStringShortOpt :: String -> CParser Char BBArg a
pStringShortOpt short = pShortOpt short &> sp pNotSpace <@ BBString short o toString
pLongOpt :: String -> CParser Char [Char] a
pLongOpt long = sptoken (fromString "--") &> token (fromString long) <& (<?> (spsymbol '='))
pShortOpt :: String -> CParser Char [Char] a
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 _ = ""
finish :: .a -> .a
finish w = w
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