Cpm.icl 9.93 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
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
18
import StdEnv, StdFile
19
20
21
22
import Text
import UtilIO
import UtilStrictLists

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
23
:: CpmAction
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
  =  Project FilePath ProjectAction
  |  Module String ModuleAction
  |  Help

:: ProjectAction
  =  CreateProject
  |  ShowProject
  |  BuildProject Bool FilePath
  |  ProjectPath PathAction
  |  ProjectHelp

:: PathAction
  =  AddPathAction String
  |  RemovePathAction String

:: ModuleAction
40
  =  CreateModule ModuleType
41
42
  |  ModuleHelp

43
44
45
46
:: ModuleType
  =  ApplicationModule
  |  LibraryModule

47
48
49
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
50
51
pCpm :: CParser Char CpmAction a
pCpm = pProject <|> pModule <!> yield Help
52
53
54
55

spstrtok :: (String -> CParser Char [Char] a)
spstrtok = sptoken o fromString

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
56
pProject :: CParser Char CpmAction a
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
57
58
59
pProject = spstrtok "project" &> pNotSpace <&> \pn -> (pProjectAction <!> yield ProjectHelp) <@ Project (toString pn)
  where  pProjectAction  =  spstrtok "create"                                       <@ const CreateProject
                       <|>  spstrtok "show"                                         <@ const ShowProject
60
                       <|>  spstrtok "build"   &>  pForce       <&> \ f-> pIDEEnvs  <@ BuildProject f
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
61
                       <|>  spstrtok "path"    &>  pPathAction                      <@ ProjectPath
62
63
64
65
66
67
68
69
70
         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

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
71
pModule :: CParser Char CpmAction a
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
72
pModule = spstrtok "module" &> pNotSpace <&> \mn -> (pModuleAction <!> yield ModuleHelp) <@ Module (toString mn)
73
74
  where  pModuleAction  =  spstrtok "create" &> pModuleType <@ CreateModule
         pModuleType    =  spstrtok "application" <@ const ApplicationModule <|> yield LibraryModule
75
76
77
78
79
80
81
82
83
84

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)
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
85
  = doCpmAction world ch pwd cpm
86

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
87
88
startParse :: [.Char] -> CpmAction
startParse args =  case filter (\(xs, _) -> xs == []) (begin pCpm args) of
89
90
91
                     [(_, as):_]  -> as
                     _            -> Help

Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
92
93
94
doCpmAction :: *World String String .CpmAction -> .World
doCpmAction world cleanhome  pwd  (Project pn pa)  = doProjectAction world cleanhome pwd pn pa
doCpmAction world cleanhome  pwd  (Module mn ma)   = doModuleAction world cleanhome mn ma
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
95
doCpmAction world _          _    _                =
96
97
  help  "cpm <target>"
    [  "Where <target> is one of the following:"
98
    ,  "  project <projectname>  : project actions"
99
    ,  "  module <modulename>    : module actions"
100
101
    ,  ""
    ,  "Execute `cpm <target> help` to get help for specific actions."] world
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

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
117
118
  # (prjok, world)    = accFiles (SaveProjectFile projectfile project cleanhome) world
  | not prjok         = error ("Could not create project file " +++ projectfile) world
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
  = 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
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
138
  | not ok || err <> ""        = error ("CPM failed while opening project: "+++.err+++."\n") world
139
  # (ok, logfile, world)       = openLogfile pn world
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
140
  | not ok                     = error ("CPM failed while opening logfile.\n") world
141
142
143
144
145
146
147
  # 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
Jurrien Stutterheim's avatar
Jurrien Stutterheim committed
148
doProjectAction world _          _  _   _                 =
149
  help "cpm project <projectname> <action>"
150
    [  "Where <action> is one of the following"
151
152
153
154
155
    ,  "  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 <add|remove>                   : add or remove a path from the project"] world
156
157
158
159
160
161
162
163
164
165

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)
166
         = show ["Paths" +++ toString (length paths)] world
167
168
169
170
171
172
173
174
175
176

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
177
doModuleAction world cleanhome mn  (CreateModule mt)
178
  # (dclexists, world)  = fileExists dclnm world
179
  | dclexists           = dexerr world
180
  # (iclexists, world)  = fileExists iclnm world
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
  | iclexists           = iexerr world
  = writeMods world mt
  where  basenm     = dropExtension mn
         dclnm      = addExtension basenm "dcl"
         iclnm      = addExtension basenm "icl"

         mkmod mty  = mty +++ "module " +++ basenm

         writeMods world ApplicationModule  = writeicl world ApplicationModule
         writeMods world LibraryModule
           # world = writeicl world ApplicationModule
           = writedcl world

         writeicl world ApplicationModule = writeicl` world "implementation "

         writeicl world LibraryModule = writeicl` world ""

         writeicl` world pref = writemod world iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'")

         writedcl world = writemod world dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'")

         writemod world nm pref errmsg
           # (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
209
210

doModuleAction world _ _   _                  =
211
212
213
  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
214
215
216
217
218
219
220
221

error :: {#.Char} *World -> .World
error message world
  # stderr      = fwrites message stderr
  # (ok,world)  = fclose stderr world
  # world       = set_return_code_world (-1) world
  = world

222
223
224
225
226
227
228
229
230
help :: !String ![String] !*World -> *World
help cmd lines world = show lines` world
  where lines` = [  "CPM: Clean Project Management"
                 :  ""
                 :  "Usage: " +++ cmd
                 :  lines]

show :: ![String] !*World -> *World
show lines world
231
232
233
234
235
236
237
238
239
240
241
242
243
  # (console,world)  = stdio world
  # console          = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
  # (_,world)        = fclose console world
  = 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