Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
cd4b2686
Commit
cd4b2686
authored
Aug 23, 2018
by
John van Groningen
Browse files
remove dependencies on the platform library (use other functions and remove imports)
parent
7fa74e04
Changes
6
Hide whitespace changes
Inline
Side-by-side
cpm/AbsSyn.dcl
View file @
cd4b2686
definition
module
AbsSyn
from
System
.
FilePath
import
::
FilePath
from
PmTypes
import
::
Output
::
FilePath
:==
Pathname
from
PmTypes
import
::
Pathname
,::
Output
/**
* Datatypes
...
...
cpm/AbsSyn.icl
View file @
cd4b2686
implementation
module
AbsSyn
from
System
.
FilePath
import
::
FilePath
from
PmTypes
import
::
Output
::
FilePath
:==
Pathname
from
PmTypes
import
::
Pathname
,::
Output
cpm/Cpm.icl
View file @
cd4b2686
...
...
@@ -8,26 +8,20 @@
module
Cpm
/**
* CPM imports
*/
import
AbsSyn
,
CpmLogic
,
Parser
/**
* CleanIDE imports
* Clean libraries imports
*/
import
UtilIO
import
StdEnv
,
ArgEnv
from
Platform
import
DirSeparatorString
/**
* C
lean Platform
imports
* C
PM
imports
*/
import
System
.
CommandLine
,
System
.
Environment
,
System
.
Directory
,
System
.
FilePath
import
Data
.
Error
,
Data
.
Func
,
Data
.
List
import
Text
import
Parser
,
CpmLogic
/**
* Clean
libraries
imports
* Clean
IDE
imports
*/
import
StdFile
,
StdString
,
StdMisc
from
UtilIO
import
GetCurrentDirectory
,
GetFullApplicationPath
,
GetLongPathName
/**
* Start function which reads the program arguments, starts the parser and
...
...
@@ -35,13 +29,14 @@ import StdFile, StdString, StdMisc
*/
Start
::
*
World
->
*
World
Start
world
#
(
cmd
,
world
)
=
getCommandLine
world
(
mpwd
,
world
)
=
getCurrentDirectory
world
(
cpmd
,
world
)
=
accFiles
GetFullApplicationPath
world
cleandir
=
if
(
endsWith
"bin"
cpmd
)
(
takeDirectory
cpmd
)
cpmd
(
ch
,
world
)
=
case
getEnvironmentVariable
"CLEAN_HOME"
world
of
(
Just
ch
,
world
)
->
(
ch
,
world
)
(_,
world
)
->
(
cleandir
,
world
)
=
case
mpwd
of
Ok
pwd
->
doCpmAction
cleandir
pwd
(
parseCpmLogic
cmd
)
world
Error
e
->
abort
"Failed to read current directory"
#
commandline
=
getCommandLine
args
=
[
arg
\\
arg
<-:
commandline
]
(
pwd_ok
,
pwd
)
=
GetCurrentDirectory
(
cpmd
,
world
)
=
accFiles
GetFullApplicationPath
world
cleandir
=
if
(
cpmd
%
(
size
cpmd
-4
,
size
cpmd
-1
)==
DirSeparatorString
+++
"bin"
)
(
cpmd
%
(
0
,
size
cpmd
-5
))
cpmd
ch
=
case
getEnvironmentVariable
"CLEAN_HOME"
of
EnvironmentVariable
ch
->
ch
EnvironmentVariableUndefined
->
cleandir
|
pwd_ok
=
doCpmAction
cleandir
pwd
(
parseCpmLogic
args
)
world
=
abort
"Failed to read current directory"
cpm/CpmLogic.icl
View file @
cd4b2686
...
...
@@ -3,25 +3,19 @@ implementation module CpmLogic
/**
* Clean libraries imports
*/
import
Std
Bool
,
StdEnum
,
StdMisc
,
StdTuple
,
StdArray
,
StdFunctions
,
StdStrictLists
import
Std
Env
from
StdOverloadedList
import
++|,
Last
,
Init
,
RemoveAt
,
SplitAt
,
instance
length
[!!]
import
set_return_code
,
Directory
/**
* CPM imports
*/
import
AbsSyn
,
CpmPaths
import
AbsSyn
,
CpmPaths
/**
* CleanIDE imports
*/
import
IdeState
,
logfile
,
PmDriver
,
PmEnvironment
,
PmProject
,
set_return_code
,
UtilIO
,
UtilStrictLists
/**
* Clean Platform imports
*/
import
Text
import
Data
.
Func
,
Data
.
Error
,
Data
.
List
import
System
.
Directory
,
System
.
File
,
System
.
FilePath
import
UtilIO
,
IdeState
,
Platform
,
PmPath
,
PmEnvironment
,
PmProject
,
PmDriver
/**
* Execute a general CPM action
...
...
@@ -49,12 +43,17 @@ doCpmAction _ _ _ world =
*/
doMake
::
String
!
String
!*
World
->
*
World
doMake
cleanhome
pwd
world
#
(
mbErr
,
world
)
=
readDirectory
pwd
world
=
case
mbErr
of
Error
_
->
error
"Failed to read current directory"
world
Ok
entries
->
case
filter
(\
entry
->
endsWith
".prj"
entry
)
entries
of
[]
->
error
(
"No project file found in "
+++
pwd
)
world
xs
->
foldr
(\
pn
->
doProjectAction
cleanhome
pwd
pn
(
BuildProject
False
EnvsFileName
))
world
xs
#
((
ok
,
pwd_path
),
world
)
=
pd_StringToPath
pwd
world
|
not
ok
=
error
"Failed to read current directory"
world
#
((
err
,
entries
),
world
)
=
getDirectoryContents
pwd_path
world
|
err
<>
NoDirError
=
error
"Failed to read current directory"
world
#
xs
=
[
e
\\
{
fileName
=
e
}<-
entries
|
size
e
>=
4
&&
e
.[
size
e
-4
]==
'.'
&&
e
.[
size
e
-3
]==
'p'
&&
e
.[
size
e
-2
]==
'r'
&&
e
.[
size
e
-1
]==
'j'
]
|
isEmpty
xs
=
error
(
"No project file found in "
+++
pwd
)
world
=
foldr
(\
pn
->
doProjectAction
cleanhome
pwd
pn
(
BuildProject
False
EnvsFileName
))
world
xs
/**
* Default compiler options. Currently it is a simple alias for
...
...
@@ -76,7 +75,7 @@ getLine world
doProjectAction
::
String
String
String
ProjectAction
*
World
->
*
World
doProjectAction
cleanhome
pwd
pn
CreateProject
world
//Check if main module exists
#
(
exists
,
world
)
=
file
Exists
mainmodule
world
#
(
exists
,
world
)
=
accFiles
(
F
Exists
mainmodule
)
world
|
not
exists
// = error ("Main module " +++ mainmodule +++ " does not exist.") world
#
world
=
showLines
[
"Main module "
+++
mainmodule
+++
" does not exist. Create it? [y/n]"
]
world
#
(
line
,
world
)
=
getLine
world
...
...
@@ -84,8 +83,7 @@ doProjectAction cleanhome pwd pn CreateProject world
|
otherwise
=
error
(
"Failed to create project. Need "
+++
mainmodule
)
world
|
otherwise
=
mkProject
world
where
basefilename
=
dropExtension
pn
mainmodule
=
addExtension
basefilename
"icl"
mainmodule
=
MakeImpPathname
pn
mkMainAndProject
world
#
world
=
doModuleAction
""
mainmodule
(
CreateModule
ApplicationModule
)
world
...
...
@@ -96,7 +94,7 @@ doProjectAction cleanhome pwd pn CreateProject world
#
prj
=
PR_NewProject
mainmodule
edit_options
compilerOptions
DefCodeGenOptions
DefApplicationOptions
[!!]
DefaultLinkOptions
#
project
=
PR_SetRoot
mainmodule
edit_options
compilerOptions
prj
#
projectfile
=
addExtension
basefilename
"prj"
#
projectfile
=
MakeImpPathname
pn
=
saveProject
cleanhome
pwd
project
projectfile
world
doProjectAction
cleanhome
pwd
pn
ShowProject
world
...
...
@@ -275,12 +273,18 @@ doModPaths cleanhome pwd pn project f world
#
world
=
saveProject
cleanhome
pwd
prj
pn
world
=
showLines
[
"Successfully modified project paths"
]
world
append_dir_separator
::
!{#
Char
}
->
{#
Char
}
append_dir_separator
s
|
size
s
>
0
&&
s
.[
size
s
-1
]==
DirSeparator
=
s
=
s
+++
DirSeparatorString
/**
* Open a project file
*/
openProject
::
!
FilePath
!
FilePath
!
FilePath
!*
World
->
(!
FilePath
,
!
Project
,
Bool
,
!*
World
)
openProject
pwd
pn
cleanhome
world
#
proj_path
=
GetLongPathName
(
pwd
</>
pn
)
#
proj_path
=
GetLongPathName
(
append_dir_separator
pwd
+++
pn
)
#
((
prj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
proj_path
cleanhome
)
world
|
not
ok
||
err
<>
""
=
(
proj_path
,
prj
,
ok
,
error
err
world
)
...
...
@@ -321,15 +325,15 @@ moveStrictListIdx i dir xs
*/
doModuleAction
::
String
!
String
!
ModuleAction
!*
World
->
*
World
doModuleAction
_
mn
(
CreateModule
mt
)
world
#
(
dclexists
,
world
)
=
file
Exists
dclnm
world
#
(
dclexists
,
world
)
=
accFiles
(
F
Exists
dclnm
)
world
|
dclexists
=
error
(
"Definition module '"
+++
dclnm
+++
"' already exists."
)
world
#
(
iclexists
,
world
)
=
file
Exists
iclnm
world
#
(
iclexists
,
world
)
=
accFiles
(
F
Exists
iclnm
)
world
|
iclexists
=
error
(
"Implementation module '"
+++
iclnm
+++
"' already exists."
)
world
=
writeMods
mt
world
where
base
nm
=
dropExtension
mn
d
clnm
=
addExtension
basenm
"dcl"
icl
nm
=
addExtension
basenm
"icl"
dcl
nm
=
MakeDefPathname
mn
i
clnm
=
MakeImpPathname
mn
base
nm
=
iclnm
%
(
0
,
size
iclnm
-5
)
mkmod
mty
=
mty
+++
"module "
+++
basenm
...
...
@@ -346,9 +350,14 @@ doModuleAction _ mn (CreateModule mt) 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
#
(
ok
,
file
,
world
)
=
fopen
nm
FWriteText
world
|
not
ok
=
error
errmsg
world
#
file
=
fwrites
(
mkmod
pref
)
file
(
ok
,
world
)
=
fclose
file
world
|
not
ok
=
error
errmsg
world
=
world
doModuleAction
_
_
_
world
=
help
"cpm module <modulename> <action>"
...
...
@@ -385,5 +394,5 @@ help cmd lines world
showLines
::
![
String
]
!*
World
->
*
World
showLines
lines
world
#
(
console
,
world
)
=
stdio
world
#
console
=
seqSt
(\
s
->
fwrites
(
s
+++
"
\n
"
))
lines
console
=
snd
$
fclose
console
world
#
console
=
foldl
(\
file
s
->
fwritec
'\n'
(
fwrites
s
file
))
console
lines
=
snd
(
fclose
console
world
)
cpm/Posix/CpmPaths.icl
View file @
cd4b2686
implementation
module
CpmPaths
import
PmEnvironment
import
System
.
FilePath
import
StdEnv
,
Platform
,
PmEnvironment
readIDEEnvs
::
!
String
!
String
!*
World
->
*([
Target
],
*
World
)
readIDEEnvs
cleanhome
ideenvs
world
=
openEnvironments
cleanhome
(
cleanhome
</>
"etc"
</>
ideenvs
)
world
append_dir_separator
::
!{#
Char
}
->
{#
Char
}
append_dir_separator
s
|
size
s
>
0
&&
s
.[
size
s
-1
]==
DirSeparator
=
s
=
s
+++
DirSeparatorString
readIDEEnvs
::
!
String
!
String
!*
World
->
*([
Target
],
*
World
)
readIDEEnvs
cleanhome
ideenvs
world
=
openEnvironments
cleanhome
(
append_dir_separator
cleanhome
+++
"etc"
+++
DirSeparatorString
+++
ideenvs
)
world
cpm/Windows/CpmPaths.icl
View file @
cd4b2686
implementation
module
CpmPaths
import
PmEnvironment
import
System
.
FilePath
import
StdEnv
,
Platform
,
PmEnvironment
append_dir_separator
::
!{#
Char
}
->
{#
Char
}
append_dir_separator
s
|
size
s
>
0
&&
s
.[
size
s
-1
]==
DirSeparator
=
s
=
s
+++
DirSeparatorString
readIDEEnvs
::
!
String
!
String
!*
World
->
*([
Target
],
*
World
)
readIDEEnvs
cleanhome
ideenvs
world
=
openEnvironments
cleanhome
(
cleanhome
</>
"Config"
</>
ideenvs
)
world
readIDEEnvs
cleanhome
ideenvs
world
=
openEnvironments
cleanhome
(
append_dir_separator
cleanhome
+++
"Config"
+++
DirSeparatorString
+++
ideenvs
)
world
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment