Working make command

4 files changed, 206 insertions, 33 deletions

diff --git a/CLPM/Package.dcl b/CLPM/Package.dcl
index 2a476a7..9c685d2 100644
--- a/CLPM/Package.dcl
+++ b/CLPM/Package.dcl
@@ -2,26 +2,39 @@ definition module CLPM.Package
 
 from StdFile import class <<<
 
+from Data.Error import :: MaybeError, :: MaybeErrorString
 from Data.Maybe import :: Maybe
 from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
 
-:: StoredPackage
-	= { name    :: Maybe PackageName
-	  , desc    :: Maybe Description
-	  , author  :: Maybe Author
-	  , url     :: Maybe Url
-	  , depends :: Maybe [StoredDependency]
-	  }
+DEFAULT_NAME :== "Unnamed package"
+DEFAULT_DESC :== "Empty description"
+DEFAULT_AUTHOR :== "Unknown author"
+DEFAULT_URL :== "http://clean.cs.ru.nl"
+DEFAULT_MAIN :== "main"
+DEFAULT_PATHS :== ["."]
+DEFAULT_OPTIONS :==
+	{ show_result       = True
+	, show_constructors = True
+	, show_time         = True
+	, heap_size         = 2000
+	, stack_size        = 500
+	, extra_flags       = []
+	}
 
-:: StoredDependency :== (PackageName, StoredPackageSource)
-:: StoredPackageSource :== String
+MODULE_DIR :== "clpm_modules"
+PACKAGE_FILE :== "clpm.json"
+
+:: StoredPackage
 
 :: Package
 	= { name    :: PackageName
 	  , desc    :: Description
 	  , author  :: Author
 	  , url     :: Url
+	  , main    :: Path
 	  , depends :: [Dependency]
+	  , paths   :: [Path]
+	  , options :: Options
 	  }
 
 :: Dependency
@@ -30,14 +43,23 @@ from Text.JSON import :: JSONNode, generic JSONEncode, generic JSONDecode
 	  }
 
 :: PackageSource
-	= GitHub String String GitTag
-	| Git Url GitTag
+	= Git Url GitTag
 	| Download Url
 
+:: Options
+	= { show_result       :: Bool
+	  , show_constructors :: Bool
+	  , show_time         :: Bool
+	  , heap_size         :: Int
+	  , stack_size        :: Int
+	  , extra_flags       :: [String]
+	  }
+
 :: PackageName :== String
 :: Description :== String
 :: Author :== String
 :: Url :== String
+:: Path :== String
 
 :: GitTag
 	= Commit String
@@ -52,7 +74,7 @@ instance <<< Package
 toPackage :: StoredPackage -> Package
 toStoredPackage :: Package -> StoredPackage
 
-DEFAULT_NAME :== "Unnamed package"
-DEFAULT_DESC :== "Empty description"
-DEFAULT_AUTHOR :== "Unknown author"
-DEFAULT_URL :== "http://clean.cs.ru.nl"
+readPackage :: String -> *World -> *(Maybe Package, *World)
+getRecursivePaths :: Package *World -> (MaybeErrorString [Path], *World)
+
+optionsToFlags :: Options -> [String]
diff --git a/CLPM/Package.icl b/CLPM/Package.icl
index 06fae3f..2eee207 100644
--- a/CLPM/Package.icl
+++ b/CLPM/Package.icl
@@ -2,16 +2,49 @@ implementation module CLPM.Package
 
 import _SystemArray
 import StdFile
+from StdFunc import o
 import StdList
 
 import Control.Applicative
+import Control.Monad
+
+import Data.Error
 from Data.Func import $
+import Data.Functor
+import Data.Tuple
+
+import System.File
+import System.FilePath
+
 from Text import class Text(indexOf,subString),
 	instance Text String, instance + String
 import Text.JSON
 
-derive JSONEncode StoredPackage
-derive JSONDecode StoredPackage
+derive JSONEncode StoredPackage, StoredOptions
+derive JSONDecode StoredPackage, StoredOptions
+
+:: StoredPackage
+	= { name    :: Maybe PackageName
+	  , desc    :: Maybe Description
+	  , author  :: Maybe Author
+	  , url     :: Maybe Url
+	  , main    :: Maybe Path
+	  , depends :: Maybe [StoredDependency]
+	  , paths   :: Maybe [Path]
+	  , options :: Maybe StoredOptions
+	  }
+
+:: StoredDependency :== (PackageName, StoredPackageSource)
+:: StoredPackageSource :== String
+
+:: StoredOptions
+	= { show_result       :: Maybe Bool
+	  , show_constructors :: Maybe Bool
+	  , show_time         :: Maybe Bool
+	  , heap_size         :: Maybe Int
+	  , stack_size        :: Maybe Int
+	  , extra_flags       :: Maybe [String]
+	  }
 
 toPackage :: StoredPackage -> Package
 toPackage spkg
