CpmLogic.icl 11.4 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
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
  # (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 ((:!) path) 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
  = set_return_code_world (-1) 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
  = snd $ fclose console world

// 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