CloogleServer.icl 14.2 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
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 24
import qualified StdMaybe as OldMaybe
from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
25 26 27 28
import TypeDB
import Type
import Levenshtein

29 30
:: OldMaybe a :== 'SimpleTCPServer'.Maybe a

Camil Staps's avatar
Camil Staps committed
31 32 33
:: Request = { unify     :: Maybe String
             , name      :: Maybe String
             , className :: Maybe String
Camil Staps's avatar
Camil Staps committed
34
             , typeName  :: Maybe String
Camil Staps's avatar
Camil Staps committed
35 36
             , modules   :: Maybe [String]
             , page      :: Maybe Int
37 38
             }

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

Camil Staps's avatar
Camil Staps committed
46
:: Result = FunctionResult FunctionResult
Camil Staps's avatar
Camil Staps committed
47
          | TypeResult TypeResult
Camil Staps's avatar
Camil Staps committed
48
          | ClassResult ClassResult
Camil Staps's avatar
Camil Staps committed
49
          | MacroResult MacroResult
Camil Staps's avatar
Camil Staps committed
50 51 52 53

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

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

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

Camil Staps's avatar
Camil Staps committed
72 73 74 75 76 77 78
:: ClassResult :== (BasicResult, ClassResultExtras)
:: ClassResultExtras = { class_name :: String
                       , class_heading :: String
                       , class_funs :: [String]
                       , class_instances :: [String]
                       }

Camil Staps's avatar
Camil Staps committed
79 80 81 82 83
:: MacroResult :== (BasicResult, MacroResultExtras)
:: MacroResultExtras = { macro_name :: String
                       , macro_representation :: String
                       }

84 85
:: StrUnifier :== ([(String,String)], [(String,String)])

Camil Staps's avatar
Camil Staps committed
86 87
:: ErrorResult = Error Int String

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

Camil Staps's avatar
Camil Staps committed
90
derive JSONEncode Request, Response, Result, ShortClassResult, BasicResult,
Camil Staps's avatar
Camil Staps committed
91
	FunctionResultExtras, TypeResultExtras, ClassResultExtras, MacroResultExtras
Camil Staps's avatar
Camil Staps committed
92
derive JSONDecode Request, Response, Result, ShortClassResult, BasicResult,
Camil Staps's avatar
Camil Staps committed
93
	FunctionResultExtras, TypeResultExtras, ClassResultExtras, MacroResultExtras
94

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

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

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

Camil Staps's avatar
Camil Staps committed
110 111 112 113 114 115 116
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
Camil Staps's avatar
Camil Staps committed
117
		basic (TypeResult (br,_)) = br
Camil Staps's avatar
Camil Staps committed
118
		basic (ClassResult (br,_)) = br
Camil Staps's avatar
Camil Staps committed
119
		basic (MacroResult (br,_)) = br
120 121

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

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

Camil Staps's avatar
Camil Staps committed
134
MAX_RESULTS :== 15
135

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

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

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

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

Camil Staps's avatar
Camil Staps committed
242 243
	makeClassResult :: (ClassLocation, [TypeVar], ClassContext, [(FunctionName,ExtendedType)])
		TypeDB -> Result
Camil Staps's avatar
Camil Staps committed
244
	makeClassResult (CL lib mod cls line, vars, cc, funs) db
Camil Staps's avatar
Camil Staps committed
245 246 247
		= ClassResult
		  ( { library  = lib
		    , filename = modToFilename mod
Camil Staps's avatar
Camil Staps committed
248
		    , dcl_line = line
Camil Staps's avatar
Camil Staps committed
249
		    , modul    = mod
250
		    , distance = -100
Camil Staps's avatar
Camil Staps committed
251
		    , builtin  = Nothing
Camil Staps's avatar
Camil Staps committed
252 253
		    }
		  , { class_name = cls
254
		    , class_heading = foldl ((+) o (flip (+) " ")) cls vars +
Camil Staps's avatar
Camil Staps committed
255
		        if (isEmpty cc) "" " " + concat (print False cc)
256
		    , class_funs = [concat $ print False fun \\ fun <- funs]
Camil Staps's avatar
Camil Staps committed
257 258 259 260 261
		    , class_instances
		        = sort [concat (print False t) \\ t <- getInstances cls db]
		    }
		  )

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

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

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

337 338
		toStrUnifier :: Unifier -> StrUnifier
		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
