scion-browser 0.2.12 → 0.2.13

raw patch · 7 files changed

+41/−33 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• scion-browser.cabal +1/−1
• src/Scion/PersistentBrowser/Build.hs +4/−3
• src/Scion/PersistentBrowser/DbTypes.hs +3/−0
• src/Scion/PersistentBrowser/Query.hs +21/−20
• src/Scion/PersistentHoogle.hs +2/−1
• src/Scion/PersistentHoogle/Parser.hs +2/−2
• src/Server/PersistentCommands.hs +8/−6

@@ -1,5 +1,5 @@ name:           scion-browser
-version:        0.2.12
+version:        0.2.13
 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3

@@ -32,6 +32,7 @@ import Text.ParserCombinators.Parsec.Pos (newPos)
 import Text.ParserCombinators.ReadP
 import Control.Monad (when)
+import Data.Conduit (runResourceT)
 
 baseDbUrl :: String
 baseDbUrl = "http://haskell.org/hoogle/base.txt"
@@ -65,7 +66,7 @@ 
 saveHackageDatabaseWithTmp :: FilePath -> FilePath -> IO ()
 saveHackageDatabaseWithTmp file tmp = do (db, _) <- createHackageDatabase tmp
-                                         withSqliteConn (T.pack file) (runSqlConn (mapM_ savePackageToDb db))
+                                         runResourceT $ withSqliteConn (T.pack file) (runSqlConn (mapM_ savePackageToDb db))
                                          --mapM_ (\pkg -> withSqliteConn (T.pack file) (runSqlConn (savePackageToDb pkg))) db
 
 -- | Downloads the information for the entire Hackage database
@@ -104,9 +105,9 @@ 
 -- | Updates a database with changes in the installed package base.
 updateDatabase :: FilePath -> [InstalledPackageInfo] -> IO ()
-updateDatabase file pkgInfo = withSqliteConn (T.pack file) $ runSqlConn $ updateDatabase' pkgInfo
+updateDatabase file pkgInfo = runResourceT $ withSqliteConn (T.pack file) $ runSqlConn $ updateDatabase' pkgInfo
 
-updateDatabase' :: [InstalledPackageInfo] -> SqlPersist IO ()
+updateDatabase' :: [InstalledPackageInfo] -> SQL ()
 updateDatabase' pkgInfo = 
   do dbPersistent <- selectList ([] :: [Filter DbPackage]) []
      let dbList        = map (fromDbToPackageIdentifier . entityVal) dbPersistent

@@ -6,6 +6,9 @@ -- import Database.Persist.Base
 import Database.Persist.Sqlite
 import Database.Persist.TH
+import Data.Conduit (ResourceT)
+
+type SQL a= SqlPersist (ResourceT IO) a
 
 data DbDeclType = DbData | DbNewType | DbClass | DbInstance | DbSignature | DbType
     deriving (Show, Read, Eq)

@@ -15,27 +15,27 @@ import Data.Char (toUpper)
 
 -- |Get the identifiers of all packages in the database.
-allPackageIds :: Maybe DbPackageIdentifier -> SqlPersist IO [DbPackageIdentifier]
+allPackageIds :: Maybe DbPackageIdentifier -> SQL [DbPackageIdentifier]
 allPackageIds pkgs = do packages <- allPackages pkgs
                         return $ map dbPackageToIdentifier packages
 
 -- |Get information of all packages in the database.
-allPackages :: Maybe DbPackageIdentifier -> SqlPersist IO [DbPackage]
+allPackages :: Maybe DbPackageIdentifier -> SQL [DbPackage]
 allPackages _ = do packages <- selectList ([] :: [Filter DbPackage]) []
                    return $ map entityVal packages
 
 -- |Get information of all versions of the package with that name.
-packagesByName :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [DbPackage]
+packagesByName :: String -> Maybe DbPackageIdentifier -> SQL [DbPackage]
 packagesByName name _ = do packages <- selectList [ DbPackageName ==. name ] []
                            return $ map entityVal packages
 
 -- |Get information about a package in the database.
-getPackage :: DbPackageIdentifier -> SqlPersist IO (Maybe (DbPackage))
+getPackage :: DbPackageIdentifier -> SQL (Maybe (DbPackage))
 getPackage (DbPackageIdentifier name version) = do package <- selectFirst [ DbPackageName ==. name, DbPackageVersion ==. version ] []
                                                    return $ fmap entityVal package
 
 -- |Get information about all modules with that name.
-modulesByName :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [DbModule]
+modulesByName :: String -> Maybe DbPackageIdentifier -> SQL [DbModule]
 modulesByName name Nothing = do mods <- selectList [ DbModuleName ==. name ] []
                                 return $ map entityVal mods
 modulesByName name (Just (DbPackageIdentifier pkgName pkgVersion)) =
@@ -48,7 +48,7 @@ 
 -- |Get all the modules hierarchically inside the specified one.
 --  For getting the entire list of modules modules, use "" as initial name.
