hsdev 0.1.2.3 → 0.1.2.4

raw patch · 5 files changed

+101/−86 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hsdev.cabal +1/−1
• src/HsDev/Client/Commands.hs +10/−4
• src/HsDev/Tools/Ghc/Prelude.hs +9/−1
• src/HsDev/Tools/Hayoo.hs +71/−77
• tools/hshayoo.hs +10/−3

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/
 
 name:                hsdev
-version:             0.1.2.3
+version:             0.1.2.4
 synopsis:            Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references etc.
 description:
   Haskell development library and tool with support of autocompletion, symbol info, go to declaration, find references, hayoo search etc.

@@ -111,7 +111,7 @@ 	cmd' "scope" [] (ctx ++ matches ++ [globalArg]) "get declarations accessible from module or within a project" scope',
 	cmd' "complete" ["input"] ctx "show completions for input" complete',
 	-- Tool commands
-	cmd' "hayoo" ["query"] [] "find declarations online via Hayoo" hayoo',
+	cmd' "hayoo" ["query"] hayooArgs "find declarations online via Hayoo" hayoo',
 	cmd' "cabal list" ["packages..."] [] "list cabal packages" cabalList',
 	cmd' "ghc-mod type" ["line", "column"] (ctx ++ [ghcOpts]) "infer type with 'ghc-mod type'" ghcmodType',
 	cmd' "ghc-mod check" ["files..."] [sandboxArg, ghcOpts] "check source files" ghcmodCheck',
@@ -150,6 +150,9 @@ 		findArg = req "find" "query" `desc` "infix match"
 		ghcOpts = list "ghc" "option" `short` ['g'] `desc` "options to pass to GHC"
 		globalArg = flag "global" `desc` "scope of project"
+		hayooArgs = [
+			req "page" "n" `short` ['p'] `desc` "page number (0 by default)",
+			req "pages" "count" `short` ['n'] `desc` "pages count (1 by default)"]
 		hlintOpts = list "hlint" "option" `short` ['h'] `desc` "options to pass to hlint"
 		holdArg = flag "hold" `short` ['h'] `desc` "don't return any response"
 		localsArg = flag "locals" `short` ['l'] `desc` "look in local declarations"
@@ -428,9 +431,12 @@ 		-- | Hayoo
 		hayoo' :: [String] -> Opts String -> CommandActionT [ModuleDeclaration]
 		hayoo' [] _ _ = commandError "Query not specified" []
-		hayoo' [query] _ _ = liftM
-				(map Hayoo.hayooAsDeclaration . Hayoo.hayooFunctions) $
-				mapErrorStr $ Hayoo.hayoo query
+		hayoo' [query] opts _ = liftM concat $ forM [page .. page + pred pages] $ \i -> liftM
+			(mapMaybe Hayoo.hayooAsDeclaration . Hayoo.resultResult) $
+			mapErrorStr $ Hayoo.hayoo query (Just i)
+			where
+				page = fromMaybe 0 $ narg "page" opts
+				pages = fromMaybe 1 $ narg "pages" opts
 		hayoo' _ _ _ = commandError "Too much arguments" []
 
 		-- | Cabal list

@@ -1,8 +1,10 @@ module HsDev.Tools.Ghc.Prelude (
-	reduce, one, trim
+	reduce, one, trim,
+	rx, srx
 	) where
 
 import Data.Char (isSpace)
+import Text.RegexPR
 
 reduce :: ([a] -> a) -> [a] -> [a]
 reduce = (return .)
@@ -13,3 +15,9 @@ trim :: String -> String
 trim = p . p where
 	p = reverse . dropWhile isSpace
+
+rx :: String -> String -> Maybe String
+rx r = fmap (fst . fst) . matchRegexPR r
+
+srx :: String -> String -> String -> String
+srx = gsubRegexPR

@@ -2,7 +2,7 @@ 
 module HsDev.Tools.Hayoo (
 	-- * Types
-	HayooResult(..), HayooFunction(..), HayooCompletion(..), HayooName(..),
+	HayooResult(..), HayooSymbol(..),
 	hayooAsDeclaration,
 	-- * Search help online
 	hayoo,
@@ -16,6 +16,7 @@ 
 import Data.Aeson
 import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Either
 import Network.HTTP
 import Text.RegexPR (gsubRegexPR)
 
@@ -25,111 +26,104 @@ 
 -- | Hayoo response
 data HayooResult = HayooResult {
-	hayooMessage :: String,
-	hayooHits :: Int,
-	hayooFunctions :: [HayooFunction],
-	hayooCompletions :: [HayooCompletion],
-	hayooModules :: [HayooName],
-	hayooPackages :: [HayooName] }
+	resultMax :: Int,
+	resultOffset :: Int,
+	resultCount :: Int,
+	resultResult :: [HayooSymbol] }
 		deriving (Eq, Ord, Read, Show)
 
