aboutsummaryrefslogtreecommitdiff
path: root/CLPM
diff options
context:
space:
mode:
Diffstat (limited to 'CLPM')
-rw-r--r--CLPM/Package.dcl52
-rw-r--r--CLPM/Package.icl122
2 files changed, 148 insertions, 26 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
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-13 15:24:18 +0000