Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

return a status code instead of only a boolean

  • Loading branch information...
commit e98ffa0269f422ab58ffe69c619dd305eb4cdcf7 1 parent 907898f
@JPMoresmau authored
View
5 .gitignore
@@ -0,0 +1,5 @@
+/.settings
+/dist
+/.dist-buildwrapper
+/.project
+/.hsproject
View
474 scion-browser.cabal
@@ -1,237 +1,237 @@
-name: scion-browser
-version: 0.2.8
-cabal-version: >= 1.8
-build-type: Simple
-license: BSD3
-license-file: docs/LICENSE
-author: Alejandro Serrano <trupill@gmail.com>
-maintainer: Alejandro Serrano <trupill@gmail.com>, JP Moresmau (jpmoresmau@gmail.com)
-homepage: http://github.com/JPMoresmau/scion-class-browser
-category: Development
-synopsis: Command-line interface for browsing and searching packages documentation
-description: Scion Browser aims to be a command-line interface for getting information about installed Haskell packages, that could be later used by development environments. It also provides integration with Hoogle. By now, it has been integrated in EclipseFP.
-
-source-repository head
- type: git
- location: https://github.com/JPMoresmau/scion-class-browser
-
-library
- hs-source-dirs: src
- build-depends:
- attoparsec >= 0.10,
- base == 4.*,
- mtl >= 2,
- derive >= 2.5 && < 3,
- text == 0.11.*,
- parsec >= 3 && < 4,
- Cabal >= 0.10,
- haskell-src-exts >= 1.11 && < 2,
- process >= 1 && < 2,
- tar == 0.3.*,
- zlib == 0.5.*,
- HTTP >= 4000 && < 5000,
- deepseq >= 1.1 && < 2,
- aeson >= 0.4,
- parallel-io >= 0.3,
- utf8-string,
- persistent >= 0.7,
- persistent-sqlite >= 0.7,
- persistent-template >= 0.7,
- conduit,
- transformers,
- unordered-containers >= 0.1.3,
- zlib,
- ghc-paths == 0.1.*
-
- if !os(mingw32)
- build-depends:
- unix >= 2 && < 3
-
- if impl(ghc >= 7.0)
- build-depends:
- containers >= 0.2 && < 0.5,
- directory >= 1.1,
- filepath >= 1.2,
- bytestring,
- -- For Scion.Packages (provisional)
- ghc >= 7
- else
- build-depends:
- containers >= 0.2 && < 0.4,
- directory == 1.0.*,
- filepath == 1.1.*,
- bytestring,
- -- For Scion.Packages (provisional)
- ghc >= 6.10 && < 6.13
-
- -- if !os(mingw32)
- -- extra-libraries: tinfo
-
- exposed-modules:
- Scion.PersistentBrowser,
- Scion.PersistentBrowser.Query,
- Scion.PersistentBrowser.Build,
- Scion.PersistentHoogle
-
- ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -fno-warn-orphans
- other-modules:
- Scion.Packages,
- Scion.PersistentBrowser.DbTypes,
- Scion.PersistentBrowser.FileUtil,
- Scion.PersistentBrowser.FromMissingH,
- Scion.PersistentBrowser.Instances.Json,
- Scion.PersistentBrowser.Parser,
- Scion.PersistentBrowser.Parser.Documentable,
- Scion.PersistentBrowser.Parser.Internal,
- Scion.PersistentBrowser.TempFile,
- Scion.PersistentBrowser.ToDb,
- Scion.PersistentBrowser.Types,
- Scion.PersistentBrowser.Util,
- Scion.PersistentHoogle.Instances.Json,
- Scion.PersistentHoogle.Parser,
- Scion.PersistentHoogle.Types,
- Scion.PersistentHoogle.Util
-
-executable scion-browser
- hs-source-dirs: src
- main-is: Main.hs
- build-depends:
- haskeline >= 0.6,
- attoparsec >= 0.10,
- base == 4.*,
- mtl >= 2,
- derive >= 2.5 && < 3,
- text == 0.11.*,
- parsec >= 3 && < 4,
- Cabal >= 0.10,
- haskell-src-exts >= 1.11 && < 2,
- process >= 1 && < 2,
- tar == 0.3.*,
- zlib == 0.5.*,
- HTTP >= 4000 && < 5000,
- deepseq >= 1.1 && < 2,
- aeson >= 0.4,
- parallel-io >= 0.3,
- utf8-string,
- persistent >= 0.7,
- persistent-sqlite >= 0.7,
- persistent-template >= 0.7,
- conduit,
- transformers,
- unordered-containers >= 0.1.3,
- zlib,
- ghc-paths == 0.1.*
-
- if !os(mingw32)
- build-depends:
- unix >= 2 && < 3
-
- if impl(ghc >= 7.0)
- build-depends:
- containers >= 0.2 && < 0.5,
- directory >= 1.1,
- filepath >= 1.2,
- bytestring,
- -- For Scion.Packages (provisional)
- ghc >= 7
- else
- build-depends:
- containers >= 0.2 && < 0.4,
- directory == 1.0.*,
- filepath == 1.1.*,
- bytestring,
- -- For Scion.Packages (provisional)
- ghc >= 6.10 && < 6.13
-
- -- if !os(mingw32)
- -- extra-libraries: tinfo
-
- ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -fno-warn-orphans -threaded
- other-modules:
- Scion.Packages,
- Scion.PersistentBrowser,
- Scion.PersistentBrowser.Build,
- Scion.PersistentBrowser.DbTypes,
- Scion.PersistentBrowser.FileUtil,
- Scion.PersistentBrowser.FromMissingH,
- Scion.PersistentBrowser.Instances.Json,
- Scion.PersistentBrowser.Parser,
- Scion.PersistentBrowser.Parser.Documentable,
- Scion.PersistentBrowser.Parser.Internal,
- Scion.PersistentBrowser.Query,
- Scion.PersistentBrowser.TempFile,
- Scion.PersistentBrowser.ToDb,
- Scion.PersistentBrowser.Types,
- Scion.PersistentBrowser.Util,
- Scion.PersistentHoogle,
- Scion.PersistentHoogle.Instances.Json,
- Scion.PersistentHoogle.Parser,
- Scion.PersistentHoogle.Types,
- Scion.PersistentHoogle.Util,
- Server.PersistentCommands
-
---test-suite BrowserTests
--- main-is: Test.hs
--- type: exitcode-stdio-1.0
--- x-uses-tf: true
--- ghc-options: -Wall -rtsopts
--- hs-source-dirs: src, test
--- other-modules: Scion.Browser.Parser.Documentable, Scion.Browser.Parser.Internal, Scion.Browser.Parser, Scion.Browser.ParserTests, Scion.PersistentHoogle.Util
---
--- build-depends:
--- HUnit >= 1.2 && < 2,
--- QuickCheck >= 2.4,
--- test-framework >= 0.4.1,
--- test-framework-quickcheck2,
--- test-framework-hunit,
--- split,
--- haskeline >= 0.6,
--- -- From library
--- attoparsec >= 0.10,
--- base == 4.*,
--- mtl >= 2,
--- derive >= 2.5 && < 3,
--- text == 0.11.*,
--- parsec >= 3 && < 4,
--- Cabal >= 0.10,
--- haskell-src-exts >= 1.11 && < 2,
--- process >= 1 && < 2,
--- tar == 0.3.*,
--- zlib == 0.5.*,
--- HTTP >= 4000 && < 5000,
--- deepseq >= 1.1 && < 2,
--- aeson >= 0.4,
--- parallel-io >= 0.3,
--- utf8-string ,
--- persistent >= 0.7,
--- persistent-sqlite >= 0.7,
--- persistent-template >= 0.7,
--- conduit,
--- transformers,
--- unordered-containers >= 0.1.3,
--- zlib,
--- -- For Scion.packages (provisional)
--- ghc-paths == 0.1.*
---
--- if !os(mingw32)
--- build-depends:
--- unix >= 2 && < 3
---
--- if impl(ghc >= 7.0)
--- build-depends:
--- containers >= 0.2 && < 0.5,
--- directory == 1.1.*,
--- filepath == 1.2.*,
--- bytestring,
--- -- For Scion.Packages (provisional)
--- ghc >= 7
--- else
--- build-depends:
--- containers >= 0.2 && < 0.4,
--- directory == 1.0.*,
--- filepath == 1.1.*,
--- bytestring,
--- -- For Scion.Packages (provisional)
-
-
-
+name: scion-browser
+version: 0.2.9
+cabal-version: >= 1.8
+build-type: Simple
+license: BSD3
+license-file: docs/LICENSE
+author: Alejandro Serrano <trupill@gmail.com>
+maintainer: Alejandro Serrano <trupill@gmail.com>, JP Moresmau (jpmoresmau@gmail.com)
+homepage: http://github.com/JPMoresmau/scion-class-browser
+category: Development
+synopsis: Command-line interface for browsing and searching packages documentation
+description: Scion Browser aims to be a command-line interface for getting information about installed Haskell packages, that could be later used by development environments. It also provides integration with Hoogle. By now, it has been integrated in EclipseFP.
+
+source-repository head
+ type: git
+ location: https://github.com/JPMoresmau/scion-class-browser
+
+library
+ hs-source-dirs: src
+ build-depends:
+ attoparsec >= 0.10,
+ base == 4.*,
+ mtl >= 2,
+ derive >= 2.5 && < 3,
+ text == 0.11.*,
+ parsec >= 3 && < 4,
+ Cabal >= 0.10,
+ haskell-src-exts >= 1.11 && < 2,
+ process >= 1 && < 2,
+ tar == 0.3.*,
+ zlib == 0.5.*,
+ HTTP >= 4000 && < 5000,
+ deepseq >= 1.1 && < 2,
+ aeson >= 0.4,
+ parallel-io >= 0.3,
+ utf8-string,
+ persistent >= 0.7,
+ persistent-sqlite >= 0.7,
+ persistent-template >= 0.7,
+ conduit,
+ transformers,
+ unordered-containers >= 0.1.3,
+ zlib,
+ ghc-paths == 0.1.*
+
+ if !os(mingw32)
+ build-depends:
+ unix >= 2 && < 3
+
+ if impl(ghc >= 7.0)
+ build-depends:
+ containers >= 0.2 && < 0.5,
+ directory >= 1.1,
+ filepath >= 1.2,
+ bytestring,
+ -- For Scion.Packages (provisional)
+ ghc >= 7
+ else
+ build-depends:
+ containers >= 0.2 && < 0.4,
+ directory == 1.0.*,
+ filepath == 1.1.*,
+ bytestring,
+ -- For Scion.Packages (provisional)
+ ghc >= 6.10 && < 6.13
+
+ -- if !os(mingw32)
+ -- extra-libraries: tinfo
+
+ exposed-modules:
+ Scion.PersistentBrowser,
+ Scion.PersistentBrowser.Query,
+ Scion.PersistentBrowser.Build,
+ Scion.PersistentHoogle
+
+ ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -fno-warn-orphans
+ other-modules:
+ Scion.Packages,
+ Scion.PersistentBrowser.DbTypes,
+ Scion.PersistentBrowser.FileUtil,
+ Scion.PersistentBrowser.FromMissingH,
+ Scion.PersistentBrowser.Instances.Json,
+ Scion.PersistentBrowser.Parser,
+ Scion.PersistentBrowser.Parser.Documentable,
+ Scion.PersistentBrowser.Parser.Internal,
+ Scion.PersistentBrowser.TempFile,
+ Scion.PersistentBrowser.ToDb,
+ Scion.PersistentBrowser.Types,
+ Scion.PersistentBrowser.Util,
+ Scion.PersistentHoogle.Instances.Json,
+ Scion.PersistentHoogle.Parser,
+ Scion.PersistentHoogle.Types,
+ Scion.PersistentHoogle.Util
+
+executable scion-browser
+ hs-source-dirs: src
+ main-is: Main.hs
+ build-depends:
+ haskeline >= 0.6,
+ attoparsec >= 0.10,
+ base == 4.*,
+ mtl >= 2,
+ derive >= 2.5 && < 3,
+ text == 0.11.*,
+ parsec >= 3 && < 4,
+ Cabal >= 0.10,
+ haskell-src-exts >= 1.11 && < 2,
+ process >= 1 && < 2,
+ tar == 0.3.*,
+ zlib == 0.5.*,
+ HTTP >= 4000 && < 5000,
+ deepseq >= 1.1 && < 2,
+ aeson >= 0.4,
+ parallel-io >= 0.3,
+ utf8-string,
+ persistent >= 0.7,
+ persistent-sqlite >= 0.7,
+ persistent-template >= 0.7,
+ conduit,
+ transformers,
+ unordered-containers >= 0.1.3,
+ zlib,
+ ghc-paths == 0.1.*
+
+ if !os(mingw32)
+ build-depends:
+ unix >= 2 && < 3
+
+ if impl(ghc >= 7.0)
+ build-depends:
+ containers >= 0.2 && < 0.5,
+ directory >= 1.1,
+ filepath >= 1.2,
+ bytestring,
+ -- For Scion.Packages (provisional)
+ ghc >= 7
+ else
+ build-depends:
+ containers >= 0.2 && < 0.4,
+ directory == 1.0.*,
+ filepath == 1.1.*,
+ bytestring,
+ -- For Scion.Packages (provisional)
+ ghc >= 6.10 && < 6.13
+
+ -- if !os(mingw32)
+ -- extra-libraries: tinfo
+
+ ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -fno-warn-orphans -threaded
+ other-modules:
+ Scion.Packages,
+ Scion.PersistentBrowser,
+ Scion.PersistentBrowser.Build,
+ Scion.PersistentBrowser.DbTypes,
+ Scion.PersistentBrowser.FileUtil,
+ Scion.PersistentBrowser.FromMissingH,
+ Scion.PersistentBrowser.Instances.Json,
+ Scion.PersistentBrowser.Parser,
+ Scion.PersistentBrowser.Parser.Documentable,
+ Scion.PersistentBrowser.Parser.Internal,
+ Scion.PersistentBrowser.Query,
+ Scion.PersistentBrowser.TempFile,
+ Scion.PersistentBrowser.ToDb,
+ Scion.PersistentBrowser.Types,
+ Scion.PersistentBrowser.Util,
+ Scion.PersistentHoogle,
+ Scion.PersistentHoogle.Instances.Json,
+ Scion.PersistentHoogle.Parser,
+ Scion.PersistentHoogle.Types,
+ Scion.PersistentHoogle.Util,
+ Server.PersistentCommands
+
+--test-suite BrowserTests
+-- main-is: Test.hs
+-- type: exitcode-stdio-1.0
+-- x-uses-tf: true
+-- ghc-options: -Wall -rtsopts
+-- hs-source-dirs: src, test
+-- other-modules: Scion.Browser.Parser.Documentable, Scion.Browser.Parser.Internal, Scion.Browser.Parser, Scion.Browser.ParserTests, Scion.PersistentHoogle.Util
+--
+-- build-depends:
+-- HUnit >= 1.2 && < 2,
+-- QuickCheck >= 2.4,
+-- test-framework >= 0.4.1,
+-- test-framework-quickcheck2,
+-- test-framework-hunit,
+-- split,
+-- haskeline >= 0.6,
+-- -- From library
+-- attoparsec >= 0.10,
+-- base == 4.*,
+-- mtl >= 2,
+-- derive >= 2.5 && < 3,
+-- text == 0.11.*,
+-- parsec >= 3 && < 4,
+-- Cabal >= 0.10,
+-- haskell-src-exts >= 1.11 && < 2,
+-- process >= 1 && < 2,
+-- tar == 0.3.*,
+-- zlib == 0.5.*,
+-- HTTP >= 4000 && < 5000,
+-- deepseq >= 1.1 && < 2,
+-- aeson >= 0.4,
+-- parallel-io >= 0.3,
+-- utf8-string ,
+-- persistent >= 0.7,
+-- persistent-sqlite >= 0.7,
+-- persistent-template >= 0.7,
+-- conduit,
+-- transformers,
+-- unordered-containers >= 0.1.3,
+-- zlib,
+-- -- For Scion.packages (provisional)
+-- ghc-paths == 0.1.*
+--
+-- if !os(mingw32)
+-- build-depends:
+-- unix >= 2 && < 3
+--
+-- if impl(ghc >= 7.0)
+-- build-depends:
+-- containers >= 0.2 && < 0.5,
+-- directory == 1.1.*,
+-- filepath == 1.2.*,
+-- bytestring,
+-- -- For Scion.Packages (provisional)
+-- ghc >= 7
+-- else
+-- build-depends:
+-- containers >= 0.2 && < 0.4,
+-- directory == 1.0.*,
+-- filepath == 1.1.*,
+-- bytestring,
+-- -- For Scion.Packages (provisional)
+
+
+
View
117 src/Scion/PersistentHoogle.hs
@@ -1,57 +1,60 @@
-module Scion.PersistentHoogle
-( query
-, downloadData
-, checkDatabase
-, module Scion.PersistentHoogle.Types
-) where
-
-import Control.Monad
-import Control.Monad.IO.Class (liftIO)
-import Database.Persist.Sqlite
-import Scion.PersistentBrowser ()
-import Scion.PersistentBrowser.Util
-
-import Scion.PersistentHoogle.Types
-import Scion.PersistentHoogle.Instances.Json ()
-import Scion.PersistentHoogle.Parser
-import Scion.PersistentHoogle.Util
-import Scion.PersistentBrowser.Util
-import System.Exit (ExitCode(..))
-import System.Process
-import Text.Parsec.Prim (runP)
-
-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
- liftIO $ logToStdout q
- liftIO $ logToStdout output
- let search = runP hoogleElements () "hoogle-output" (output)
- case search of
- Right result -> do dbResult <- result
- return dbResult
- Left perr -> do
- liftIO $ logToStdout $ show perr -- I like to see the error in the log
- return []
- _ -> do liftIO $ logToStdout err -- I like to see the error in the log
- return []
-
-downloadData :: Maybe String -> IO Bool
-downloadData p = do mpath <- findHoogleBinPath p
- case mpath of
- Nothing -> return False
- Just path -> do logToStdout "Downloading hoogle data..."
- (ec, _, err) <- readProcessWithExitCode path ["data"] ""
- when (ec/= ExitSuccess) (putStrLn err)
- return (ec == 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)
-
+module Scion.PersistentHoogle
+( query
+, downloadData
+, checkDatabase
+, module Scion.PersistentHoogle.Types
+) where
+
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Database.Persist.Sqlite
+import Scion.PersistentBrowser ()
+import Scion.PersistentBrowser.Util
+
+import Scion.PersistentHoogle.Types
+import Scion.PersistentHoogle.Instances.Json ()
+import Scion.PersistentHoogle.Parser
+import Scion.PersistentHoogle.Util
+import System.Exit (ExitCode(..))
+import System.Process
+import Text.Parsec.Prim (runP)
+
+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
+ liftIO $ logToStdout q
+ liftIO $ logToStdout output
+ let search = runP hoogleElements () "hoogle-output" (output)
+ case search of
+ Right result -> do dbResult <- result
+ return dbResult
+ Left perr -> do
+ liftIO $ logToStdout $ show perr -- I like to see the error in the log
+ return []
+ _ -> do liftIO $ logToStdout err -- I like to see the error in the log
+ return []
+
+downloadData :: Maybe String -> IO HoogleStatus
+downloadData p = do mpath <- findHoogleBinPath p
+ case mpath of
+ Nothing -> return Missing
+ Just path -> do logToStdout "Downloading hoogle data..."
+ (ec, _, err) <- readProcessWithExitCode path ["data"] ""
+ when (ec/= ExitSuccess) (putStrLn err)
+ return $ case ec of
+ ExitSuccess->OK
+ _-> Error
+
+checkDatabase :: Maybe String -> IO HoogleStatus
+checkDatabase p = do mpath <- findHoogleBinPath p
+ case mpath of
+ Nothing -> return Missing
+ Just path -> do (ec, _, _) <- readProcessWithExitCode path ["fmap"] ""
+ return $ case ec of
+ ExitSuccess->OK
+ _-> Error
+
View
31 src/Scion/PersistentHoogle/Types.hs
@@ -1,14 +1,17 @@
-module Scion.PersistentHoogle.Types where
-
-import Scion.PersistentBrowser.DbTypes
-
-type Results = [Result]
-
-data Result = RPackage [DbPackage]
- | RModule [(DbPackageIdentifier, DbModule)]
- | RDeclaration [(DbPackageIdentifier, String, DbCompleteDecl)]
- | RConstructor [(DbPackageIdentifier, String, DbCompleteDecl, DbConstructor)]
- | RKeyword String
-
-data Query = Query String
-
+module Scion.PersistentHoogle.Types where
+
+import Scion.PersistentBrowser.DbTypes
+
+type Results = [Result]
+
+data Result = RPackage [DbPackage]
+ | RModule [(DbPackageIdentifier, DbModule)]
+ | RDeclaration [(DbPackageIdentifier, String, DbCompleteDecl)]
+ | RConstructor [(DbPackageIdentifier, String, DbCompleteDecl, DbConstructor)]
+ | RKeyword String
+
+data Query = Query String
+
+-- | status of hoogle operation
+data HoogleStatus = Missing | OK | Error
+ deriving (Show,Read,Eq,Ord,Enum,Bounded)
View
352 src/Server/PersistentCommands.hs
@@ -1,176 +1,176 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Server.PersistentCommands where
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.State
-import Data.Aeson
-import qualified Data.HashMap.Lazy as M
-import Data.Maybe (isJust, fromJust)
-import qualified Data.Text as T
-import Database.Persist.Sqlite hiding (get)
-import Scion.PersistentBrowser
-import Scion.PersistentBrowser.Build
-import Scion.PersistentBrowser.Query
-import Scion.PersistentBrowser.Util (logToStdout)
-import qualified Scion.PersistentHoogle as H
-import Scion.Packages
-import System.Directory
-
-data Command = LoadLocalDatabase FilePath Bool
- | LoadHackageDatabase FilePath Bool
- | GetPackages CurrentDatabase
- | GetModules CurrentDatabase String
- | GetDeclarations CurrentDatabase String
- | HoogleQuery CurrentDatabase String
- | HoogleDownloadData
- | HoogleCheckDatabase
- | GetDeclarationModules CurrentDatabase String
- | SetExtraHooglePath String
- | GetDeclarationsFromPrefix CurrentDatabase String
- | Quit
-
-data CurrentDatabase = AllPackages
- | HackageDatabase
- | LocalDatabase
- | APackage DbPackageIdentifier
-
-data BrowserState = BrowserState
- { localDb :: Maybe FilePath
- , hackageDb :: Maybe FilePath
- , extraHooglePath :: Maybe String
- }
-
-
-initialState :: BrowserState
-initialState = BrowserState Nothing Nothing Nothing --True True Nothing
-
-useLocal :: CurrentDatabase -> Bool
-useLocal HackageDatabase=False
-useLocal _=True
-
-useHackage :: CurrentDatabase -> Bool
-useHackage LocalDatabase=False
-useHackage _=True
-
-filterPackage :: CurrentDatabase -> Maybe DbPackageIdentifier
-filterPackage (APackage pkgId)=Just pkgId
-filterPackage _ = Nothing
-
-runWithState :: BrowserState -> CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> IO [a]
-runWithState (BrowserState lDb hDb _) cdb action =
- do
- let filterPkg=filterPackage cdb
- localThings <- runWithState' (useLocal cdb) lDb (action filterPkg)
- hackageThings <- runWithState' (useHackage cdb) hDb (action filterPkg)
- return $ localThings ++ hackageThings
-
-runWithState' :: Bool -> Maybe FilePath -> SqlPersist IO [a] -> IO [a]
-runWithState' use mpath action = if use && isJust mpath
- then do let path = fromJust mpath
- withSqliteConn (T.pack path) $ runSqlConn action
- else return []
-
-runDb :: CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> BrowserM [a]
-runDb cdb action =
- do
- st <- get
- lift $ runWithState st cdb action
-
-type BrowserM = StateT BrowserState IO
-
-executeCommand :: Command -> BrowserM (Value, Bool) -- Bool indicates if continue receiving commands
-executeCommand (LoadLocalDatabase path rebuild) =
- do fileExists <- lift $ doesFileExist path
- let fileExists' = fileExists `seq` fileExists
- when rebuild $
- lift $ do withSqliteConn (T.pack path) $ runSqlConn $ do
- runMigration migrateAll
- createIndexes
- pkgInfos' <- getPkgInfos
- let pkgInfos = concat $ map snd pkgInfos'
- updateDatabase path pkgInfos
- if fileExists' || rebuild -- If the file already existed or was rebuilt
- then do modify (\s -> s { localDb = Just path })
- lift $ logToStdout "Local database loaded"
- else modify (\s -> s { localDb = Nothing })
- return (String "ok", True)
-executeCommand (LoadHackageDatabase path rebuild) =
- do fileExists <- lift $ doesFileExist path
- let fileExists' = fileExists `seq` fileExists
- when (not fileExists' || rebuild) $
- lift $ do when fileExists' (removeFile path)
- logToStdout "Rebuilding Hackage database"
- withSqliteConn (T.pack path) $ runSqlConn $ do
- runMigration migrateAll
- createIndexes
- saveHackageDatabase path
- if fileExists' || rebuild -- If the file already existed or was rebuilt
- then do modify (\s -> s { hackageDb = Just path })
- lift $ logToStdout "Hackage database loaded"
- else modify (\s -> s { hackageDb = Nothing })
- return (String "ok", True)
-executeCommand (GetPackages cdb) = do pkgs <- runDb cdb allPackages
- return (toJSON pkgs, True)
-executeCommand (GetModules cdb mname) =
- do smods <- runDb cdb (getSubmodules mname)
- return (toJSON smods, True)
-executeCommand (GetDeclarations cdb mname) =
- do decls <- runDb cdb (getDeclsInModule mname)
- return (toJSON decls, True)
-executeCommand (GetDeclarationsFromPrefix cdb prefix) =
- do decls <- runDb cdb (getDeclsFromPrefix prefix)
- return (toJSON decls, True)
-executeCommand (HoogleQuery cdb query) =
- do extraH <- fmap extraHooglePath get
- results <- runDb cdb (\_ -> H.query extraH query)
- return (toJSON results, True)
-executeCommand HoogleDownloadData = do extraH <- fmap extraHooglePath get
- _ <- lift $ H.downloadData extraH
- return (String "ok", True)
-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 cdb d) =
- do mods <- runDb cdb (\_ -> getModulesWhereDeclarationIs d)
- return (toJSON mods, True)
-executeCommand Quit = return (String "ok", False)
-
-
-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" -> GetPackages <$> v .: "db"
- "get-modules" -> GetModules <$> v .: "db"
- <*> v .: "module"
- "get-declarations" -> GetDeclarations <$>v .: "db"
- <*> v .: "module"
- "get-decl-prefix" -> GetDeclarationsFromPrefix <$>v .: "db"
- <*> v .: "prefix"
- "hoogle-query" -> HoogleQuery <$> v .: "db"
- <*> v .: "query"
- "hoogle-data" -> pure HoogleDownloadData
- "hoogle-check" -> pure HoogleCheckDatabase
- "extra-hoogle-path" -> SetExtraHooglePath <$> v .: "path"
- "get-decl-module" -> GetDeclarationModules <$> v .: "db"
- <*> v .: "decl"
- "quit" -> pure Quit
- _ -> mzero
- _ -> mzero
- parseJSON _ = mzero
-
-instance FromJSON CurrentDatabase where
- parseJSON (String new) = case T.unpack new of
- "_all" -> pure AllPackages
- "_hackage" -> pure HackageDatabase
- "_local" -> pure LocalDatabase
- _ -> mzero
- parseJSON other = APackage <$> parseJSON other
+{-# LANGUAGE OverloadedStrings #-}
+
+module Server.PersistentCommands where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+import Data.Aeson
+import qualified Data.HashMap.Lazy as M
+import Data.Maybe (isJust, fromJust)
+import qualified Data.Text as T
+import Database.Persist.Sqlite hiding (get)
+import Scion.PersistentBrowser
+import Scion.PersistentBrowser.Build
+import Scion.PersistentBrowser.Query
+import Scion.PersistentBrowser.Util (logToStdout)
+import qualified Scion.PersistentHoogle as H
+import Scion.Packages
+import System.Directory
+
+data Command = LoadLocalDatabase FilePath Bool
+ | LoadHackageDatabase FilePath Bool
+ | GetPackages CurrentDatabase
+ | GetModules CurrentDatabase String
+ | GetDeclarations CurrentDatabase String
+ | HoogleQuery CurrentDatabase String
+ | HoogleDownloadData
+ | HoogleCheckDatabase
+ | GetDeclarationModules CurrentDatabase String
+ | SetExtraHooglePath String
+ | GetDeclarationsFromPrefix CurrentDatabase String
+ | Quit
+
+data CurrentDatabase = AllPackages
+ | HackageDatabase
+ | LocalDatabase
+ | APackage DbPackageIdentifier
+
+data BrowserState = BrowserState
+ { localDb :: Maybe FilePath
+ , hackageDb :: Maybe FilePath
+ , extraHooglePath :: Maybe String
+ }
+
+
+initialState :: BrowserState
+initialState = BrowserState Nothing Nothing Nothing --True True Nothing
+
+useLocal :: CurrentDatabase -> Bool
+useLocal HackageDatabase=False
+useLocal _=True
+
+useHackage :: CurrentDatabase -> Bool
+useHackage LocalDatabase=False
+useHackage _=True
+
+filterPackage :: CurrentDatabase -> Maybe DbPackageIdentifier
+filterPackage (APackage pkgId)=Just pkgId
+filterPackage _ = Nothing
+
+runWithState :: BrowserState -> CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> IO [a]
+runWithState (BrowserState lDb hDb _) cdb action =
+ do
+ let filterPkg=filterPackage cdb
+ localThings <- runWithState' (useLocal cdb) lDb (action filterPkg)
+ hackageThings <- runWithState' (useHackage cdb) hDb (action filterPkg)
+ return $ localThings ++ hackageThings
+
+runWithState' :: Bool -> Maybe FilePath -> SqlPersist IO [a] -> IO [a]
+runWithState' use mpath action = if use && isJust mpath
+ then do let path = fromJust mpath
+ withSqliteConn (T.pack path) $ runSqlConn action
+ else return []
+
+runDb :: CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> BrowserM [a]
+runDb cdb action =
+ do
+ st <- get
+ lift $ runWithState st cdb action
+
+type BrowserM = StateT BrowserState IO
+
+executeCommand :: Command -> BrowserM (Value, Bool) -- Bool indicates if continue receiving commands
+executeCommand (LoadLocalDatabase path rebuild) =
+ do fileExists <- lift $ doesFileExist path
+ let fileExists' = fileExists `seq` fileExists
+ when rebuild $
+ lift $ do withSqliteConn (T.pack path) $ runSqlConn $ do
+ runMigration migrateAll
+ createIndexes
+ pkgInfos' <- getPkgInfos
+ let pkgInfos = concat $ map snd pkgInfos'
+ updateDatabase path pkgInfos
+ if fileExists' || rebuild -- If the file already existed or was rebuilt
+ then do modify (\s -> s { localDb = Just path })
+ lift $ logToStdout "Local database loaded"
+ else modify (\s -> s { localDb = Nothing })
+ return (String "ok", True)
+executeCommand (LoadHackageDatabase path rebuild) =
+ do fileExists <- lift $ doesFileExist path
+ let fileExists' = fileExists `seq` fileExists
+ when (not fileExists' || rebuild) $
+ lift $ do when fileExists' (removeFile path)
+ logToStdout "Rebuilding Hackage database"
+ withSqliteConn (T.pack path) $ runSqlConn $ do
+ runMigration migrateAll
+ createIndexes
+ saveHackageDatabase path
+ if fileExists' || rebuild -- If the file already existed or was rebuilt
+ then do modify (\s -> s { hackageDb = Just path })
+ lift $ logToStdout "Hackage database loaded"
+ else modify (\s -> s { hackageDb = Nothing })
+ return (String "ok", True)
+executeCommand (GetPackages cdb) = do pkgs <- runDb cdb allPackages
+ return (toJSON pkgs, True)
+executeCommand (GetModules cdb mname) =
+ do smods <- runDb cdb (getSubmodules mname)
+ return (toJSON smods, True)
+executeCommand (GetDeclarations cdb mname) =
+ do decls <- runDb cdb (getDeclsInModule mname)
+ return (toJSON decls, True)
+executeCommand (GetDeclarationsFromPrefix cdb prefix) =
+ do decls <- runDb cdb (getDeclsFromPrefix prefix)
+ return (toJSON decls, True)
+executeCommand (HoogleQuery cdb query) =
+ do extraH <- fmap extraHooglePath get
+ results <- runDb cdb (\_ -> H.query extraH query)
+ return (toJSON results, True)
+executeCommand HoogleDownloadData = do extraH <- fmap extraHooglePath get
+ ret <- lift $ H.downloadData extraH
+ return (String $ T.pack $ show ret, True)
+executeCommand HoogleCheckDatabase = do extraH <- fmap extraHooglePath get
+ ret <- lift $ H.checkDatabase extraH
+ return (String $ T.pack $ show ret, True)
+executeCommand (SetExtraHooglePath p) = do modify (\s -> s { extraHooglePath = Just p })
+ return (String "ok", True)
+executeCommand (GetDeclarationModules cdb d) =
+ do mods <- runDb cdb (\_ -> getModulesWhereDeclarationIs d)
+ return (toJSON mods, True)
+executeCommand Quit = return (String "ok", False)
+
+
+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" -> GetPackages <$> v .: "db"
+ "get-modules" -> GetModules <$> v .: "db"
+ <*> v .: "module"
+ "get-declarations" -> GetDeclarations <$>v .: "db"
+ <*> v .: "module"
+ "get-decl-prefix" -> GetDeclarationsFromPrefix <$>v .: "db"
+ <*> v .: "prefix"
+ "hoogle-query" -> HoogleQuery <$> v .: "db"
+ <*> v .: "query"
+ "hoogle-data" -> pure HoogleDownloadData
+ "hoogle-check" -> pure HoogleCheckDatabase
+ "extra-hoogle-path" -> SetExtraHooglePath <$> v .: "path"
+ "get-decl-module" -> GetDeclarationModules <$> v .: "db"
+ <*> v .: "decl"
+ "quit" -> pure Quit
+ _ -> mzero
+ _ -> mzero
+ parseJSON _ = mzero
+
+instance FromJSON CurrentDatabase where
+ parseJSON (String new) = case T.unpack new of
+ "_all" -> pure AllPackages
+ "_hackage" -> pure HackageDatabase
+ "_local" -> pure LocalDatabase
+ _ -> mzero
+ parseJSON other = APackage <$> parseJSON other
Please sign in to comment.
Something went wrong with that request. Please try again.