Commit cd4b2686 authored by John van Groningen's avatar John van Groningen
Browse files

remove dependencies on the platform library (use other functions and remove imports)

parent 7fa74e04
definition module AbsSyn definition module AbsSyn
from System.FilePath import :: FilePath :: FilePath:==Pathname
from PmTypes import :: Output from PmTypes import ::Pathname,::Output
/** /**
* Datatypes * Datatypes
......
implementation module AbsSyn implementation module AbsSyn
from System.FilePath import :: FilePath :: FilePath:==Pathname
from PmTypes import :: Output from PmTypes import ::Pathname,::Output
...@@ -8,26 +8,20 @@ ...@@ -8,26 +8,20 @@
module Cpm module Cpm
/** /**
* CPM imports * Clean libraries imports
*/
import AbsSyn, CpmLogic, Parser
/**
* CleanIDE imports
*/ */
import UtilIO import StdEnv,ArgEnv
from Platform import DirSeparatorString
/** /**
* Clean Platform imports * CPM imports
*/ */
import System.CommandLine, System.Environment, System.Directory, System.FilePath import Parser,CpmLogic
import Data.Error, Data.Func, Data.List
import Text
/** /**
* Clean libraries imports * CleanIDE imports
*/ */
import StdFile, StdString, StdMisc from UtilIO import GetCurrentDirectory,GetFullApplicationPath,GetLongPathName
/** /**
* Start function which reads the program arguments, starts the parser and * Start function which reads the program arguments, starts the parser and
...@@ -35,13 +29,14 @@ import StdFile, StdString, StdMisc ...@@ -35,13 +29,14 @@ import StdFile, StdString, StdMisc
*/ */
Start :: *World -> *World Start :: *World -> *World
Start world Start world
# (cmd, world) = getCommandLine world # commandline = getCommandLine
(mpwd, world) = getCurrentDirectory world args = [arg \\ arg <-: commandline]
(cpmd, world) = accFiles GetFullApplicationPath world (pwd_ok,pwd) = GetCurrentDirectory
cleandir = if (endsWith "bin" cpmd) (takeDirectory cpmd) cpmd (cpmd, world) = accFiles GetFullApplicationPath world
(ch, world) = case getEnvironmentVariable "CLEAN_HOME" world of cleandir = if (cpmd % (size cpmd-4,size cpmd-1)==DirSeparatorString+++"bin") (cpmd % (0,size cpmd-5)) cpmd
(Just ch, world) -> (ch, world) ch = case getEnvironmentVariable "CLEAN_HOME" of
(_, world) -> (cleandir, world) EnvironmentVariable ch -> ch
= case mpwd of EnvironmentVariableUndefined -> cleandir
Ok pwd -> doCpmAction cleandir pwd (parseCpmLogic cmd) world | pwd_ok
Error e -> abort "Failed to read current directory" = doCpmAction cleandir pwd (parseCpmLogic args) world
= abort "Failed to read current directory"
...@@ -3,25 +3,19 @@ implementation module CpmLogic ...@@ -3,25 +3,19 @@ implementation module CpmLogic
/** /**
* Clean libraries imports * Clean libraries imports
*/ */
import StdBool, StdEnum, StdMisc, StdTuple, StdArray, StdFunctions, StdStrictLists import StdEnv
from StdOverloadedList import ++|,Last,Init,RemoveAt,SplitAt,instance length [!!] from StdOverloadedList import ++|,Last,Init,RemoveAt,SplitAt,instance length [!!]
import set_return_code,Directory
/** /**
* CPM imports * CPM imports
*/ */
import AbsSyn, CpmPaths import AbsSyn,CpmPaths
/** /**
* CleanIDE imports * CleanIDE imports
*/ */
import IdeState, logfile, PmDriver, PmEnvironment, PmProject, set_return_code, UtilIO, UtilStrictLists import UtilIO,IdeState,Platform,PmPath,PmEnvironment,PmProject,PmDriver
/**
* Clean Platform imports
*/
import Text
import Data.Func, Data.Error, Data.List
import System.Directory, System.File, System.FilePath
/** /**
* Execute a general CPM action * Execute a general CPM action
...@@ -49,12 +43,17 @@ doCpmAction _ _ _ world = ...@@ -49,12 +43,17 @@ doCpmAction _ _ _ world =
*/ */
doMake :: String !String !*World -> *World doMake :: String !String !*World -> *World
doMake cleanhome pwd world doMake cleanhome pwd world
# (mbErr, world) = readDirectory pwd world # ((ok,pwd_path),world) = pd_StringToPath pwd world
= case mbErr of | not ok
Error _ -> error "Failed to read current directory" world = error "Failed to read current directory" world
Ok entries -> case filter (\entry -> endsWith ".prj" entry) entries of # ((err,entries), world) = getDirectoryContents pwd_path world
[] -> error ("No project file found in " +++ pwd) world | err<>NoDirError
xs -> foldr (\pn -> doProjectAction cleanhome pwd pn (BuildProject False EnvsFileName)) world xs = 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 * Default compiler options. Currently it is a simple alias for
...@@ -76,7 +75,7 @@ getLine world ...@@ -76,7 +75,7 @@ getLine world
doProjectAction :: String String String ProjectAction *World -> *World doProjectAction :: String String String ProjectAction *World -> *World
doProjectAction cleanhome pwd pn CreateProject world doProjectAction cleanhome pwd pn CreateProject world
//Check if main module exists //Check if main module exists
# (exists,world) = fileExists mainmodule world # (exists,world) = accFiles (FExists mainmodule) world
| not exists // = error ("Main module " +++ mainmodule +++ " does not exist.") world | not exists // = error ("Main module " +++ mainmodule +++ " does not exist.") world
# world = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world # world = showLines ["Main module " +++ mainmodule +++ " does not exist. Create it? [y/n]"] world
# (line, world) = getLine world # (line, world) = getLine world
...@@ -84,8 +83,7 @@ doProjectAction cleanhome pwd pn CreateProject world ...@@ -84,8 +83,7 @@ doProjectAction cleanhome pwd pn CreateProject world
| otherwise = error ("Failed to create project. Need " +++ mainmodule) world | otherwise = error ("Failed to create project. Need " +++ mainmodule) world
| otherwise = mkProject world | otherwise = mkProject world
where where
basefilename = dropExtension pn mainmodule = MakeImpPathname pn
mainmodule = addExtension basefilename "icl"
mkMainAndProject world mkMainAndProject world
# world = doModuleAction "" mainmodule (CreateModule ApplicationModule) world # world = doModuleAction "" mainmodule (CreateModule ApplicationModule) world
...@@ -96,7 +94,7 @@ doProjectAction cleanhome pwd pn CreateProject world ...@@ -96,7 +94,7 @@ doProjectAction cleanhome pwd pn CreateProject world
# prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions # prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions DefApplicationOptions [!!] DefaultLinkOptions
# project = PR_SetRoot mainmodule edit_options compilerOptions prj # project = PR_SetRoot mainmodule edit_options compilerOptions prj
# projectfile = addExtension basefilename "prj" # projectfile = MakeImpPathname pn
= saveProject cleanhome pwd project projectfile world = saveProject cleanhome pwd project projectfile world
doProjectAction cleanhome pwd pn ShowProject world doProjectAction cleanhome pwd pn ShowProject world
...@@ -275,12 +273,18 @@ doModPaths cleanhome pwd pn project f world ...@@ -275,12 +273,18 @@ doModPaths cleanhome pwd pn project f world
# world = saveProject cleanhome pwd prj pn world # world = saveProject cleanhome pwd prj pn world
= showLines ["Successfully modified project paths"] 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 * Open a project file
*/ */
openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World) openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World)
openProject pwd pn cleanhome 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 # ((prj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
| not ok || err <> "" | not ok || err <> ""
= (proj_path, prj, ok, error err world) = (proj_path, prj, ok, error err world)
...@@ -321,15 +325,15 @@ moveStrictListIdx i dir xs ...@@ -321,15 +325,15 @@ moveStrictListIdx i dir xs
*/ */
doModuleAction :: String !String !ModuleAction !*World -> *World doModuleAction :: String !String !ModuleAction !*World -> *World
doModuleAction _ mn (CreateModule mt) world doModuleAction _ mn (CreateModule mt) world
# (dclexists, world) = fileExists dclnm world # (dclexists, world) = accFiles (FExists dclnm) world
| dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world | dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world
# (iclexists, world) = fileExists iclnm world # (iclexists, world) = accFiles (FExists iclnm) world
| iclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world | iclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
= writeMods mt world = writeMods mt world
where where
basenm = dropExtension mn dclnm = MakeDefPathname mn
dclnm = addExtension basenm "dcl" iclnm = MakeImpPathname mn
iclnm = addExtension basenm "icl" basenm = iclnm % (0,size iclnm-5)
mkmod mty = mty +++ "module " +++ basenm mkmod mty = mty +++ "module " +++ basenm
...@@ -346,9 +350,14 @@ doModuleAction _ mn (CreateModule mt) world ...@@ -346,9 +350,14 @@ doModuleAction _ mn (CreateModule mt) world
writedcl world = writemod dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'") world writedcl world = writemod dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'") world
writemod nm pref errmsg world writemod nm pref errmsg world
# (me, world) = writeFile nm (mkmod pref) world # (ok,file,world) = fopen nm FWriteText world
| isError me = error errmsg world | not ok
= world = error errmsg world
# file = fwrites (mkmod pref) file
(ok,world) = fclose file world
| not ok
= error errmsg world
= world
doModuleAction _ _ _ world = doModuleAction _ _ _ world =
help "cpm module <modulename> <action>" help "cpm module <modulename> <action>"
...@@ -385,5 +394,5 @@ help cmd lines world ...@@ -385,5 +394,5 @@ help cmd lines world
showLines :: ![String] !*World -> *World showLines :: ![String] !*World -> *World
showLines lines world showLines lines world
# (console, world) = stdio world # (console, world) = stdio world
# console = seqSt (\s -> fwrites (s +++ "\n")) lines console # console = foldl (\file s -> fwritec '\n' (fwrites s file)) console lines
= snd $ fclose console world = snd (fclose console world)
implementation module CpmPaths implementation module CpmPaths
import PmEnvironment import StdEnv,Platform,PmEnvironment
import System.FilePath
readIDEEnvs :: !String !String !*World -> *([Target], *World) append_dir_separator :: !{#Char} -> {#Char}
readIDEEnvs cleanhome ideenvs world = openEnvironments cleanhome (cleanhome </> "etc" </> ideenvs) world 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
implementation module CpmPaths implementation module CpmPaths
import PmEnvironment import StdEnv,Platform,PmEnvironment
import System.FilePath
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 :: !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
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