CloogleServer.icl 14.7 KB
Newer Older
1 2
module CloogleServer

3 4 5 6 7 8 9 10
import StdArray
import StdBool
import StdFile
import StdList
import StdOrdList
import StdOverloaded
import StdString
import StdTuple
Camil Staps's avatar
Camil Staps committed
11
from StdFunc import o, flip, const, seq
12
from StdMisc import abort
13

14
from TCPIP import :: IPAddress, :: Port, instance toString IPAddress
15 16

from Data.Func import $
Camil Staps's avatar
Camil Staps committed
17
import Data.List
18
import Data.Tuple
19 20 21 22
import Data.Maybe
import System.CommandLine
import Data.Functor
import Control.Applicative
23
import Control.Monad
Camil Staps's avatar
Camil Staps committed
24
from Text import class Text(concat,trim,indexOf,toLowerCase),
25
	instance Text String, instance + String
26
import Text.JSON
Camil Staps's avatar
Camil Staps committed
27 28

import System.Time
29

30 31
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
32 33
import TypeDB
import Type
34
import Cache
35
import Cloogle
Camil Staps's avatar
Camil Staps committed
36

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

40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
:: RequestCacheKey
	= { c_unify     :: Maybe Type
	  , c_name      :: Maybe String
	  , c_className :: Maybe String
	  , c_typeName  :: Maybe String
	  , c_modules   :: Maybe [String]
	  , c_libraries :: Maybe ([String], Bool)
	  , c_page      :: Maybe Int
	  }

derive JSONEncode Kind, ClassOrGeneric, Type, RequestCacheKey
instance toString RequestCacheKey
where toString rck = toString $ toJSON rck

toRequestCacheKey :: Request -> RequestCacheKey
toRequestCacheKey r =
	{ 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 = appFst sort <$> r.libraries
Camil Staps's avatar
Camil Staps committed
62
	, c_page      = r.page <|> Just 0
63 64
	}

65 66 67 68 69 70 71 72 73
Start w
# (io, w) = stdio w
# (cmdline, w) = getCommandLine w
| length cmdline <> 2 = help io w
# [_,port:_] = cmdline
# port = toInt port
# (db, io) = openDb io
# (_, w) = fclose io w
| isNothing db = abort "stdin does not have a TypeDB\n"
74
#! db = fromJust db
Camil Staps's avatar
Camil Staps committed
75
= serve (handle db) (Just log) port w
76
where
Camil Staps's avatar
Camil Staps committed
77 78 79 80 81
	help :: *File *World -> *World
	help io w
	# io = io <<< "Usage: ./CloogleServer <port>\n"
	= snd $ fclose io w

Camil Staps's avatar
Camil Staps committed
82
	handle :: !TypeDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
83
	handle _ Nothing w = (err CLOOGLE_E_INVALIDINPUT "Couldn't parse input", "", w)
Camil Staps's avatar
Camil Staps committed
84
	handle db (Just request=:{unify,name,page}) w
85
		//Check cache
Camil Staps's avatar
Camil Staps committed
86
		# (mbResponse, w) = readCache key w
87 88
		| isJust mbResponse
			# r = fromJust mbResponse
Camil Staps's avatar
Camil Staps committed
89
			= ({r & return = if (r.return == 0) 1 r.return}, cacheKey key, w)
90
		| isJust name && size (fromJust name) > 40
91
			= respond (err CLOOGLE_E_INVALIDNAME "Function name too long") w
Camil Staps's avatar
Camil Staps committed
92
		| isJust name && any isSpace (fromString $ fromJust name)
93
			= respond (err CLOOGLE_E_INVALIDNAME "Name cannot contain spaces") w
Camil Staps's avatar
Camil Staps committed
94
		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
95
			= respond (err CLOOGLE_E_INVALIDTYPE "Couldn't parse type") w
Camil Staps's avatar
Camil Staps committed
96 97
		// Results
		# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