@@ -20,7 +53,10 @@ toPackage spkg
 	  , desc    = fromJust $ spkg.StoredPackage.desc <|> Just DEFAULT_DESC
 	  , author  = fromJust $ spkg.StoredPackage.author <|> Just DEFAULT_AUTHOR
 	  , url     = fromJust $ spkg.StoredPackage.url <|> Just DEFAULT_URL
+	  , main    = fromJust $ spkg.StoredPackage.main <|> Just DEFAULT_MAIN
 	  , depends = map toDep $ fromJust $ spkg.StoredPackage.depends <|> Just []
+	  , paths   = fromJust $ spkg.StoredPackage.paths <|> Just DEFAULT_PATHS
+	  , options = toOptions spkg.StoredPackage.options
 	  }
 where
 	toDep :: StoredDependency -> Dependency
@@ -28,11 +64,31 @@ where
 		= { dep_name = name, dep_source = toPackSource src }
 
 	toPackSource :: StoredPackageSource -> PackageSource
-	toPackSource sps = GitHub owner repo Latest
-	where
-		owner = subString 0 slash sps
-		repo  = subString (slash + 1) (size sps - 1) sps
-		slash = indexOf "/" sps
+	toPackSource sps = Git sps Latest
+
+	toOptions :: (Maybe StoredOptions) -> Options
+	toOptions Nothing = DEFAULT_OPTIONS
+	toOptions (Just opts) =
+		{ Options
+		| show_result       = fromJust $
+			opts.StoredOptions.show_result <|>
+			Just DEFAULT_OPTIONS.Options.show_result
+		, show_constructors = fromJust $
+			opts.StoredOptions.show_constructors <|>
+			Just DEFAULT_OPTIONS.Options.show_constructors
+		, show_time = fromJust $
+			opts.StoredOptions.show_time <|>
+			Just DEFAULT_OPTIONS.Options.show_time
+		, heap_size = fromJust $
+			opts.StoredOptions.heap_size <|>
+			Just DEFAULT_OPTIONS.Options.heap_size
+		, stack_size = fromJust $
+			opts.StoredOptions.stack_size <|>
+			Just DEFAULT_OPTIONS.Options.stack_size
+		, extra_flags = fromJust $
+			opts.StoredOptions.extra_flags <|>
+			Just DEFAULT_OPTIONS.Options.extra_flags
+		}
 
 toStoredPackage :: Package -> StoredPackage
 toStoredPackage pkg
@@ -41,18 +97,62 @@ toStoredPackage pkg
 	  , desc    = Just pkg.Package.desc
 	  , author  = Just pkg.Package.author
 	  , url     = Just pkg.Package.url
-	  , depends = case map toStoredDep pkg.Package.depends of
-	    [] = Nothing
-	    ds = Just ds
+	  , main    = Just pkg.Package.main
+	  , depends = listToMaybeList $ map toStoredDep pkg.Package.depends
+	  , paths   = listToMaybeList pkg.Package.paths
+	  , options = Just $ toStoredOpts pkg.Package.options
 	  }
 where
+	listToMaybeList :: [a] -> Maybe [a]
+	listToMaybeList [] = Nothing
+	listToMaybeList xs = Just xs
+
 	toStoredDep :: Dependency -> StoredDependency
 	toStoredDep d = (d.dep_name, toStoredPackSource d.dep_source)
 
 	toStoredPackSource :: PackageSource -> StoredPackageSource
-	toStoredPackSource (GitHub o r t) = o + "/" + r
+	toStoredPackSource (Git url t) = url
 	// TODO
 
+	toStoredOpts :: Options -> StoredOptions
+	toStoredOpts opts =
+		{ StoredOptions
+		| show_result       = Just opts.Options.show_result
+		, show_constructors = Just opts.Options.show_constructors
+		, show_time         = Just opts.Options.show_time
+		, heap_size         = Just opts.Options.heap_size
+		, stack_size        = Just opts.Options.stack_size
+		, extra_flags       = listToMaybeList opts.Options.extra_flags
+		}
+
 instance <<< Package
 where
 	(<<<) f p = f <<< (jsonPrettyPrint $ toJSON $ toStoredPackage p)
