CloogleServer.icl 7.29 KB
Newer Older
1
2
module CloogleServer

3
4
5
import StdArray
import StdBool
import StdFile
6
7
from StdFunc import o, seq
from StdMisc import abort, undef
8
9
10
import StdOrdList
import StdOverloaded
import StdTuple
11

12
from TCPIP import :: IPAddress, :: Port, instance toString IPAddress
13

14
15
import Control.Applicative
import Control.Monad
16
17
import qualified Data.Foldable as Foldable
from Data.Foldable import class Foldable, instance Foldable Maybe
18
from Data.Func import $
19
import Data.Functor
Camil Staps's avatar
Camil Staps committed
20
import Data.List
21
import Data.Tuple
Camil Staps's avatar
Camil Staps committed
22
import System._Posix
23
import System.CommandLine
Camil Staps's avatar
Camil Staps committed
24
import System.Time
25
from Text import class Text(concat), instance Text String
26
import Text.JSON
Camil Staps's avatar
Camil Staps committed
27

28
import Cloogle
29
import Type
Camil Staps's avatar
Camil Staps committed
30
import CloogleDB
31
import Search
Camil Staps's avatar
Camil Staps committed
32

33
import SimpleTCPServer
Camil Staps's avatar
Camil Staps committed
34
35
36
import Cache
import Memory

37
MAX_RESULTS    :== 15
Camil Staps's avatar
Camil Staps committed
38
CACHE_PREFETCH :== 5
39

40
:: RequestCacheKey
Camil Staps's avatar
Camil Staps committed
41
42
43
44
45
46
47
	= { c_unify            :: Maybe Type
	  , c_name             :: Maybe String
	  , c_className        :: Maybe String
	  , c_typeName         :: Maybe String
	  , c_modules          :: Maybe [String]
	  , c_libraries        :: Maybe [String]
	  , c_include_builtins :: Bool
48
	  , c_include_core     :: Bool
Camil Staps's avatar
Camil Staps committed
49
	  , c_page             :: Int
50
51
	  }

52
derive JSONEncode Kind, Type, RequestCacheKey, TypeRestriction
53
54
55
56
57
instance toString RequestCacheKey
where toString rck = toString $ toJSON rck

toRequestCacheKey :: Request -> RequestCacheKey
toRequestCacheKey r =
Camil Staps's avatar
Camil Staps committed
58
59
60
61
62
63
	{ c_unify            = r.unify >>= parseType o fromString
	, c_name             = r.name
	, c_className        = r.className
	, c_typeName         = r.typeName
	, c_modules          = sort <$> r.modules
	, c_libraries        = sort <$> r.libraries
64
65
	, c_include_builtins = fromJust (r.include_builtins <|> Just DEFAULT_INCLUDE_BUILTINS)
	, c_include_core     = fromJust (r.include_core <|> Just DEFAULT_INCLUDE_CORE)
Camil Staps's avatar
Camil Staps committed
66
	, c_page             = fromJust (r.page <|> Just 0)
67
68
	}

69
70
Start w
# (cmdline, w) = getCommandLine w
Camil Staps's avatar
Camil Staps committed
71
72
| length cmdline <> 2
	= help w
73
# [_,port:_] = cmdline
Camil Staps's avatar
Camil Staps committed
74
75
76
# w = disableSwap w
#! (_,f,w) = fopen "types.json" FReadText w
#! (db,f) = openDb f
Camil Staps's avatar
Camil Staps committed
77
#! db = eval_all_nodes db
Camil Staps's avatar
Camil Staps committed
78
#! (_,w) = fclose f w
79
80
81
82
= serve
	{ handler           = handle db
	, logger            = Just log
	, port              = toInt port
83
84
	, connect_timeout   = Just 3600000 // 1h
	, keepalive_timeout = Just 5000    // 5s
85
	} w
86
where
Camil Staps's avatar
Camil Staps committed
87
88
89
	help :: *World -> *World
	help w
	# (io, w) = stdio w
Camil Staps's avatar
Camil Staps committed
90
91
92
	# io = io <<< "Usage: ./CloogleServer <port>\n"
	= snd $ fclose io w

