CloogleServer.icl 14.9 KB
Newer Older
1 2
module CloogleServer

3
import StdArray, StdBool, StdFile, StdList, StdOrdList, StdOverloaded, StdTuple
Camil Staps's avatar
Camil Staps committed
4
from StdFunc import o, flip, const
5
from StdMisc import abort
6

7
from TCPIP import :: IPAddress, :: Port, instance toString IPAddress
8 9

from Data.Func import $
Camil Staps's avatar
Camil Staps committed
10
import Data.List
11 12 13 14 15
import Data.Maybe
import System.CommandLine
import Text.JSON
import Data.Functor
import Control.Applicative
16
import Control.Monad
Camil Staps's avatar
Camil Staps committed
17
from Text import class Text(concat,trim,indexOf,toLowerCase),
18
	instance Text String, instance + String
Camil Staps's avatar
Camil Staps committed
19 20

import System.Time
21

22 23
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
24 25 26
import TypeDB
import Type

Camil Staps's avatar
Camil Staps committed
27 28 29
:: Request = { unify     :: Maybe String
             , name      :: Maybe String
             , className :: Maybe String
Camil Staps's avatar
Camil Staps committed
30
             , typeName  :: Maybe String
Camil Staps's avatar
Camil Staps committed
31
             , modules   :: Maybe [String]
32
             , libraries :: Maybe ([String], Bool)
Camil Staps's avatar
Camil Staps committed
33
             , page      :: Maybe Int
34 35
             }

Camil Staps's avatar
Camil Staps committed
36 37 38
:: Response = { return         :: Int
              , data           :: [Result]
              , msg            :: String
Camil Staps's avatar
Camil Staps committed
39
              , more_available :: Maybe Int
40
              , suggestions    :: Maybe [(Request, Int)]
41 42
              }

Camil Staps's avatar
Camil Staps committed
43
:: Result = FunctionResult FunctionResult
Camil Staps's avatar
Camil Staps committed
44
          | TypeResult TypeResult
Camil Staps's avatar
Camil Staps committed
45
          | ClassResult ClassResult
Camil Staps's avatar
Camil Staps committed
46
          | MacroResult MacroResult
Camil Staps's avatar
Camil Staps committed
47 48 49 50

:: BasicResult = { library  :: String
                 , filename :: String
                 , modul    :: String
Camil Staps's avatar
Camil Staps committed
51
                 , dcl_line :: Maybe Int
Camil Staps's avatar
Camil Staps committed
52
                 , distance :: Int
Camil Staps's avatar
Camil Staps committed
53
                 , builtin  :: Maybe Bool
Camil Staps's avatar
Camil Staps committed
54 55
                 }

Camil Staps's avatar
Camil Staps committed
56
:: FunctionResult :== (BasicResult, FunctionResultExtras)
Camil Staps's avatar
Camil Staps committed
57 58 59 60 61
:: FunctionResultExtras = { func                :: String
                          , unifier             :: Maybe StrUnifier
                          , cls                 :: Maybe ShortClassResult
                          , constructor_of      :: Maybe String
                          , recordfield_of      :: Maybe String
Camil Staps's avatar
Camil Staps committed
62
                          , generic_derivations :: Maybe [(String, [(String,String,Maybe Int)])]
Camil Staps's avatar
Camil Staps committed
63 64 65 66 67
                          }

:: TypeResult :== (BasicResult, TypeResultExtras)
:: TypeResultExtras = { type :: String
                      }
68

Camil Staps's avatar
Camil Staps committed
69
:: ClassResult :== (BasicResult, ClassResultExtras)
70 71 72
:: ClassResultExtras = { class_name      :: String
                       , class_heading   :: String
                       , class_funs      :: [String]
Camil Staps's avatar
Camil Staps committed
73
                       , class_instances :: [(String, [(String,String,Maybe Int)])]
Camil Staps's avatar
Camil Staps committed
74 75
                       }