Camil Staps's avatar
oops  
Camil Staps committed
98
		# results = drop drop_n $ sort $ search request db
Camil Staps's avatar
Camil Staps committed
99 100
		# more = max 0 (length results - MAX_RESULTS)
		// Suggestions
101
		# mbType = unify >>= parseType o fromString
Camil Staps's avatar
Camil Staps committed
102 103 104 105 106 107
		# suggestions = mbType >>= flip (suggs name) db
		# w = seq [cachePages
				(toRequestCacheKey req) CACHE_PREFETCH 0 zero suggs
				\\ (req,suggs) <- mb2list suggestions] w
			with
				mb2list Nothing = []; mb2list (Just xs) = xs
Camil Staps's avatar
Camil Staps committed
108
		# suggestions
109
			= sortBy (\a b -> snd a > snd b) <$>
Camil Staps's avatar
Camil Staps committed
110 111
			  filter ((<) (length results) o snd) <$>
			  map (appSnd length) <$> suggestions
Camil Staps's avatar
Camil Staps committed
112
		# (results,nextpages) = splitAt MAX_RESULTS results
Camil Staps's avatar
Camil Staps committed
113
		// Response
114
		# response = if (isEmpty results)
115
			(err CLOOGLE_E_NORESULTS "No results")
Camil Staps's avatar
Camil Staps committed
116 117
			{ zero
		    & data           = results
Camil Staps's avatar
Camil Staps committed
118 119
		    , more_available = Just more
		    , suggestions    = suggestions
120
		    }
Camil Staps's avatar
Camil Staps committed
121
		// Save page prefetches
Camil Staps's avatar
Camil Staps committed
122
		# w = cachePages key CACHE_PREFETCH 1 response nextpages w
123
		// Save cache file
124 125
		= respond response w
	where
126 127
		key = toRequestCacheKey request

Camil Staps's avatar
Camil Staps committed
128
		respond :: Response *World -> *(Response, CacheKey, *World)
129
		respond r w = (r, cacheKey key, writeCache LongTerm key r w)
Camil Staps's avatar
Camil Staps committed
130

Camil Staps's avatar
Camil Staps committed
131 132 133 134
		cachePages :: RequestCacheKey Int Int Response [Result] *World -> *World
		cachePages key _ _  _ [] w = w
		cachePages key 0 _  _ _  w = w
		cachePages key npages i response results w
Camil Staps's avatar
Camil Staps committed
135
		# w = writeCache Brief req` resp` w
Camil Staps's avatar
Camil Staps committed
136
		= cachePages key (npages - 1) (i + 1) response keep w
Camil Staps's avatar
Camil Staps committed
137
		where
138
			req` = { key & c_page = ((+) i) <$> (key.c_page <|> pure 0) }
Camil Staps's avatar
Camil Staps committed
139 140 141 142 143 144
			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
145

Camil Staps's avatar
Camil Staps committed
146
	suggs :: !(Maybe String) !Type !TypeDB -> Maybe [(Request, [Result])]
147
	suggs n (Func is r cc) db
148 149
		| length is < 3
			= Just [let t` = concat $ print False $ Func is` r cc in
150
			        let request = {zero & name=n, unify=Just t`} in
Camil Staps's avatar
Camil Staps committed
151
			        (request, search request db)
152
			        \\ is` <- permutations is | is` <> is]
153
	suggs _ _ _ = Nothing
Camil Staps's avatar
Camil Staps committed
154

155
	search :: !Request !TypeDB -> [Result]
Camil Staps's avatar
Camil Staps committed
156 157 158 159
	search {unify,name,className,typeName,modules,libraries,page} db
		# db = case libraries of
			(Just ls) = filterLocations (isLibMatch ls) db
			Nothing   = db
160 161 162
		# db = case modules of
			(Just ms) = filterLocations (isModMatch ms) db
			Nothing   = db
Camil Staps's avatar
Camil Staps committed
163 164 165 166
		| isJust className
			# className = fromJust className
			# classes = findClass className db
			= map (flip makeClassResult db) classes