Camil Staps's avatar
Camil Staps committed
93
94
95
96
97
98
99
100
101
	disableSwap :: *World -> *World
	disableSwap w
	# (ok,w) = mlockall (MCL_CURRENT bitor MCL_FUTURE) w
	| ok = w
	# (err,w) = errno w
	# (io,w) = stdio w
	# io = io <<< "Could not lock memory (" <<< err <<< "); process may get swapped out\n"
	= snd $ fclose io w

Camil Staps's avatar
Camil Staps committed
102
103
104
105
106
107
108
109
	eval_all_nodes :: !.a -> .a // From GraphCopy
	eval_all_nodes g = code {
		push_a 0
		.d 1 0
		jsr	_eval_to_nf
		.o 0 0
	}

Camil Staps's avatar
Camil Staps committed
110
	handle :: !CloogleDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
Camil Staps's avatar
Camil Staps committed
111
	handle db Nothing w = (err InvalidInput "Couldn't parse input", "", w)
Camil Staps's avatar
Camil Staps committed
112
	handle db (Just request=:{unify,name,page}) w
113
		//Check cache
Camil Staps's avatar
Camil Staps committed
114
		#! (mbResponse, w) = readCache key w
115
116
		| isJust mbResponse
			# r = fromJust mbResponse
Camil Staps's avatar
Camil Staps committed
117
			= ({r & return = if (r.return == 0) 1 r.return}, cacheKey key, w)
118
		| isJust name && size (fromJust name) > 40
Camil Staps's avatar
Camil Staps committed
119
			= respond (err InvalidName "Function name too long") w
Camil Staps's avatar
Camil Staps committed
120
		| isJust name && any isSpace (fromString $ fromJust name)
Camil Staps's avatar
Camil Staps committed
121
			= respond (err InvalidName "Name cannot contain spaces") w
Camil Staps's avatar
Camil Staps committed
122
		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
Camil Staps's avatar
Camil Staps committed
123
			= respond (err InvalidType "Couldn't parse type") w
Camil Staps's avatar
Camil Staps committed
124
		// Results
Camil Staps's avatar
Camil Staps committed
125
126
127
		#! drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
		#! results = drop drop_n $ sort $ search request db
		#! more = max 0 (length results - MAX_RESULTS)
Camil Staps's avatar
Camil Staps committed
128
		// Suggestions
Camil Staps's avatar
Camil Staps committed
129
		#! suggestions = unify >>= parseType o fromString >>= flip (suggs name) db
Camil Staps's avatar
Camil Staps committed
130
		#! w = seq [cachePages
Camil Staps's avatar
Camil Staps committed
131
				(toRequestCacheKey req) CACHE_PREFETCH 0 zero suggs
132
				\\ (req,suggs) <- 'Foldable'.concat suggestions] w
Camil Staps's avatar
Camil Staps committed
133
		#! suggestions
134
			= sortBy (\a b -> snd a > snd b) <$>
Camil Staps's avatar
Camil Staps committed
135
136
			  filter ((<) (length results) o snd) <$>
			  map (appSnd length) <$> suggestions
Camil Staps's avatar
Camil Staps committed
137
		#! (results,nextpages) = splitAt MAX_RESULTS results
Camil Staps's avatar
Camil Staps committed
138
		// Response
Camil Staps's avatar
Camil Staps committed
139
		#! response = if (isEmpty results)
Camil Staps's avatar
Camil Staps committed
140
			(err NoResults "No results")
Camil Staps's avatar
Camil Staps committed
141
142
			{ zero
		    & data           = results
Camil Staps's avatar
Camil Staps committed
143
144
		    , more_available = Just more
		    , suggestions    = suggestions
145
		    }
Camil Staps's avatar
Camil Staps committed
146
		// Save page prefetches
Camil Staps's avatar
Camil Staps committed
147
		#! w = cachePages key CACHE_PREFETCH 1 response nextpages w
148
		// Save cache file
149
150
		= respond response w
	where
151
152
		key = toRequestCacheKey request

Camil Staps's avatar
Camil Staps committed
153
		respond :: !Response !*World -> *(!Response, !CacheKey, !*World)
154
		respond r w = (r, cacheKey key, writeCache LongTerm key r w)
Camil Staps's avatar
Camil Staps committed
155

Camil Staps's avatar
Camil Staps committed
156
		cachePages :: !RequestCacheKey !Int !Int !Response ![Result] !*World -> *World
