Initial compiling result of adding project management capabilities to

batchbuild

BatchBuild/BatchBuild.icl

 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 _ = ""