add submodule and add \!query search
authorMart Lubbers <mart@martlubbers.net>
Mon, 6 Mar 2017 10:30:57 +0000 (11:30 +0100)
committerMart Lubbers <mart@martlubbers.net>
Mon, 6 Mar 2017 10:30:57 +0000 (11:30 +0100)
.gitmodules [new file with mode: 0644]
Makefile
cloogle-sub [new submodule]
cloogle.icl

diff --git a/.gitmodules b/.gitmodules
new file mode 100644 (file)
index 0000000..6292283
--- /dev/null
@@ -0,0 +1,3 @@
+[submodule "cloogle-sub"]
+       path = cloogle-sub
+       url = https://github.com/clean-cloogle/cloogle.git
index 52e804e..ca5595b 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -13,6 +13,7 @@ CLMLIBS:=\
        -I $(CLEAN_HOME)/lib/Generics\
        -I $(CLEAN_HOME)/lib/TCPIP\
        -I $(CLEAN_HOME)/lib/Dynamics\
+       -I ./cloogle-sub/backend
 
 BINARIES:=test cloogle
 
diff --git a/cloogle-sub b/cloogle-sub
new file mode 160000 (submodule)
index 0000000..ac8e331
--- /dev/null
@@ -0,0 +1 @@
+Subproject commit ac8e33102880d63c6a9f9bc33c3d2e412d7a5ac4
index 874d177..fa3bb50 100644 (file)
@@ -1,5 +1,6 @@
 module cloogle
 
+import Cloogle
 import GenPrint
 import IRC
 import StdEnv
@@ -9,6 +10,8 @@ import Data.Maybe
 from Data.Func import $
 from Text import class Text(..), instance Text String, instance + String
 
+import Text.JSON
+
 import Text.URI
 
 import Control.Applicative
@@ -122,11 +125,44 @@ cloogle data w
                { newHTTPRequest
                & req_path = "/api.php"
                , req_query = "?str=" + urlEncode data
+               , req_headers = 'DM'.fromList [("User-Agent", "cloogle-irc")]
                , server_name = "cloogle.org"
                , server_port = 80} 10 w
 | isError mer = ("request failed: " + fromError mer, w)
 # resp = fromOk mer
-= (resp.rsp_data, w)
+= case fromJSON $ fromString resp.HTTPResponse.rsp_data of
+       Nothing = ("couldn't parse json", w)
+       Just clr = ("Results for " + data + " -- https://cloogle.org/#" + urlEncode data + "\n" +
+                       processResults clr, w)
+       where
+               processResults :: Response -> String
+               processResults resp
+               | resp.return > 127 = "Failed: return code: " + toString resp.return + ", " + resp.msg
+               = join "\n" $ map processResult $ take 3 resp.data
+               
+               processResult :: Result -> String
+               processResult (FunctionResult (br, {func}))
+                       = "Function in " +++ br.library +++ ": " +++ br.modul +++ " - " +++ func
+               processResult (TypeResult (br, {type}))
+                       = "Type in " +++ br.library +++ ": " +++ br.modul +++ " - " +++ limitResults type
+               processResult (ClassResult (br, {class_name,class_funs}))
+                       = "Class in " +++ br.library +++ ": " +++ br.modul +++ " - " +++ class_name +++ " with "
+                               +++ toString (length class_funs) +++ " class functions"
+               processResult (MacroResult (br, {macro_name}))
+                       = "Macro in " +++ br.library +++ ": " +++ br.modul +++ " - " +++ macro_name
+               processResult (ModuleResult (br, _))
+                       = "Module in " +++ br.library +++ ": " +++ br.modul
+
+               limitResults :: String -> String
+               limitResults s
+               # lines = split "\n" s
+               | length lines > 4 = limitResults (join "\n" (take 3 lines) + "\n...")
+               = join "\n" (map maxWidth lines)
+               
+               maxWidth :: String -> String
+               maxWidth s
+               | size s > 80 = subString 0 77 s + "..."
+               = s
 
 send :: [String] TCP_DuplexChannel *World -> (TCP_DuplexChannel, *World)
 send [] chan w = (chan, w)
@@ -160,7 +196,7 @@ process io chan w
                ["ping":xs] = (w, Just [msg $ "pong " +++ join " " xs])
                ["query":xs]
                        # (s, w) = cloogle (join " " xs) w
-                       = (w, Just [msg s])
+                       = (w, Just $ map msg $ split "\n" s)
                ["short"] = (w, Just [msg $ "short requires an url argument"])
                ["short":xs]
                        # (s, w) = shorten (join " " xs) w
@@ -185,20 +221,18 @@ process io chan w
        = process io chan w
 = process io chan w
 
-Start :: *World -> (String, *World)
-Start w = cloogle "Monad" w
-//Start :: *World -> *World
-//Start w
-//# (io, w) = stdio w
-//# (ip, w) = lookupIPAddress SERVER w
-//| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
-//# (Just ip) = ip
-//# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
-//| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
-//| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
-//# chan = fromJust chan
-//# (chan, w) = send commands chan w
-//# (io, chan, w) = process io chan w
-//# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
-//# (_, w) = fclose io w
-//= closeChannel sChannel (closeRChannel rChannel w)
+Start :: *World -> *World
+Start w
+# (io, w) = stdio w
+# (ip, w) = lookupIPAddress SERVER w
+| isNothing ip = abort $ "DNS lookup for " +++ SERVER +++ " failed\n"
+# (Just ip) = ip
+# (rpt,chan,w) = connectTCP_MT TIMEOUT (ip, 6667) w
+| rpt == TR_Expired = abort $ "Connection to " +++ SERVER +++ " timed out\n"
+| rpt == TR_NoSuccess = abort $ "Could not connect to " +++ SERVER +++ "\n"
+# chan = fromJust chan
+# (chan, w) = send commands chan w
+# (io, chan, w) = process io chan w
+# ({sChannel,rChannel}, w) = send [toString $ QUIT Nothing] chan w
+# (_, w) = fclose io w
+= closeChannel sChannel (closeRChannel rChannel w)