Coverage report: /home/ellis/comp/core/app/skel/cli.lisp

Kind	Covered	All	%
expression	0	286	0.0
branch	0	18	0.0

Key

Not instrumented

Conditionalized out

Executed

Not executed

Both branches taken

One branch taken

Neither branch taken

1

;;; cli.lisp --- Skel CLI Definitions

2

3

;; CLI implementation of Skel

4

5

;;; Code:

6

(in-package :skel/cli)

7

8

;; *SKEL-CLI* exposes access to the SKEL system from the CLI.

9

(defcmd skc-init ()

10

(let ((file (when *args* (pop *args*)))

11

(name (when (> *argc* 1) (pop *args*))))

12

;; TODO: test, may need to be sequential for side-effect of pop

13

(handler-bind

14

((sb-ext:file-exists

15

#'(lambda (s)

16

(std:println (format nil "file already exists: ~A"

17

(or file *default-skelfile*)))

18

(let ((f2 (read-line)))

19

(if (string= f2 "")

20

(error s)

21

(use-value f2 s))))))

22

(init-skelfile file name))))

23

24

(defcmd skc-describe ()

25

(describe

26

(if (> *argc* 0)

27

(find-skelfile (pathname (car *args*)) :load t)

28

(or *skel-project* *skel-user-config* *skel-system-config*))))

29

30

(defcmd skc-inspect ()

31

(sb-ext:enable-debugger)

32

(setq *no-exit* t)

33

(inspect (or *skel-project* *skel-user-config*)))

34

35