Camil Staps's avatar
Camil Staps committed
157
158
159
		cachePages key _ _  _ [] w = w
		cachePages key 0 _  _ _  w = w
		cachePages key npages i response results w
Camil Staps's avatar
Camil Staps committed
160
		# w = writeCache Brief req` resp` w
Camil Staps's avatar
Camil Staps committed
161
		= cachePages key (npages - 1) (i + 1) response keep w
Camil Staps's avatar
Camil Staps committed
162
		where
Camil Staps's avatar
Camil Staps committed
163
			req` = { key & c_page = key.c_page + i }
Camil Staps's avatar
Camil Staps committed
164
165
166
167
168
169
			resp` =
				{ response
				& more_available = Just $ max 0 (length results - MAX_RESULTS)
				, data = give
				}
			(give,keep) = splitAt MAX_RESULTS results
Mart Lubbers's avatar
Mart Lubbers committed
170

Camil Staps's avatar
Camil Staps committed
171
	suggs :: !(Maybe String) !Type !CloogleDB -> Maybe [(Request, [Result])]
172
	suggs n (Func is r cc) db
173
174
		| length is < 3
			= Just [let t` = concat $ print False $ Func is` r cc in
175
			        let request = {zero & name=n, unify=Just t`} in
Camil Staps's avatar
Camil Staps committed
176
			        (request, search request db)
177
			        \\ is` <- permutations is | is` <> is]
178
	suggs _ _ _ = Nothing
Camil Staps's avatar
Camil Staps committed
179

180
181
182
183
:: LogMemory =
	{ mem_ip         :: IPAddress
	, mem_time_start :: Tm
	, mem_time_end   :: Tm
184
	, mem_request    :: Maybe Request
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
	}

instance zero LogMemory
where
	zero =
		{ mem_ip         = undef
		, mem_time_start = undef
		, mem_time_end   = undef
		, mem_request    = undef
		}

:: LogMessage` :== LogMessage (Maybe Request) Response CacheKey

:: LogEntry =
	{ ip            :: String
	, time_start    :: (String, Int)
	, time_end      :: (String, Int)
202
	, request       :: Maybe Request
203
204
205
206
207
208
209
210
211
212
213
214
215
	, cachekey      :: String
	, response_code :: Int
	, results       :: Int
	}

derive JSONEncode LogEntry

log :: LogMessage` (Maybe LogMemory) *World -> *(Maybe LogMemory, *World)
log msg mem w
# mem     = fromJust (mem <|> pure zero)
# (mem,w) = updateMemory msg mem w
| not needslog = (Just mem, w)
# (io,w)  = stdio w
Camil Staps's avatar
Camil Staps committed
216
# io      = io <<< toString (toJSON $ makeLogEntry msg mem) <<< "\n"
217
218
219
220
221
= (Just mem, snd (fclose io w))
where
	needslog = case msg of (Sent _ _) = True; _ = False

	updateMemory :: LogMessage` LogMemory *World -> *(LogMemory, *World)
222
223
	updateMemory (Connected ip) s w = ({s & mem_ip=ip}, w)
	updateMemory (Received r)   s w
224
225
	# (t,w) = localTime w
	= ({s & mem_time_start=t, mem_request=r}, w)
226
	updateMemory (Sent _ _)     s w
227
228
229
230
	# (t,w) = localTime w
	= ({s & mem_time_end=t}, w)
	updateMemory _                   s w = (s,w)

Camil Staps's avatar
Camil Staps committed
231
232
233
234
235
236
237
238
239
240
	makeLogEntry :: LogMessage` LogMemory -> LogEntry
	makeLogEntry (Sent response ck) mem =
		{ ip            = toString mem.mem_ip
		, time_start    = (toString mem.mem_time_start, toInt $ mkTime mem.mem_time_start)
		, time_end      = (toString mem.mem_time_end, toInt $ mkTime mem.mem_time_end)
		, request       = mem.mem_request
		, cachekey      = ck
		, response_code = response.return
		, results       = length response.data
		}
Camil Staps's avatar
Camil Staps committed
241
242
243
244
245
246
247
248

err :: CloogleError String -> Response
err c m = { return         = toInt c
          , data           = []
          , msg            = m
          , more_available = Nothing
          , suggestions    = Nothing
          }