Camil Staps's avatar
Camil Staps committed
76
:: MacroResult :== (BasicResult, MacroResultExtras)
77
:: MacroResultExtras = { macro_name           :: String
Camil Staps's avatar
Camil Staps committed
78 79 80
                       , macro_representation :: String
                       }

81 82
:: StrUnifier :== ([(String,String)], [(String,String)])

Camil Staps's avatar
Camil Staps committed
83 84
:: ErrorResult = Error Int String

Camil Staps's avatar
Camil Staps committed
85
:: ShortClassResult = { cls_name :: String, cls_vars :: [String] }
Camil Staps's avatar
Camil Staps committed
86

Camil Staps's avatar
Camil Staps committed
87
derive JSONEncode Request, Response, Result, ShortClassResult, BasicResult,
Camil Staps's avatar
Camil Staps committed
88
	FunctionResultExtras, TypeResultExtras, ClassResultExtras, MacroResultExtras
Camil Staps's avatar
Camil Staps committed
89
derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult,
Camil Staps's avatar
Camil Staps committed
90
	FunctionResultExtras, TypeResultExtras, ClassResultExtras, MacroResultExtras
91

Camil Staps's avatar
Camil Staps committed
92 93
instance zero Request
where
Camil Staps's avatar
Camil Staps committed
94 95 96
	zero = { unify     = Nothing
	       , name      = Nothing
	       , className = Nothing
Camil Staps's avatar
Camil Staps committed
97
	       , typeName  = Nothing
Camil Staps's avatar
Camil Staps committed
98
	       , modules   = Nothing
Camil Staps's avatar
Camil Staps committed
99
	       , libraries = Nothing
Camil Staps's avatar
Camil Staps committed
100
	       , page      = Nothing
Camil Staps's avatar
Camil Staps committed
101 102
	       }

103
instance toString Response where toString r = toString (toJSON r) + "\n"
Camil Staps's avatar
Camil Staps committed
104
instance toString Request where toString r = toString $ toJSON r
105

Camil Staps's avatar
Camil Staps committed
106
instance fromString (Maybe Request) where fromString s = fromJSON $ fromString s
107

Camil Staps's avatar
Camil Staps committed
108 109 110 111 112 113 114
instance < BasicResult where (<) r1 r2 = r1.distance < r2.distance
instance < Result
where
	(<) r1 r2 = basic r1 < basic r2
	where
		basic :: Result -> BasicResult
		basic (FunctionResult (br,_)) = br
115 116 117
		basic (TypeResult     (br,_)) = br
		basic (ClassResult    (br,_)) = br
		basic (MacroResult    (br,_)) = br
118 119

err :: Int String -> Response
Camil Staps's avatar
Camil Staps committed
120 121 122 123 124 125
err c m = { return         = c
          , data           = []
          , msg            = m
          , more_available = Nothing
          , suggestions    = Nothing
          }
126

127
E_NORESULTS    :== 127
Camil Staps's avatar
Camil Staps committed
128
E_INVALIDINPUT :== 128
129 130
E_INVALIDNAME  :== 129
E_INVALIDTYPE  :== 130
Camil Staps's avatar
Camil Staps committed
131

132
MAX_RESULTS    :== 15
133

134 135 136 137 138 139 140 141 142
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"
143
#! db = fromJust db
Camil Staps's avatar
Camil Staps committed
144
= serve (handle db) (Just log) port w
145
where
Camil Staps's avatar
Camil Staps committed
146 147 148 149 150
	help :: *File *World -> *World
	help io w
	# io = io <<< "Usage: ./CloogleServer <port>\n"
	= snd $ fclose io w

151
	handle :: !TypeDB !(Maybe Request) !*World -> *(!Response, !*World)
Camil Staps's avatar
Camil Staps committed
152
	handle _ Nothing w = (err E_INVALIDINPUT "Couldn't parse input", w)
Camil Staps's avatar
Camil Staps committed
153
	handle db (Just request=:{unify,name,page}) w
154
		| isJust name && size (fromJust name) > 40