(defun call-with-args (action args)

36

(let* ((*default-pathname-defaults* skel-path))

37

(if (null args)

38

(sk-call *skel-project* action)

39

(mapc (lambda (x)

40

                 (sk-call *skel-project* (keywordicate (symbol-name action) '- (string-upcase x))))

41

args))))

42

43

(defcmd skc-compile ()

44

(call-with-args :compile *args*))

45

(defcmd skc-build ()

46

(call-with-args :build *args*))

47

(defcmd skc-update ()

48

(call-with-args :update *args*))

49

(defcmd skc-dist ()

50

(call-with-args :dist *args*))

51

(defcmd skc-install ()

52

(call-with-args :install *args*))

53

(defcmd skc-pack ()

54

(call-with-args :pack *args*))

55

(defcmd skc-unpack ()

56

(call-with-args :unpack *args*))

57

(defcmd skc-bundle ()

58

(call-with-args :bundle *args*))

59

(defcmd skc-unbundle ()

60

(call-with-args :unbundle *args*))

61

(defcmd skc-clean ()

62

(call-with-args :clean *args*))

63

(defcmd skc-test ()

64

(call-with-args :test *args*))

65

(defcmd skc-bench ()

66

(call-with-args :bench *args*))

67

(defcmd skc-save ()

68

(call-with-args :save *args*))

69

70

(defcmd skc-show ()

71

(if *args*

72

(mapc (lambda (x)

73

(let ((y (string-left-trim ":" x)))

74

(if (sk-project-slot y nil)

75

(skel/core/print::sk-print-slot

76

(find y

77

(sb-mop:class-slots (class-of *skel-project*))

78

:test 'string=

79

                            :key (lambda (x) (string-downcase (sb-mop:slot-definition-name x))))

80

*skel-project*

81

:limit nil)

82

(log:fatal! "unknown argument: ~A~%" x))))

83

*args*)

84

(cond

85

((boundp '*skel-project*)

86

(sk-print *skel-project* :exclude (if ast:*keep-ast* '(:ast :rules) '(:rules))))

87

((boundp '*skel-user-config*) (sk-print *skel-user-config*))

88

((boundp '*skel-system-config*) (sk-print *skel-system-config*))

89

(t (skel-simple-error "skel not installed")))))

90

91

(defcmd skc-list ()

92

(if (zerop *argc*)

93

(list-all-projects)

94

(string-case ((subseq (pop *args*) 0 3))

95

("pro" (list-all-projects))

96

("log" (apply 'sk-log-list *args*)))))

97

98

(defcmd skc-id ()

99

(println (octet-vector-to-hex-string (integer-to-octets (id:id *skel-project*)))))

100

101

(defopt skc-config (load-user-skelrc (or *arg* user-skelrc) nil))

102

103

(defcmd skc-edit ()

104

(let ((file (or (when *args* (pop *args*)) (path *skel-project*))))

105

(cli/ed:run-emacsclient (namestring file))))

106

107

(defcmd skc-make ()

108

(let ((sk *skel-project*))

109

(sb-ext:enable-debugger)

110

(if *args*

111

(loop for a in *args*

112

do (debug!

113

(if-let ((rule (sk-find a sk)))

114

(sk-make sk rule)

115

;; TODO 2024-08-23: restart condition here

116

(skel-simple-error "rule not found: ~A" a))))

117

(sk-make sk (aref (sk-rules sk) 0)))))

118

119

(defcmd skc-status ()

120

(vc:vc-status (sk-vc *skel-project*)))

121

122

(defcmd skc-run ()

123

(sb-ext:enable-debugger)

124

(if *args*

125

(mapc (lambda (script)

126

;; first check if a script with the same name exists, else check

127

;; for a rule definition

128

(if-let ((script (sk-find

129

(pathname-name script)

130

*skel-user-config*)))

131

(sk-run script)

132

(call-with-args :run (list script))))

133

*args*)

134

(required-argument 'name)))

135

136

(defcmd skc-new ()

137

(println *args*)

138

(println *opts*))

139

140

(defcmd skc-search ()

141

"Search the current project and return a date-frame of results."

142

(dolist (a *args*)

143

(println (sk-search-project a))))

144

145

(defun sk-shell ()

146

(trace! "starting skel shell")

147

(setq *no-exit* t)

148

(progn

149

(in-package :sk-user)

150

(use-package :cl-user)

151

(use-package :sb-ext)

152

(use-package :std-user)

153

(println "Welcome to SKEL")

154

(cli/linedit:install-repl :wrap-current t :history "/tmp/skel.history" :killring "/tmp/skel.killring")

155

(sb-impl::toplevel-repl nil)))

156

157

(defcmd skc-shell () (sk-shell))

158

159

(define-cli *skel-cli*

160

:help t

161

   :version (format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))

162

:description "The hackable devtool."

163

:thunk skc-show

164

:name "skel"

165

:opts

166

((:name "version"

167

:description "print version"

168

:kind boolean

169

:thunk version-opt)

170

(:name "ast" :description "save the intermediate skel AST"

171

:thunk keep-ast-opt :kind boolean)

172

(:name "level" :description "set log level (warn,info,debug,trace)"

173

:thunk level-opt)

174

(:name "config" :description "set a custom skel user config"

175

:kind file

176

:thunk skc-config))

177

:cmds

178

((:name init

179

:description "initialize a skelfile in the current directory"

180

:opts ((:name "name" :description "project name" :kind string))

181

:thunk skc-init)

182

(:name id

183

:description "print the current project id"

184

:thunk skc-id)

185

(:name inspect

186

:description "inspect the project skelfile"

187

:opts ((:name "file" :description "path to skelfile" :kind file))

188

:thunk skc-inspect)

189

(:name new

190

:description "make a new skel project"

191

:opts ((:name "name" :description "project name" :kind string))

192

:thunk skc-new)

193

(:name describe

194

:description "describe a skelfile"

195

:thunk skc-describe)

196

(:name edit

197

:description "edit a project file in emacs."

198

:thunk skc-edit)

199

(:name show

200

:description "show skel objects slots"

201

:opts ((:name "file" :description "path to skelfile" :kind file))

202

:thunk skc-show)

203

(:name status

204

:description "show the current project status"

205

:thunk skc-status)

206

(:name list

207

:description "list skel objects"

208

:thunk skc-list)

209

(:name make

210

:description "build project targets"

211

:thunk skc-make)

212

(:name search

213

:description "search the current project"

214

:thunk skc-search)

215

(:name run

216

:description "run a script or command"

217

:thunk skc-run)

218

(:name compile

219

:description "compile source code"

220

:thunk skc-compile)

221

(:name build

222

:description "build programs and libraries"

223

:thunk skc-build)

224

(:name update

225

:description "update components"

226

:thunk skc-update)

227

(:name save

228

:description "save a file"

229

:thunk skc-save)

230

(:name dist

231

:description "distribute build artifacts"

232

:thunk skc-dist)

233

(:name install

234

:description "install stuff"

235

:thunk skc-install)

236

(:name pack

237

:description "pack stuff"

238

:thunk skc-pack)

239

(:name unpack

240

:description "unpack stuff"

241

:thunk skc-unpack)

242

(:name bundle

243

:description "bundle source code"

244

:thunk skc-bundle)

245

(:name unbundle

246

:description "unbundle source code"

247

:thunk skc-unbundle)

248

(:name clean

249

:description "clean up the project"

250

:thunk skc-clean)

251

(:name test

252

:description "run tests"

253

:thunk skc-test)

254

(:name bench

255

:description "run benchmark"

256

:thunk skc-bench)

257

(:name shell

258

:description "open the sk-shell interpreter"

259

:thunk skc-shell)))