-getSubmodules :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [DbModule]
+getSubmodules :: String -> Maybe DbPackageIdentifier -> SQL [DbModule]
 getSubmodules "" Nothing =
   do let sql = "SELECT name, doc, packageId FROM DbModule"
      queryDb sql [] moduleAction
@@ -74,7 +74,7 @@ moduleAction _ = error "This should not happen"
 
 -- |Get information about all declaration with that name.
-declsByName :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [DbDecl]
+declsByName :: String -> Maybe DbPackageIdentifier -> SQL [DbDecl]
 declsByName name Nothing =
   do let sql = "SELECT DbDecl.declType, DbDecl.name, DbDecl.doc, DbDecl.kind, DbDecl.signature, DbDecl.equals, DbDecl.moduleId"
                ++ " FROM DbDecl, DbModule"
@@ -97,7 +97,7 @@ declAction _ = error "This should not happen"
 
 
-createIndexes :: SqlPersist IO()
+createIndexes :: SQL ()
 createIndexes=do
         -- liftIO $ logToStdout "creating indexes"
         let idxs = [ "create index if not exists module_pkgid_name on DbModule (packageId,name)"
@@ -114,7 +114,7 @@ 
 -- |Gets the declarations inside some module,
 --  along with information about which package it lives.
-getDeclsInModule :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [(DbPackageIdentifier, DbCompleteDecl)]
+getDeclsInModule :: String -> Maybe DbPackageIdentifier -> SQL [(DbPackageIdentifier, DbCompleteDecl)]
 getDeclsInModule modName pkgId =
   do let pkg = case pkgId of
                  Nothing -> ""
@@ -146,7 +146,7 @@ 
 -- | list declarations matching the given prefix, useful for content assist
 -- the prefix either matches the declaration itself or any constructor
-getDeclsFromPrefix :: String -> Maybe DbPackageIdentifier -> SqlPersist IO [(DbPackageIdentifier, DbModule, DbCompleteDecl)]
+getDeclsFromPrefix :: String -> Maybe DbPackageIdentifier -> SQL [(DbPackageIdentifier, DbModule, DbCompleteDecl)]
 getDeclsFromPrefix prefix pkgId =
   do let pkg = case pkgId of
                  Nothing -> ""
@@ -184,7 +184,7 @@                 -- we do case insensitive match here to be consistent with LIKE above
                 return $ filter (\(DbConstructor name _ _)->isPrefixOf (map toUpper prefix) (map toUpper name)) $ map entityVal consts'
 
-getAllDeclInfo :: (DbDeclId, DbDecl) -> SqlPersist IO DbCompleteDecl
+getAllDeclInfo :: (DbDeclId, DbDecl) -> SQL DbCompleteDecl
 getAllDeclInfo (declId, decl) =
   do ctxs' <- selectList [ DbContextDeclId ==. declId] []
      let ctxs = map entityVal ctxs'
@@ -197,12 +197,12 @@      return $ DbCompleteDecl decl ctxs tyvars fundeps consts
 
 -- |Get information about all constructors with that name.
-constructorsByName :: String -> SqlPersist IO [DbConstructor]
+constructorsByName :: String -> SQL [DbConstructor]
 constructorsByName name = do consts <- selectList [ DbConstructorName ==. name ] []
                              return $ map entityVal consts
 
 -- | Gets a list of modules where a declaration may live
-getModulesWhereDeclarationIs :: String -> SqlPersist IO [(DbModule,String)]
+getModulesWhereDeclarationIs :: String -> SQL [(DbModule,String)]
 getModulesWhereDeclarationIs declName =
   do let sqlDecl = "SELECT DbModule.name, DbModule.doc, DbModule.packageId,''"
                    ++ " FROM DbDecl, DbModule"
@@ -219,7 +219,7 @@         action _ = error "This should not happen"
 
 -- |Executes a query.
-queryDb :: String -> [String] -> ([PersistValue] -> a) -> SqlPersist IO [a]
+queryDb :: String -> [String] -> ([PersistValue] -> a) -> SQL [a]
 queryDb sql params action = runResourceT (withStmt (T.pack sql) (map toPersistValue params) $= CL.map action $$ CL.consume)
 
 -- |Gets information from a text value.
@@ -230,31 +230,32 @@ 
 -- |Things that reside on a package.
 class HasDbPackage d where
-  getDbPackage :: d -> SqlPersist IO DbPackage
+  getDbPackage :: d -> SQL DbPackage
 
 instance HasDbPackage DbPackage where
   getDbPackage = return
 
 instance HasDbPackage DbModule where
-  getDbPackage (DbModule _ _ pkgId) = do Just pkg <- get pkgId
+  getDbPackage (DbModule _ _ pkgId) = do pkg <- getJust pkgId
                                          return pkg
 
 instance HasDbPackage DbDecl where
-  getDbPackage (DbDecl _ _ _ _ _ _ modId) = do Just md <- get modId
+  getDbPackage (DbDecl _ _ _ _ _ _ modId) = do md <- getJust modId
                                                getDbPackage md
 
 -- |Things that reside on a module.
 class HasDbModule d where
-  getDbModule :: d -> SqlPersist IO DbModule
+  getDbModule :: d -> SQL DbModule
 
 instance HasDbModule DbModule where
   getDbModule = return
 
 instance HasDbModule DbDecl where
-  getDbModule (DbDecl _ _ _ _ _ _ modId) = do Just md <- get modId
+  getDbModule (DbDecl _ _ _ _ _ _ modId) = do md <- getJust modId
                                               return md
 
 instance HasDbModule DbConstructor where
-  getDbModule (DbConstructor _ _ declId) = do Just dc <- get declId
+  getDbModule (DbConstructor _ _ declId) = do 
+                                              dc <-  getJust declId
                                               getDbModule dc
 

@@ -10,6 +10,7 @@ import Database.Persist.Sqlite
 import Scion.PersistentBrowser ()
 import Scion.PersistentBrowser.Util
+import Scion.PersistentBrowser.DbTypes
 
 import Scion.PersistentHoogle.Types
 import Scion.PersistentHoogle.Instances.Json ()
@@ -19,7 +20,7 @@ import System.Process
 import Text.Parsec.Prim (runP)
 
-query :: Maybe String -> String -> SqlPersist IO [Result]
+query :: Maybe String -> String -> SQL [Result]
 query p q = do mpath <- liftIO $ findHoogleBinPath p
                case mpath of
                  Nothing   -> return []

@@ -24,7 +24,7 @@                 | HalfGadtDecl String (Documented GadtDecl)
                 | HalfKeyword  String
 
-hoogleElements :: BSParser (SqlPersist IO [Result])
+hoogleElements :: BSParser (SQL [Result])
 hoogleElements = do elts <- hoogleElements'
                     let results = catMaybesM $ map convertHalfToResult elts
                     return results
@@ -92,7 +92,7 @@                    spaces0
                    return name
 
-convertHalfToResult :: HalfResult -> SqlPersist IO (Maybe Result)
+convertHalfToResult :: HalfResult -> SQL (Maybe Result)
 convertHalfToResult (HalfKeyword kw) =
   return $ Just (RKeyword kw)
 convertHalfToResult (HalfPackage  pname) = 

@@ -12,11 +12,13 @@ import Database.Persist.Sqlite hiding (get)
 import Scion.PersistentBrowser
 import Scion.PersistentBrowser.Build
+import Scion.PersistentBrowser.DbTypes
 import Scion.PersistentBrowser.Query
 import Scion.PersistentBrowser.Util (logToStdout)
 import qualified Scion.PersistentHoogle as H
 import Scion.Packages
 import System.Directory
+import Data.Conduit (runResourceT)
 
 data Command = LoadLocalDatabase FilePath Bool
              | LoadHackageDatabase FilePath Bool
@@ -58,7 +60,7 @@ filterPackage (APackage pkgId)=Just pkgId
 filterPackage _ = Nothing
 
-runWithState :: BrowserState -> CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> IO [a]
+runWithState :: BrowserState -> CurrentDatabase -> (Maybe DbPackageIdentifier -> SQL [a]) -> IO [a]
 runWithState (BrowserState lDb hDb _) cdb action =
   do 
      let filterPkg=filterPackage cdb
@@ -66,13 +68,13 @@      hackageThings <- runWithState' (useHackage cdb) hDb (action filterPkg)
      return $ localThings ++ hackageThings
 
-runWithState' :: Bool -> Maybe FilePath -> SqlPersist IO [a] -> IO [a]
+runWithState' :: Bool -> Maybe FilePath -> SQL[a] -> IO [ a]
 runWithState' use mpath action = if use && isJust mpath
                                     then do let path = fromJust mpath
-                                            withSqliteConn (T.pack path) $ runSqlConn action
+                                            runResourceT $ withSqliteConn (T.pack path) $ runSqlConn action
                                     else return []
 
-runDb :: CurrentDatabase -> (Maybe DbPackageIdentifier -> SqlPersist IO [a]) -> BrowserM [a]
+runDb :: CurrentDatabase -> (Maybe DbPackageIdentifier -> SQL [a]) -> BrowserM [a]
 runDb cdb action = 
    do 
       st <- get
@@ -85,7 +87,7 @@   do fileExists <- lift $ doesFileExist path
      let fileExists' = fileExists `seq` fileExists
      when rebuild $
-          lift $ do withSqliteConn (T.pack path) $ runSqlConn $ do
+          lift $ do runResourceT $ withSqliteConn (T.pack path) $ runSqlConn $ do
                          runMigration migrateAll
                          createIndexes
                     pkgInfos' <- getPkgInfos
@@ -102,7 +104,7 @@      when (not fileExists' || rebuild) $
           lift $ do when fileExists' (removeFile path)
                     logToStdout "Rebuilding Hackage database"
-                    withSqliteConn (T.pack path) $ runSqlConn $ do
+                    runResourceT $ withSqliteConn (T.pack path) $ runSqlConn $ do
                         runMigration migrateAll
                         createIndexes
                     saveHackageDatabase path