f/api.4th at master · GeraldWodni/f · GitHub

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
\ Forth package manager api
\ (c)copyright 2015-2016 by Gerald Wodni <gerald.wodni@gmail.com>

\ TODO : wrap this into a vocubulary, add sub-vacabularies for each response-type for maximum security

15 constant name-length

\ -- package info --

\ TODO : load wordlist for packages-response
: forth-packages ;

\ TODO : unload wordlist for packages-response
: end-forth-packages ;

\ show package name and description
: name-description ( -- )
    \ name
    vt-bold vt-magenta
    parse-name dup >r type
    \ space
    name-length r> - 1 max spaces
    \ description
    vt-normal
    10 parse type
    vt-color-off
    cr ;

\ -- package download --

: package-content ( <parse-name> <parse-version> -- c-addr-directory n-directory )
    vt-magenta vt-bold ." package-content: "
    vt-normal
    parse-name
    parse-name
    2over type
    ."  v:"
    2dup type

    fdirectory 2@
    $prefix$name$version+

    \ create package directory
    vt-bold
    2dup create-directories ?dup if
        vt-red ." ERROR" vt-default throw
    else
        vt-green ." ok"
    then
    vt-default cr ;

: end-package-content ( c-addr-directory n-directory -- )
    drop freet
    vt-magenta vt-bold ." end-package-content" cr
    vt-default ;

\ TODO: hide in final wordset
\ merge prefix and path, keep copy of address for easy free
: _merge-path ( c-addr-pre n-pre c-addr-path n-path -- c-addr-pre n-pre c-addr-merged c-addr-merged n-merged )
    2over 2swap \ copy prefix
    $+          \ add strings
    over -rot ; \ save address

: directory ( <parse-directory> -- )
    vt-bold vt-magenta
    ." directory "
    vt-normal
    parse-name \ parse dirname
    2dup type bl emit

    vt-bold
    _merge-path create-directories swap freet
    ?dup if
        vt-red  ." ERROR" vt-default throw
    else
        vt-green  ." ok"
    then
    vt-default cr ;

\ TODO: hide in final wordset
\ write content into file
: _burp-file ( c-addr-content n-content c-addr-filename n-filename -- )
    w/o create-file throw >r
    r@ write-file throw
    r> close-file throw ;

: file ( <parse-filename> <parse-link> -- )
    vt-bold vt-magenta
    ." file "
    parse-name \ parse filename
    parse-name \ parse link
    2over
    vt-normal
    type bl emit

    api-host http-slurp 200 = if
        vt-default
        2>r \ content
        _merge-path 2r> 2swap \ get merged path and content
        _burp-file \ store in file
        freet

        vt-bold vt-green ." ok"
    else
        vt-bold vt-red
        . type
        2drop
    then
    vt-default cr ;

\ parse name and immediately drop it
: parse-drop ( <parse-name> -- )
    parse-name 2drop ;
: parse-line ( <parse-line> -- c-addr n )
    10 parse ;
: parse-line-drop ( <parse-line> -- )
    parse-line 2drop ;

\ join two paths
: path-join ( c-addr1 n1 caddr2 n2 -- caddr3 n3 )
    {: c-addr1 n1 c-addr2 n2 :}
    n1 n2 + 1+ dup allocate throw >r
    c-addr1 r@ n1 cmove         \ 1st path
    [CHAR] / r@ n1 + c!         \ separator
    c-addr2 r@ n1 + 1+ n2 cmove \ 2nd path
    r> swap ;

    \ TODO: make path-join work and use it in "Main Found"
    \ TODO: free path afterwards

\ finclude package.4th handling
vocabulary finclude-words
also finclude-words definitions
    : forth-package ( -- f )
        0 ;
    : key-value ( <parse-name> <parse-line> -- )
        parse-name s" main" compare 0= if
            drop \ drop false-flag
            2over parse-name path-join \ get path
            -1 \ add true flag
        else
            parse-line-drop
        then ;
    : key-list ( <parse-name> <parse-line> -- )
        parse-line-drop ; \ no need to inspect any lines in finlude
    : end-forth-package ; ( -- )
previous definitions