Skip to content
Browse files

Add more places to check for Hoogle

  • Loading branch information...
1 parent 0ba86da commit 05d50600416200357b13a1782da439d5220cc310 @serras serras committed
Showing with 63 additions and 54 deletions.
  1. +1 −0 README.markdown
  2. +27 −27 src/Scion/PersistentHoogle.hs
  3. +3 −3 src/Scion/PersistentHoogle/Util.hs
  4. +32 −24 src/Server/PersistentCommands.hs
View
1 README.markdown
@@ -21,6 +21,7 @@ Currently, the functionality is provided via a command-line program which receiv
* `{ "command" : "set-current-db", "new-db" : id }`: sets the current database. `id` can take different values: `"_all"` for both Hackage and local databases, `"_hackage"` for Hackage database, `"_local"` for the local packages database and `{ "name" : "package-name", "version" : "x.y.z" }` for query only a specific package,
* `{ "command" : "get-modules", "module" : "mod" }`: get all descendants of the module `mod` (that is, if we query for modules in `A`, we would get `A.B`, `A.B.C`, and so on). To ask for all modules, query for module `""`,
* `{ "command" : "get-declarations", "module" : "mod" }`: queries the module `mod` for all declarations (datatypes, newtypes, typeclasses, instances, functions and type synonyms) inside it,
+* `{ "command" : "extra-hoogle-path", "path" : "pathToSearch" }`: adds another place to check for Hoogle,
* `{ "command" : "hoogle-query", "query" : "mapM" }`: sends a query to Hoogle and relates the results with the current database (that is, only results that are in the current database will be returned). For this to work, the `hoogle` package must be installed and `hoogle data` must have been run at least once,
* `{ "command" : "hoogle-data" }`: ask Hoogle to refresh its internal database, using `hoogle data`,
* `{ "command" : "hoogle-check" }`: checks whether there is a working Hoogle program with a saved database.
View
54 src/Scion/PersistentHoogle.hs
@@ -17,33 +17,33 @@ import System.Exit (ExitCode(..))
import System.Process
import Text.Parsec.Prim (runP)
-query :: String -> SqlPersist IO [Result]
-query q = do mpath <- liftIO $ findHoogleBinPath
- case mpath of
- Nothing -> return []
- Just path -> do (exitCode, output, err) <- liftIO $ readProcessWithExitCode path [q] ""
- case exitCode of
- ExitSuccess -> do let search = runP hoogleElements () "hoogle-output" (output)
- case search of
- Right result -> do dbResult <- result
- return dbResult
- Left _ -> return []
- _ -> do liftIO $ putStrLn err
- return []
+query :: Maybe String -> String -> SqlPersist IO [Result]
+query p q = do mpath <- liftIO $ findHoogleBinPath p
+ case mpath of
+ Nothing -> return []
+ Just path -> do (exitCode, output, err) <- liftIO $ readProcessWithExitCode path [q] ""
+ case exitCode of
+ ExitSuccess -> do let search = runP hoogleElements () "hoogle-output" (output)
+ case search of
+ Right result -> do dbResult <- result
+ return dbResult
+ Left _ -> return []
+ _ -> do liftIO $ putStrLn err
+ return []
-downloadData :: IO Bool
-downloadData = do mpath <- findHoogleBinPath
- case mpath of
- Nothing -> return False
- Just path -> do putStrLn "Running hoogle data..."
- (ec, _, err) <- readProcessWithExitCode path ["data"] ""
- when (ec/= ExitSuccess) (putStrLn err)
- return (ec == ExitSuccess)
+downloadData :: Maybe String -> IO Bool
+downloadData p = do mpath <- findHoogleBinPath p
+ case mpath of
+ Nothing -> return False
+ Just path -> do putStrLn "Running hoogle data..."
+ (ec, _, err) <- readProcessWithExitCode path ["data"] ""
+ when (ec/= ExitSuccess) (putStrLn err)
+ return (ec == ExitSuccess)
-checkDatabase :: IO Bool
-checkDatabase = do mpath <- findHoogleBinPath
- case mpath of
- Nothing -> return False
- Just path -> do (exitCode, _, _) <- readProcessWithExitCode path ["fmap"] ""
- return (exitCode == ExitSuccess)
+checkDatabase :: Maybe String -> IO Bool
+checkDatabase p = do mpath <- findHoogleBinPath p
+ case mpath of
+ Nothing -> return False
+ Just path -> do (exitCode, _, _) <- readProcessWithExitCode path ["fmap"] ""
+ return (exitCode == ExitSuccess)
View
6 src/Scion/PersistentHoogle/Util.hs
@@ -16,14 +16,14 @@ import System.Directory (doesFileExist, getAppUserDataDirectory, getHomeDirector
-- Functions for finding Hoogle in the system
-findHoogleBinPath :: IO (Maybe String)
-findHoogleBinPath = do
+findHoogleBinPath :: Maybe String -> IO (Maybe String)
+findHoogleBinPath extraPath = do
p1 <- findHoogleBinInLibrary getHoogleBinPath1
p2 <- findHoogleBinInLibrary getHoogleBinPath2
p3 <- getHoogleBinPathCabalAPI
p4 <- getHoogleBinPathCabalDir
p5 <- getHoogleBinPathMacOsDir
- let placesToSearch = (catMaybes [p1, p2]) ++ [p4, p5] ++ p3
+ let placesToSearch = (catMaybes [extraPath, p1, p2]) ++ [p4, p5] ++ p3
findPathsAndCheck placesToSearch
findPathsAndCheck :: [String] -> IO (Maybe String)
View
56 src/Server/PersistentCommands.hs
@@ -28,6 +28,7 @@ data Command = LoadLocalDatabase FilePath Bool
| HoogleDownloadData
| HoogleCheckDatabase
| GetDeclarationModules String
+ | SetExtraHooglePath String
| Quit
data CurrentDatabase = AllPackages
@@ -36,18 +37,19 @@ data CurrentDatabase = AllPackages
| APackage DbPackageIdentifier
data BrowserState = BrowserState
- { localDb :: Maybe FilePath
- , hackageDb :: Maybe FilePath
- , useLocal :: Bool
- , useHackage :: Bool
- , filterPackage :: Maybe DbPackageIdentifier
+ { localDb :: Maybe FilePath
+ , hackageDb :: Maybe FilePath
+ , useLocal :: Bool
+ , useHackage :: Bool
+ , filterPackage :: Maybe DbPackageIdentifier
+ , extraHooglePath :: Maybe String
}
initialState :: BrowserState
-initialState = BrowserState Nothing Nothing True True Nothing
+initialState = BrowserState Nothing Nothing True True Nothing Nothing
runWithState :: BrowserState -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> IO [a]
-runWithState (BrowserState lDb hDb useL useH filterPkg) action =
+runWithState (BrowserState lDb hDb useL useH filterPkg _) action =
do localThings <- runWithState' useL lDb (action filterPkg)
hackageThings <- runWithState' useH hDb (action filterPkg)
return $ localThings ++ hackageThings
@@ -107,12 +109,17 @@ executeCommand (GetModules mname) = do smods <- runDb (getSubmodules mnam
return (toJSON smods, True)
executeCommand (GetDeclarations mname) = do decls <- runDb (getDeclsInModule mname)
return (toJSON decls, True)
-executeCommand (HoogleQuery query) = do results <- runDb (\_ -> H.query query)
+executeCommand (HoogleQuery query) = do extraH <- fmap extraHooglePath get
+ results <- runDb (\_ -> H.query extraH query)
return (toJSON results, True)
-executeCommand HoogleDownloadData = do _ <- lift $ H.downloadData
+executeCommand HoogleDownloadData = do extraH <- fmap extraHooglePath get
+ _ <- lift $ H.downloadData extraH
return (String "ok", True)
-executeCommand HoogleCheckDatabase = do present <- lift $ H.checkDatabase
+executeCommand HoogleCheckDatabase = do extraH <- fmap extraHooglePath get
+ present <- lift $ H.checkDatabase extraH
return (Bool present, True)
+executeCommand (SetExtraHooglePath p) = do modify (\s -> s { extraHooglePath = Just p })
+ return (String "ok", True)
executeCommand (GetDeclarationModules d) = do mods <- runDb (\_ -> getModulesWhereDeclarationIs d)
return (toJSON mods, True)
executeCommand Quit = return (String "ok", False)
@@ -122,20 +129,21 @@ instance FromJSON Command where
parseJSON (Object v) = case M.lookup (T.pack "command") v of
Just (String e) ->
case T.unpack e of
- "load-local-db" -> LoadLocalDatabase <$> v .: "filepath"
- <*> v .: "rebuild"
- "load-hackage-db" -> LoadHackageDatabase <$> v .: "filepath"
- <*> v .: "rebuild"
- "get-packages" -> pure GetPackages
- "set-current-db" -> SetCurrentDatabase <$> v .: "new-db"
- "get-modules" -> GetModules <$> v .: "module"
- "get-declarations" -> GetDeclarations <$> v .: "module"
- "hoogle-query" -> HoogleQuery <$> v .: "query"
- "hoogle-data" -> pure HoogleDownloadData
- "hoogle-check" -> pure HoogleCheckDatabase
- "get-decl-module" -> GetDeclarationModules <$> v .: "decl"
- "quit" -> pure Quit
- _ -> mzero
+ "load-local-db" -> LoadLocalDatabase <$> v .: "filepath"
+ <*> v .: "rebuild"
+ "load-hackage-db" -> LoadHackageDatabase <$> v .: "filepath"
+ <*> v .: "rebuild"
+ "get-packages" -> pure GetPackages
+ "set-current-db" -> SetCurrentDatabase <$> v .: "new-db"
+ "get-modules" -> GetModules <$> v .: "module"
+ "get-declarations" -> GetDeclarations <$> v .: "module"
+ "hoogle-query" -> HoogleQuery <$> v .: "query"
+ "hoogle-data" -> pure HoogleDownloadData
+ "hoogle-check" -> pure HoogleCheckDatabase
+ "extra-hoogle-path" -> SetExtraHooglePath <$> v .: "path"
+ "get-decl-module" -> GetDeclarationModules <$> v .: "decl"
+ "quit" -> pure Quit
+ _ -> mzero
_ -> mzero
parseJSON _ = mzero

0 comments on commit 05d5060

Please sign in to comment.
Something went wrong with that request. Please try again.