Camil Staps's avatar
Camil Staps committed
155 156 157
			= (err E_INVALIDNAME "function name too long", w)
		| isJust name && any isSpace (fromString $ fromJust name)
			= (err E_INVALIDNAME "name cannot contain spaces", w)
Camil Staps's avatar
Camil Staps committed
158 159
		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
			= (err E_INVALIDTYPE "couldn't parse type", w)
Camil Staps's avatar
Camil Staps committed
160 161
		// Results
		# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
Camil Staps's avatar
oops  
Camil Staps committed
162
		# results = drop drop_n $ sort $ search request db
Camil Staps's avatar
Camil Staps committed
163 164
		# more = max 0 (length results - MAX_RESULTS)
		// Suggestions
165
		# mbType = unify >>= parseType o fromString
Camil Staps's avatar
Camil Staps committed
166
		# suggestions
167 168
			= sortBy (\a b -> snd a > snd b) <$>
			  filter ((<)(length results) o snd) <$>
169 170
			  (mbType >>= \t -> suggs name t db)
		# results = take MAX_RESULTS results
Camil Staps's avatar
Camil Staps committed
171 172 173 174 175 176 177 178 179 180
		// Response
		| isEmpty results = (err E_NORESULTS "No results", w)
		= ( { return = 0
		    , msg = "Success"
		    , data           = results
		    , more_available = Just more
		    , suggestions    = suggestions
		    }
		  , w)

181
	suggs :: !(Maybe String) !Type !TypeDB -> Maybe [(Request, Int)]
182
	suggs n (Func is r cc) db
183 184
		| length is < 3
			= Just [let t` = concat $ print False $ Func is` r cc in
185 186
			        let request = {zero & name=n, unify=Just t`} in
			        (request, length $ search request db)
187
			        \\ is` <- permutations is | is` <> is]
188
	suggs _ _ _ = Nothing
Camil Staps's avatar
Camil Staps committed
189

190
	search :: !Request !TypeDB -> [Result]
Camil Staps's avatar
Camil Staps committed
191 192 193 194
	search {unify,name,className,typeName,modules,libraries,page} db
		# db = case libraries of
			(Just ls) = filterLocations (isLibMatch ls) db
			Nothing   = db
195 196 197
		# db = case modules of
			(Just ms) = filterLocations (isModMatch ms) db
			Nothing   = db
Camil Staps's avatar
Camil Staps committed
198 199 200 201
		| isJust className
			# className = fromJust className
			# classes = findClass className db
			= map (flip makeClassResult db) classes
Camil Staps's avatar
Camil Staps committed
202 203 204 205
		| isJust typeName
			# typeName = fromJust typeName
			# types = findType typeName db
			= map (uncurry (makeTypeResult (Just typeName))) types
206
		# mbType = prepare_unification True <$> (unify >>= parseType o fromString)
Camil Staps's avatar
Camil Staps committed
207
		// Search normal functions
208
		# filts = catMaybes [ (\t _ -> isUnifiable t) <$> mbType
209
		                    , (\n loc _ -> isNameMatch (size n*2/3) n loc) <$> name
210
		                    ]
211
		# funs = map (\f -> makeFunctionResult name mbType Nothing f db) $ findFunction`` filts db
Camil Staps's avatar
Camil Staps committed
212
		// Search macros
213
		# macros = case (isNothing mbType,name) of
214
			(True,Just n) = findMacro` (\loc _ -> isNameMatch (size n*2/3) n loc) db
215
			_             = []
Camil Staps's avatar
Camil Staps committed
216
		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
Camil Staps's avatar
Camil Staps committed
217
		// Search class members
Camil Staps's avatar
Camil Staps committed
218
		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
219
		                    , (\n (Location lib mod _ _) _ _ f _ -> isNameMatch
220
		                      (size n*2/3) n (Location lib mod Nothing f)) <$> name
221
		                    ]
Camil Staps's avatar
Camil Staps committed
222
		# members = findClassMembers`` filts db
223 224
		# members = map (\(Location lib mod line cls,vs,_,f,et) -> makeFunctionResult name mbType
			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line f,et) db) members
Camil Staps's avatar
Camil Staps committed
225
		// Search types