Camil Staps's avatar
Camil Staps committed
167 168 169
		| isJust typeName
			# typeName = fromJust typeName
			# types = findType typeName db
170
			= [makeTypeResult (Just typeName) l td db \\ (l,td) <- types]
171
		# mbType = prepare_unification True <$> (unify >>= parseType o fromString)
Camil Staps's avatar
Camil Staps committed
172
		// Search normal functions
173
		# filts = catMaybes [ (\t _ -> isUnifiable t) <$> mbType
174
		                    , (\n loc _ -> isNameMatch (size n*2/3) n loc) <$> name
175
		                    ]
176
		# funs = map (\f -> makeFunctionResult name mbType Nothing f db) $ findFunction`` filts db
Camil Staps's avatar
Camil Staps committed
177
		// Search macros
178
		# macros = case (isNothing mbType,name) of
179
			(True,Just n) = findMacro` (\loc _ -> isNameMatch (size n*2/3) n loc) db
180
			_             = []
Camil Staps's avatar
Camil Staps committed
181
		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
Camil Staps's avatar
Camil Staps committed
182
		// Search class members
Camil Staps's avatar
Camil Staps committed
183
		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
184 185
		                    , (\n (Location lib mod _ _ _) _ _ f _ -> isNameMatch
		                      (size n*2/3) n (Location lib mod Nothing Nothing f)) <$> name
186
		                    ]
Camil Staps's avatar
Camil Staps committed
187
		# members = findClassMembers`` filts db
188 189
		# members = map (\(Location lib mod line iclline cls,vs,_,f,et) -> makeFunctionResult name mbType
			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line iclline f,et) db) members
Camil Staps's avatar
Camil Staps committed
190
		// Search types
191
		# lcName = if (isJust mbType && isType (fromJust mbType))
Camil Staps's avatar
Camil Staps committed
192 193
			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
			(toLowerCase <$> name)
194 195 196
		# types = case (isNothing mbType,lcName) of
			(True,Just n) = findType` (\loc _ -> toLowerCase (getName loc) == n) db
			_             = []
197
		# types = map (\(tl,td) -> makeTypeResult name tl td db) types
198 199
		// Search classes
		# classes = case (isNothing mbType, toLowerCase <$> name) of