339
		where toStr (var, type) = (var, concat $ print False type)
340

Camil Staps's avatar
Camil Staps committed
341
		toStrPriority :: (Maybe TE_Priority) -> String
342
		toStrPriority p = case print False p of [] = ""; ss = concat [" ":ss]
Camil Staps's avatar
Camil Staps committed
343

Camil Staps's avatar
Camil Staps committed
344
		distance
Camil Staps's avatar
Camil Staps committed
345
			| isNothing orgsearch || fromJust orgsearch == ""
Camil Staps's avatar
Camil Staps committed
346 347
				| isNothing orgsearchtype = 0
				# orgsearchtype = fromJust orgsearchtype
348 349 350
				# (Just (ass1, ass2)) = finish_unification <$>
					unify [] orgsearchtype (prepare_unification False type)
				= toInt $ sum [typeComplexity t \\ (_,t)<-ass1 ++ ass2 | not (isVar t)]
351
			# orgsearch = fromJust orgsearch
Camil Staps's avatar
Camil Staps committed
352
			= levenshtein` orgsearch fname
353
		where
354 355 356 357 358 359
			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
360

Camil Staps's avatar
Camil Staps committed
361 362 363
	levenshtein` :: String String -> Int
	levenshtein` a b = if (indexOf a b == -1) 0 -100 + levenshtein a b

Camil Staps's avatar
Camil Staps committed
364 365
	modToFilename :: String -> String
	modToFilename mod = (toString $ reverse $ takeWhile ((<>)'.')
366
	                              $ reverse $ fromString mod) + ".dcl"
Camil Staps's avatar
Camil Staps committed
367

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

Camil Staps's avatar
Camil Staps committed
371
	isNameMatch :: !Int !String FunctionLocation -> Bool
Camil Staps's avatar
Camil Staps committed
372 373
	isNameMatch maxdist n1 fl
		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName fl})
Camil Staps's avatar
Camil Staps committed
374
		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein n1 n2 <= maxdist
Camil Staps's avatar
Camil Staps committed
375
	where
Camil Staps's avatar
Camil Staps committed
376
		getName (FL _ _ n _) = n; getName (FL_Builtin n) = n
Camil Staps's avatar
Camil Staps committed
377

Camil Staps's avatar
Camil Staps committed
378
	isModMatchF :: ![String] FunctionLocation ExtendedType -> Bool
Camil Staps's avatar
Camil Staps committed
379
	isModMatchF mods (FL _ mod _ _) _ = isMember mod mods
Camil Staps's avatar
Camil Staps committed
380

Camil Staps's avatar
Camil Staps committed
381
	isModMatchC :: ![String] ClassLocation [TypeVar] ClassContext FunctionName ExtendedType -> Bool
Camil Staps's avatar
Camil Staps committed
382
	isModMatchC mods (CL _ mod _ _) _ _ _ _ = isMember mod mods
Camil Staps's avatar
Camil Staps committed
383 384

	log :: (LogMessage (Maybe Request) Response) IPAddress *World
385
	       -> *(IPAddress, *World)
Camil Staps's avatar
Camil Staps committed
386
	log msg s w
Camil Staps's avatar
Camil Staps committed
387 388
	| not needslog = (newS msg s, w)
	# (tm,w) = localTime w
Camil Staps's avatar
Camil Staps committed
389
	# (io,w) = stdio w
Camil Staps's avatar
Camil Staps committed
390
	# io = io <<< trim (toString tm) <<< " " <<< msgToString msg s
Camil Staps's avatar
Camil Staps committed
391
	= (newS msg s, snd (fclose io w))
Camil Staps's avatar
Camil Staps committed
392 393
	where
		needslog = case msg of (Received _) = True; (Sent _) = True; _ = False
Camil Staps's avatar
Camil Staps committed
394

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

Camil Staps's avatar
Camil Staps committed
398
	msgToString :: (LogMessage (Maybe Request) Response) IPAddress -> String
Camil Staps's avatar
Camil Staps committed
399
	msgToString (Received Nothing) ip
400
		= toString ip + " <-- Nothing\n"
Camil Staps's avatar
Camil Staps committed
401
	msgToString (Received (Just a)) ip
402
		= toString ip + " <-- " + toString a + "\n"
Camil Staps's avatar
Camil Staps committed
403
	msgToString (Sent {return,data,msg,more_available}) ip
404 405 406
		= 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
407
	msgToString _ _ = ""