1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
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, 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
= { Package
| name = fromJust $ spkg.StoredPackage.name <|> Just DEFAULT_NAME
, 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
toDep (name, src)
= { dep_name = name, dep_source = toPackSource src }
toPackSource :: StoredPackageSource -> PackageSource
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
= { StoredPackage
| name = Just pkg.Package.name
, desc = Just pkg.Package.desc
, author = Just pkg.Package.author
, url = Just pkg.Package.url
, 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 (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
|