Camil Staps's avatar
Camil Staps committed
200
			(True, Just c) = findClass` (\loc _ _ _ -> toLowerCase (getName loc) == c) db
Camil Staps's avatar
Camil Staps committed
201 202
			_              = []
		# classes = map (flip makeClassResult db) classes
Camil Staps's avatar
Camil Staps committed
203
		// Merge results
Camil Staps's avatar
Camil Staps committed
204
		= sort $ funs ++ members ++ types ++ classes ++ macros
Camil Staps's avatar
Camil Staps committed
205

206
	makeClassResult :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
Camil Staps's avatar
Camil Staps committed
207
		TypeDB -> Result
Camil Staps's avatar
Camil Staps committed
208 209 210 211 212
	makeClassResult rec=:(Builtin _, _, _, _) db
		= ClassResult
		  ( { library  = ""
		    , filename = ""
		    , dcl_line = Nothing
213
		    , icl_line = Nothing
Camil Staps's avatar
Camil Staps committed
214 215 216 217 218 219
		    , modul    = ""
		    , distance = -100
		    , builtin  = Just True
		    }
		  , makeClassResultExtras rec db
		  )
220
	makeClassResult rec=:(Location lib mod line iclline cls, vars, cc, funs) db
Camil Staps's avatar
Camil Staps committed
221 222 223
		= ClassResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
224
		    , dcl_line = line
225
		    , icl_line = iclline
Camil Staps's avatar
Camil Staps committed
226
		    , modul    = mod
227
		    , distance = -100
Camil Staps's avatar
Camil Staps committed
228
		    , builtin  = Nothing
Camil Staps's avatar
Camil Staps committed
229
		    }
Camil Staps's avatar
Camil Staps committed
230
		  , makeClassResultExtras rec db
Camil Staps's avatar
Camil Staps committed
231
		  )
Camil Staps's avatar
Camil Staps committed
232 233 234 235 236
	makeClassResultExtras :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
		TypeDB -> ClassResultExtras
	makeClassResultExtras (l, vars, cc, funs) db
		= { class_name = cls
		  , class_heading = foldl ((+) o (flip (+) " ")) cls vars +
237
		      if (isEmpty cc) "" " | " + concat (print False cc)
Camil Staps's avatar
Camil Staps committed
238 239 240 241 242 243
		  , class_funs = [print_fun fun \\ fun <- funs]
		  , class_instances
		      = sortBy (\(a,_) (b,_) -> a < b)
		          [([concat (print False t) \\ t <- ts], map loc ls)
		          \\ (ts,ls) <- getInstances cls db]
		  }
244
	where
Camil Staps's avatar
Camil Staps committed
245 246
		cls = case l of
			Builtin c = c
247
			Location _ _ _ _ c = c
Camil Staps's avatar
Camil Staps committed
248

249 250 251
		print_fun :: (Name,ExtendedType) -> String
		print_fun f=:(_,ET _ et) = fromJust $
			et.te_representation <|> (pure $ concat $ print False f)
Camil Staps's avatar
Camil Staps committed
252

253
	makeTypeResult :: (Maybe String) Location TypeDef TypeDB -> Result
254
	makeTypeResult mbName (Location lib mod line iclline t) td db
Camil Staps's avatar
Camil Staps committed
255 256 257
		= TypeResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
258
		    , dcl_line = line
259
		    , icl_line = iclline
Camil Staps's avatar
Camil Staps committed
260
		    , modul    = mod
Camil Staps's avatar
Camil Staps committed
261
		    , distance
262
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
Camil Staps's avatar
Camil Staps committed
263 264
		    , builtin  = Nothing
		    }
265
		  , { type             = concat $ print False td
266 267
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
268 269
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
Camil Staps's avatar
Camil Staps committed
270
		  )
271
	makeTypeResult mbName (Builtin t) td db
Camil Staps's avatar
Camil Staps committed
272 273 274
		= TypeResult
		  ( { library  = ""
		    , filename = ""
Camil Staps's avatar
Camil Staps committed
275
		    , dcl_line = Nothing
276
		    , icl_line = Nothing
Camil Staps's avatar
Camil Staps committed
277 278 279 280
		    , modul    = ""
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Just True
Camil Staps's avatar
Camil Staps committed
281
		    }
282
		  , { type             = concat $ print False td
283 284
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
285 286
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
Camil Staps's avatar
Camil Staps committed
287 288
		  )

289
	makeMacroResult :: (Maybe String) Location Macro -> Result
290
	makeMacroResult mbName (Location lib mod line iclline m) mac
Camil Staps's avatar
Camil Staps committed
291 292 293
		= MacroResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
294
		    , dcl_line = line
295
		    , icl_line = iclline
Camil Staps's avatar
Camil Staps committed
296 297
		    , modul    = mod
		    , distance
Camil Staps's avatar
Camil Staps committed
298
		        = if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
Camil Staps's avatar
Camil Staps committed
299
		    , builtin  = Nothing
Camil Staps's avatar
Camil Staps committed
300 301 302 303 304 305
		    }
		  , { macro_name = m
		    , macro_representation = mac.macro_as_string
		    }
		  )

Camil Staps's avatar
Camil Staps committed
306
	makeFunctionResult :: (Maybe String) (Maybe Type) (Maybe ShortClassResult)
307
		(Location, ExtendedType) TypeDB -> Result
Camil Staps's avatar
Camil Staps committed
308
	makeFunctionResult
Camil Staps's avatar
Camil Staps committed
309
		orgsearch orgsearchtype mbCls (fl, et=:(ET type tes)) db
Camil Staps's avatar
Camil Staps committed
310 311
		= FunctionResult
		  ( { library  = lib
Camil Staps's avatar
Camil Staps committed
312
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
313
		    , dcl_line = line
314
		    , icl_line = iclline
Camil Staps's avatar
Camil Staps committed
315 316
		    , modul    = mod
		    , distance = distance
Camil Staps's avatar
Camil Staps committed
317
		    , builtin  = builtin
Camil Staps's avatar
Camil Staps committed
318
		    }
319 320
		  , { func     = fromJust (tes.te_representation <|>
		                           (pure $ concat $ print False (fname,et)))
321 322
		    , unifier  = toStrUnifier <$> finish_unification <$>
		        (orgsearchtype >>= unify [] (prepare_unification False type))
Camil Staps's avatar
Camil Staps committed
323
		    , cls      = mbCls
324
		    , constructor_of = if tes.te_isconstructor
Camil Staps's avatar
Camil Staps committed
325 326
		        (let (Func _ r _) = type in Just $ concat $ print False r)
		        Nothing
327
		    , recordfield_of = if tes.te_isrecordfield
Camil Staps's avatar
Camil Staps committed
328 329
		        (let (Func [t:_] _ _) = type in Just $ concat $ print False t)
		        Nothing
330 331
		    , generic_derivations
		        = let derivs = getDerivations fname db in
Camil Staps's avatar
Camil Staps committed
332 333
		          const (sortBy (\(a,_) (b,_) -> a < b)
				    [(concat $ print False d, map loc ls) \\ (d,ls) <- derivs]) <$>
Camil Staps's avatar
Camil Staps committed
334
		          tes.te_generic_vars
Camil Staps's avatar
Camil Staps committed
335 336
		    }
		  )
Camil Staps's avatar
Camil Staps committed
337
	where
338 339 340
		(lib,mod,fname,line,iclline,builtin) = case fl of
			(Location l m ln iln f) = (l,  m,  f, ln,      iln,     Nothing)
			(Builtin f)             = ("", "", f, Nothing, Nothing, Just True)
Camil Staps's avatar
Camil Staps committed
341

342 343
		toStrUnifier :: Unifier -> StrUnifier
		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
344
		where toStr (var, type) = (var, concat $ print False type)
345

Camil Staps's avatar
Camil Staps committed
346
		toStrPriority :: (Maybe Priority) -> String
347
		toStrPriority p = case print False p of [] = ""; ss = concat [" ":ss]
Camil Staps's avatar
Camil Staps committed
348

Camil Staps's avatar
Camil Staps committed
349
		distance
Camil Staps's avatar
Camil Staps committed
350
			| isNothing orgsearch || fromJust orgsearch == ""
Camil Staps's avatar
Camil Staps committed
351 352
				| isNothing orgsearchtype = 0
				# orgsearchtype = fromJust orgsearchtype
353 354
				# (Just (ass1, ass2)) = finish_unification <$>
					unify [] orgsearchtype (prepare_unification False type)
355
				= penalty + toInt (sum [typeComplexity t \\ (_,t)<-ass1 ++ ass2 | not (isVar t)])
356
			# orgsearch = fromJust orgsearch
357
			= penalty + levenshtein` orgsearch fname