-instance FromJSON HayooResult where
-	parseJSON = withObject "hayoo response" $ \v -> HayooResult <$>
-		(v .:: "message") <*>
-		(v .:: "hits") <*>
-		(v .:: "functions") <*>
-		(v .:: "completions") <*>
-		(v .:: "modules") <*>
-		(v .:: "packages")
-
--- | Hayoo function information
-data HayooFunction = HayooFunction {
+-- | Hayoo symbol
+data HayooSymbol = HayooSymbol {
+	resultUri :: String,
+	tag :: String,
+	hayooPackage :: String,
 	hayooName :: String,
+	hayooSource :: String,
+	hayooDescription :: String,
 	hayooSignature :: String,
-	hayooModule :: String,
-	hayooPackage :: String,
-	hayooHackage :: String,
-	hayooDescription :: String }
+	hayooModules :: [String],
+	hayooScore :: Double,
+	hayooType :: String }
 		deriving (Eq, Ord, Read, Show)
 
-instance Symbol HayooFunction where
+newtype HayooValue = HayooValue { hayooValue :: Either Value HayooSymbol }
+
+instance FromJSON HayooResult where
+	parseJSON = withObject "hayoo response" $ \v -> HayooResult <$>
+		(v .:: "max") <*>
+		(v .:: "offset") <*>
+		(v .:: "count") <*>
+		((rights . map hayooValue) <$> (v .:: "result"))
+
+instance Symbol HayooSymbol where
 	symbolName = hayooName
-	symbolQualifiedName f = hayooModule f ++ "." ++ hayooName f
+	symbolQualifiedName f = case hayooModules f of
+		[] -> hayooName f
+		(m:_) -> m ++ "." ++ hayooName f
 	symbolDocs = Just . hayooDescription
-	symbolLocation r = Location (ModuleSource $ Just $ hayooHackage r) Nothing where
+	symbolLocation r = Location (ModuleSource $ Just $ resultUri r) Nothing where
 
-instance Documented HayooFunction where
+instance Documented HayooSymbol where
 	brief f
-		| hayooSignature f `elem` ["type", "newtype", "data", "class"] =
-			hayooSignature f ++ " " ++ hayooName f
-		| otherwise = hayooName f ++ " :: " ++ hayooSignature f
+		| hayooType f == "function" = hayooName f ++ " :: " ++ hayooSignature f
+		| otherwise = hayooType f ++ " " ++ hayooName f
 	detailed f = unlines $ defaultDetailed f ++ online where
 		online = [
 			"", "Hayoo online documentation", "",
 			"Package: " ++ hayooPackage f,
-			"Hackage URL: " ++ hayooHackage f]
-
-instance FromJSON HayooFunction where
-	parseJSON = withObject "function" $ \v -> HayooFunction <$>
-		(v .:: "name") <*>
-		(v .:: "signature") <*>
-		(v .:: "module") <*>
-		(v .:: "package") <*>
-		(v .:: "uri") <*>
-		(v .:: "description")
-
--- | Hayoo completions
-data HayooCompletion = HayooCompletion {
-	completionWord :: String,
-	completionCount :: Int }
-		deriving (Eq, Ord, Read, Show)
-
-instance FromJSON HayooCompletion where
-	parseJSON = withObject "completion" $ \v -> HayooCompletion <$>
-		(v .:: "word") <*>
-		(v .:: "count")
+			"Hackage URL: " ++ resultUri f]
 
--- | Hayoo name
-data HayooName = HayooName {
-	nameName :: String,
-	nameCount :: Int }
-		deriving (Eq, Ord, Read, Show)
+instance FromJSON HayooSymbol where
+	parseJSON = withObject "symbol" $ \v -> HayooSymbol <$>
+		(v .:: "resultUri") <*>
+		(v .:: "tag") <*>
+		(v .:: "resultPackage") <*>
+		(v .:: "resultName") <*>
+		(v .:: "resultSource") <*>
+		(v .:: "resultDescription") <*>
+		(v .:: "resultSignature") <*>
+		(v .:: "resultModules") <*>
+		(v .:: "resultScore") <*>
+		(v .:: "resultType")
 
