From e044cfaa625c5b38ab18a481c20eb743fccb285d Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Mar 2017 11:30:57 +0100 Subject: [PATCH] add submodule and add \!query search --- .gitmodules | 3 +++ Makefile | 1 + cloogle-sub | 1 + cloogle.icl | 72 +++++++++++++++++++++++++++++++++++++++-------------- 4 files changed, 58 insertions(+), 19 deletions(-) create mode 100644 .gitmodules create mode 160000 cloogle-sub diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..6292283 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "cloogle-sub"] + path = cloogle-sub + url = https://github.com/clean-cloogle/cloogle.git diff --git a/Makefile b/Makefile index 52e804e..ca5595b 100644 --- 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 index 0000000..ac8e331 --- /dev/null +++ b/cloogle-sub @@ -0,0 +1 @@ +Subproject commit ac8e33102880d63c6a9f9bc33c3d2e412d7a5ac4 diff --git a/cloogle.icl b/cloogle.icl index 874d177..fa3bb50 100644 --- a/cloogle.icl +++ b/cloogle.icl @@ -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) -- 2.20.1