358
		where
359 360 361 362 363
			penalty
			| tes.te_isrecordfield = 2
			| tes.te_isconstructor = 1
			| otherwise            = 0

364 365 366 367 368 369
			typeComplexity :: Type -> Real
			typeComplexity (Type _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Func is r _) = 2.0 * foldr ((+) o typeComplexity) 1.0 [r:is]
			typeComplexity (Var _) = 1.0
			typeComplexity (Cons _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Uniq t) = 3.0 + typeComplexity t
Camil Staps's avatar
Camil Staps committed
370

Camil Staps's avatar
Camil Staps committed
371
	levenshtein` :: String String -> Int
Camil Staps's avatar
Camil Staps committed
372
	levenshtein` a b = if (indexOf a b == -1) 0 -100 + levenshtein [c \\ c <-: a] [c \\ c <-: b]
Camil Staps's avatar
Camil Staps committed
373

Camil Staps's avatar
Camil Staps committed
374 375
	modToFilename :: String -> String
	modToFilename mod = (toString $ reverse $ takeWhile ((<>)'.')
376
	                              $ reverse $ fromString mod) + ".dcl"
Camil Staps's avatar
Camil Staps committed
377

Camil Staps's avatar
Camil Staps committed
378
	isUnifiable :: Type ExtendedType -> Bool