+
+readPackage :: String -> *World -> *(Maybe Package, *World)
+readPackage f = appFst parse o readFile f
+where parse = join o fmap (fmap toPackage o fromJSON o fromString) o error2mb
+
+getRecursivePaths :: Package *World -> (MaybeErrorString [Path], *World)
+getRecursivePaths pkg w = getPaths` pkg.Package.paths [] pkg.Package.depends w
+where
+	getPaths` :: [Path] [Package] [Dependency] *World
+		-> (MaybeErrorString [Path], *World)
+	getPaths` ps _   []     w = (Ok ps, w)
+	getPaths` ps pks [d:ds] w
+	| isMember d.dep_name [p.Package.name \\ p <- pks]
+		= getPaths` ps pks ds w
+	# (pkg,w) = readPackage (MODULE_DIR </> d.dep_name </> PACKAGE_FILE) w
+	| isNothing pkg
+		= (Error $ "Could not read " + PACKAGE_FILE + " for " + d.dep_name + ".",w)
+	# pkg = fromJust pkg
+	= getPaths` (removeDup $ ps ++ pkg.Package.paths) [pkg:pks] ds w
+
+optionsToFlags :: Options -> [String]
+optionsToFlags opts
+	= if opts.Options.show_result [] ["-nr"]
+	++ if opts.Options.show_constructors ["-sc"] ["-b"]
+	++ if opts.Options.show_time ["-t"] ["-nt"]
+	++ ["-h " + toString opts.Options.heap_size + "k"]
+	++ ["-s " + toString opts.Options.stack_size + "k"]
+	++ opts.Options.extra_flags
diff --git a/clpm.icl b/clpm.icl
index 195b135..dab9e83 100644
--- a/clpm.icl
+++ b/clpm.icl
@@ -5,32 +5,41 @@ import StdFile
 import StdList
 import StdOverloaded
 import StdString
+import StdTuple
 
 import Control.Applicative
 import Control.Monad
+
 import Data.Error
 from Data.Func import $
 import Data.Functor
 import Data.Maybe
 import Data.Tuple
+
 from Text import instance + String
 import Text.JSON
 
 import System.CommandLine
+import System.Directory
 import System.File
 
 import CLPM.Package
 
-FILENAME :== "clpm.json"
+:: Action
+	= NoAction
+	| Install
+	| Make
 
 :: Arguments
 	= { package_file :: String
+	  , action       :: Action
 	  }
 
 instance zero Arguments
 where
 	zero
-		= { package_file = FILENAME
+		= { package_file = PACKAGE_FILE
+		  , action = NoAction
 		  }
 
 Start w
@@ -46,18 +55,48 @@ Start w
 	# (_,w) = fclose io w
 	= w
 # pkg = fromJust pkg
-# io = io <<< pkg <<< '\n'
+# (io,w) = do args pkg io w
 # (_,w) = fclose io w
 = w
 
+do :: Arguments Package *File *World -> *(*File, *World)
+do args pkg io w = case args.action of
+	NoAction = (io,w)
+	Install  = install pkg io w
+	Make     = make pkg io w
+
+install :: Package *File *World -> *(*File, *World)
+install pkg io w
+# (e,w) = fileExists MODULE_DIR w
+# w = if e w (snd $ createDirectory MODULE_DIR w)
+# (r,w) = syscall "echo hello" w
+# io = io <<< r <<< "\n"
+= (io,w)
+
+make :: Package *File *World -> *(*File, *World)
+make pkg io w
+# (ps,w) = getRecursivePaths pkg w
+| isError ps
+	= (io <<< fromError ps <<< "\n", w)
+# ps = fromOk ps
+# (r,w) = syscall (foldl (+) "clm" [" -I " + p \\ p <- ps] +
+	foldl (+) "" [" " + f \\ f <- optionsToFlags pkg.options] +
+	" " + pkg.main + " -o " + pkg.main) w
+= (io,w)
+
 parseArgs :: [String] Arguments [String] -> ([String], Arguments)
 parseArgs miss args []
 	= (miss, args)
 parseArgs miss args ["-p":name:rest]
 	= parseArgs miss {args & package_file = name} rest
+parseArgs miss args ["install":rest]
+	= parseArgs miss {args & action = Install} rest
+parseArgs miss args ["make":rest]
+	= parseArgs miss {args & action = Make} rest
 parseArgs miss args [a:rest]
 	= parseArgs [a:miss] args rest
 
-readPackage :: String -> *World -> *(Maybe Package, *World)
-readPackage f = appFst parse o readFile f
-where parse = join o fmap (fmap toPackage o fromJSON o fromString) o error2mb
+syscall :: !String !*World -> !*(!Int, !*World)
+syscall cmd w = code {
+	ccall system "s:I:A"
+}
diff --git a/clpm.json b/clpm.json
index 74a453d..0232dbc 100644
--- a/clpm.json
+++ b/clpm.json
@@ -2,5 +2,17 @@
 	"name": "CLPM",
 	"desc": "Clean Package Manger",
 	"author": "Camil Staps",
-	"url": "https://github.com/camilstaps/clpm"
+	"url": "https://github.com/camilstaps/clpm",
+	"main": "clpm",
+	"paths": [
+		"$CLEAN_HOME/lib/clean-platform/OS-Linux-64",
+		"$CLEAN_HOME/lib/clean-platform/OS-Linux",
+		"$CLEAN_HOME/lib/clean-platform/OS-Posix",
+		"$CLEAN_HOME/lib/clean-platform/OS-Independent",
+		"$CLEAN_HOME/lib/Generics"
+	],
+	"options": {
+		"show_result": false,
+		"show_time": false
+	}
 }