-instance FromJSON HayooName where
-	parseJSON = withObject "name" $ \v -> HayooName <$>
-		(v .:: "name") <*>
-		(v .:: "count")
+instance FromJSON HayooValue where
+	parseJSON v = HayooValue <$> ((Right <$> parseJSON v) <|> pure (Left v))
 
 -- | 'HayooFunction' as 'Declaration'
-hayooAsDeclaration :: HayooFunction -> ModuleDeclaration
-hayooAsDeclaration f = ModuleDeclaration {
-	declarationModuleId = ModuleId {
-		moduleIdName = hayooModule f,
-		moduleIdLocation = ModuleSource (Just $ hayooHackage f) },
-	moduleDeclaration = Declaration {
-		declarationName = hayooName f,
-		declarationDocs = Just (addOnline $ untagDescription $ hayooDescription f),
-		declarationPosition = Nothing,
-		declaration = declInfo } }
+hayooAsDeclaration :: HayooSymbol -> Maybe ModuleDeclaration
+hayooAsDeclaration f
+	| hayooType f `elem` ["function", "type", "newtype", "data", "class"] = Just ModuleDeclaration {
+		declarationModuleId = ModuleId {
+			moduleIdName = head $ hayooModules f,
+			moduleIdLocation = ModuleSource (Just $ resultUri f) },
+		moduleDeclaration = Declaration {
+			declarationName = hayooName f,
+			declarationDocs = Just (addOnline $ untagDescription $ hayooDescription f),
+			declarationPosition = Nothing,
+			declaration = declInfo } }
+	| otherwise = Nothing
 	where
 		-- Add other info
-		addOnline d = unlines $ [
+		addOnline d = unlines [
 			d, "",
 			"Hayoo online documentation",
 			"",
 			"Package: " ++ hayooPackage f,
-			"Hackage URL: " ++ hayooHackage f]
+			"Hackage URL: " ++ resultUri f]
 
 		declInfo
-			| hayooSignature f `elem` ["type", "newtype", "data", "class"]
-				= declarationTypeCtor (hayooSignature f) $ TypeInfo Nothing [] Nothing
-			| otherwise = Function (Just $ hayooSignature f) []
+			| hayooType f == "function" = Function (Just $ hayooSignature f) []
+			| hayooType f `elem` ["type", "newtype", "data", "class"] = declarationTypeCtor (hayooType f) $ TypeInfo Nothing [] Nothing
+			| otherwise = error "Impossible"
 
 -- | Search hayoo
-hayoo :: String -> ErrorT String IO HayooResult
-hayoo q = do
-	resp <- ErrorT $ fmap (show +++ rspBody) $ simpleHTTP (getRequest $ "http://hayoo.fh-wedel.de/?query=" ++ urlEncode q)
+hayoo :: String -> Maybe Int -> ErrorT String IO HayooResult
+hayoo q page = do
+	resp <- ErrorT $ (show +++ rspBody) <$> simpleHTTP (getRequest $ maybe id addPage page $ "http://hayoo.fh-wedel.de/json/?query=" ++ urlEncode q)
 	ErrorT $ return $ eitherDecode $ L.pack resp
+	where
+		addPage :: Int -> String -> String
+		addPage p s = s ++ "&page=" ++ show p
 
 -- | Remove tags in description
 untagDescription :: String -> String

@@ -2,14 +2,21 @@ 	main
 	) where
 
-import Control.Monad (liftM)
+import Control.Monad (liftM, forM)
+import Data.Maybe
 import HsDev.Tools.Hayoo
 
 import Tool
 
 main :: IO ()
 main = toolMain "hshayoo" [
-	jsonCmd_ "" ["query"] "search in hayoo" hayoo']
+	jsonCmd "" ["query"] options "search in hayoo" hayoo']
 	where
-		hayoo' [q] = liftM (map hayooAsDeclaration . hayooFunctions) $ hayoo q
+		options = [
+			req "page" "n" `short` ['p'] `desc` "page number (0 by default)",
+			req "pages" "count" `short` ['n'] `desc` "pages count (1 by default)"]
+
+		hayoo' (Args [q] opts) = liftM concat $ forM [page .. page + pred pages] $ \i -> liftM (mapMaybe hayooAsDeclaration . resultResult) $ hayoo q (Just i) where
+			page = fromMaybe 0 (narg "page" opts)
+			pages = fromMaybe 1 (narg "pages" opts)
 		hayoo' _ = toolError "Invalid arguments"