379
	isUnifiable t1 (ET t2 _) = isJust (unify [] t1 (prepare_unification False t2))
Camil Staps's avatar
Camil Staps committed
380

381 382 383
	isNameMatch :: !Int !String Location -> Bool
	isNameMatch maxdist n1 loc
		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName loc})
Camil Staps's avatar
Camil Staps committed
384
		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein [c \\ c <-: n1] [c \\ c <-: n2] <= maxdist
Camil Staps's avatar
Camil Staps committed
385

386
	isModMatch :: ![String] Location -> Bool
387 388
	isModMatch mods (Location _ mod _ _ _) = isMember mod mods
	isModMatch _    (Builtin _)            = False
Camil Staps's avatar
Camil Staps committed
389

390
	isLibMatch :: (![String], !Bool) Location -> Bool
391 392
	isLibMatch (libs,_) (Location lib _ _ _ _) = any (\l -> indexOf l lib == 0) libs
	isLibMatch (_,blti) (Builtin _)            = blti
Camil Staps's avatar
Camil Staps committed
393

394
	loc :: Location -> LocationResult
395
	loc (Location lib mod ln iln _) = (lib, mod, ln, iln)
Camil Staps's avatar
Camil Staps committed
396

Camil Staps's avatar
Camil Staps committed
397
	log :: (LogMessage (Maybe Request) Response CacheKey) IPAddress *World
398
		-> *(IPAddress, *World)
Camil Staps's avatar
Camil Staps committed
399
	log msg s w
Camil Staps's avatar
Camil Staps committed
400 401
	| not needslog = (newS msg s, w)
	# (tm,w) = localTime w
Camil Staps's avatar
Camil Staps committed
402
	# (io,w) = stdio w
Camil Staps's avatar
Camil Staps committed
403
	# io = io <<< trim (toString tm) <<< " " <<< msgToString msg s
Camil Staps's avatar
Camil Staps committed
404
	= (newS msg s, snd (fclose io w))
Camil Staps's avatar
Camil Staps committed
405
	where
Camil Staps's avatar
Camil Staps committed
406
		needslog = case msg of (Received _) = True; (Sent _ _) = True; _ = False
Camil Staps's avatar
Camil Staps committed
407

Camil Staps's avatar
Camil Staps committed
408
	newS :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> IPAddress
Camil Staps's avatar
Camil Staps committed
409 410
	newS m s = case m of (Connected ip) = ip; _ = s

Camil Staps's avatar
Camil Staps committed
411
	msgToString :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> String
Camil Staps's avatar
Camil Staps committed
412
	msgToString (Received Nothing) ip
413
		= toString ip + " <-- Nothing\n"
Camil Staps's avatar
Camil Staps committed
414
	msgToString (Received (Just a)) ip
415
		= toString ip + " <-- " + toString a + "\n"
Camil Staps's avatar
Camil Staps committed
416
	msgToString (Sent {return,data,msg,more_available} ck) ip
417
		= toString ip + " --> " + toString (length data)
Camil Staps's avatar
Camil Staps committed
418 419 420
			+ " results (" + toString return + "; " + msg
			+ if (isJust more_available) ("; " + toString (fromJust more_available) + " more") ""
			+ "; cache: " + ck + ")\n"
Camil Staps's avatar
Camil Staps committed
421
	msgToString _ _ = ""