226
		# lcName = if (isJust mbType && isType (fromJust mbType))
Camil Staps's avatar
Camil Staps committed
227 228
			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
			(toLowerCase <$> name)
229 230 231
		# types = case (isNothing mbType,lcName) of
			(True,Just n) = findType` (\loc _ -> toLowerCase (getName loc) == n) db
			_             = []
Camil Staps's avatar
Camil Staps committed
232
		# types = map (\(tl,td) -> makeTypeResult name tl td) types
233 234
		// Search classes
		# classes = case (isNothing mbType, toLowerCase <$> name) of
235
			(True, Just c) = findClass` (\(Location _ _ _ c`) _ _ _ -> toLowerCase c` == c) db
Camil Staps's avatar
Camil Staps committed
236 237
			_              = []
		# classes = map (flip makeClassResult db) classes
Camil Staps's avatar
Camil Staps committed
238
		// Merge results
Camil Staps's avatar
Camil Staps committed
239
		= sort $ funs ++ members ++ types ++ classes ++ macros
Camil Staps's avatar
Camil Staps committed
240

241
	makeClassResult :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
Camil Staps's avatar
Camil Staps committed
242
		TypeDB -> Result
243
	makeClassResult (Location lib mod line cls, vars, cc, funs) db
Camil Staps's avatar
Camil Staps committed
244 245 246
		= ClassResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
247
		    , dcl_line = line
Camil Staps's avatar
Camil Staps committed
248
		    , modul    = mod
249
		    , distance = -100
Camil Staps's avatar
Camil Staps committed
250
		    , builtin  = Nothing
Camil Staps's avatar
Camil Staps committed
251 252
		    }
		  , { class_name = cls
253
		    , class_heading = foldl ((+) o (flip (+) " ")) cls vars +
Camil Staps's avatar
Camil Staps committed
254
		        if (isEmpty cc) "" " " + concat (print False cc)
255
		    , class_funs = [print_fun fun \\ fun <- funs]
Camil Staps's avatar
Camil Staps committed
256
		    , class_instances
Camil Staps's avatar
Camil Staps committed
257 258
		        = sortBy (\(a,_) (b,_) -> a < b)
		            [(concat (print False t), map loc ls) \\ (t,ls) <- getInstances cls db]
Camil Staps's avatar
Camil Staps committed
259 260
		    }
		  )
261 262 263 264
	where
		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
265

266 267
	makeTypeResult :: (Maybe String) Location TypeDef -> Result
	makeTypeResult mbName (Location lib mod line t) td
Camil Staps's avatar
Camil Staps committed
268 269 270
		= TypeResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
271
		    , dcl_line = line
Camil Staps's avatar
Camil Staps committed
272
		    , modul    = mod
Camil Staps's avatar
Camil Staps committed
273
		    , distance
274
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
Camil Staps's avatar
Camil Staps committed
275 276 277 278
		    , builtin  = Nothing
		    }
		  , { type = concat $ print False td }
		  )
279
	makeTypeResult mbName (Builtin t) td
Camil Staps's avatar
Camil Staps committed
280 281 282
		= TypeResult
		  ( { library  = ""
		    , filename = ""
Camil Staps's avatar
Camil Staps committed
283
		    , dcl_line = Nothing
Camil Staps's avatar
Camil Staps committed
284 285 286 287
		    , modul    = ""
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Just True
Camil Staps's avatar
Camil Staps committed
288
		    }
289
		  , { type = concat $ print False td }
Camil Staps's avatar
Camil Staps committed
290 291
		  )

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

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

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

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

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

365 366 367 368 369 370
			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
371

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

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

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

382 383 384
	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
385
		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein [c \\ c <-: n1] [c \\ c <-: n2] <= maxdist
Camil Staps's avatar
Camil Staps committed
386

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

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

Camil Staps's avatar
Camil Staps committed
395 396 397
	loc :: Location -> (String, String, Maybe Int)
	loc (Location lib mod ln _) = (lib, mod, ln)

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

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

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