packages feed

scion-browser 0.2.18 → 0.2.19

raw patch · 6 files changed

+35/−34 lines, 6 files

Files

scion-browser.cabal view
@@ -1,5 +1,5 @@ name:           scion-browser
-version:        0.2.18+version:        0.2.19 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3
src/Scion/PersistentBrowser/Build.hs view
@@ -31,15 +31,14 @@ import Text.ParserCombinators.Parsec.Error (newErrorMessage, Message(..))
 import Text.ParserCombinators.Parsec.Pos (newPos)
 import Text.ParserCombinators.ReadP
-import Control.Monad (when)
+import Control.Monad (unless)
 import Data.Conduit (runResourceT)
-import Control.Monad.Logger (runNoLoggingT) --runStderrLoggingT,
 
-baseDbUrl :: String
-baseDbUrl = "http://haskell.org/hoogle/base.txt"
-
-ghcDbUrl :: String
-ghcDbUrl = "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/ghc.txt"
+--baseDbUrl :: String
+--baseDbUrl = "http://haskell.org/hoogle/base.txt"
+--
+--ghcDbUrl :: String
+--ghcDbUrl = "http://www.haskell.org/ghc/docs/latest/html/libraries/ghc/ghc.txt"
 
 hoogleDbUrl :: String
 hoogleDbUrl = "http://hackage.haskell.org/packages/archive/00-hoogle.tar.gz"
@@ -52,7 +51,7 @@ -- | Gets the version of GHC used
 getGhcInstalledVersion :: [PackageIdentifier] -> Version
 getGhcInstalledVersion []     = error "No GHC found"
-getGhcInstalledVersion ((PackageIdentifier (PackageName "ghc") version):_) = version
+getGhcInstalledVersion (PackageIdentifier (PackageName "ghc") version : _) = version
 getGhcInstalledVersion (_:xs) = getGhcInstalledVersion xs
 
 -- | Gets the url of a package from GHC libraries
@@ -67,7 +66,7 @@ 
 saveHackageDatabaseWithTmp :: FilePath -> FilePath -> IO ()
 saveHackageDatabaseWithTmp file tmp = do (db, _) <- createHackageDatabase tmp
-                                         runResourceT $ runNoLoggingT $ withSqliteConn (T.pack file) (runSqlConn (mapM_ savePackageToDb db))
+                                         runResourceT $ runLogging $ 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
@@ -106,7 +105,7 @@ 
 -- | Updates a database with changes in the installed package base.
 updateDatabase :: FilePath -> [InstalledPackageInfo] -> IO ()
-updateDatabase file pkgInfo = runResourceT $ runNoLoggingT $ withSqliteConn (T.pack file) $ runSqlConn $ updateDatabase' pkgInfo
+updateDatabase file pkgInfo = runResourceT $ runLogging $ withSqliteConn (T.pack file) $ runSqlConn $ updateDatabase' pkgInfo
 -- runStderrLoggingT $
 
 updateDatabase' :: [InstalledPackageInfo] -> SQL ()
@@ -116,16 +115,15 @@          installedList = nub $ removeSmallVersions $ map sourcePackageId pkgInfo
          toRemove      = dbList \\ installedList
          toAdd         = installedList \\ dbList
-     when (not $ null toRemove) (do
+     unless (null toRemove) (
         liftIO $ logToStdout $ "Removing " ++ show (map (\(PackageIdentifier (PackageName name) _) -> name) toRemove))
      mapM_ deletePackageByInfo toRemove
-     when (not $ null toAdd) (do
+     unless (null toAdd) (
         liftIO $ logToStdout $ "Adding " ++ show (map (\(PackageIdentifier (PackageName name) _) -> name) toAdd))
      let ghcVersion = getGhcInstalledVersion installedList
      (addedDb, errors) <- liftIO $ createCabalDatabase' ghcVersion toAdd True
      mapM_ savePackageToDb addedDb
-     when (not $ null errors) (do
-        liftIO $ logToStdout $ show errors)
+     unless (null errors) (liftIO $ logToStdout $ show errors)
 
 fromDbToPackageIdentifier :: DbPackage -> PackageIdentifier
 fromDbToPackageIdentifier (DbPackage name version _) = PackageIdentifier (PackageName name)
src/Scion/PersistentBrowser/DbTypes.hs view
@@ -7,9 +7,15 @@ import Database.Persist.Sqlite
 import Database.Persist.TH
 import Data.Conduit (ResourceT)
-import Control.Monad.Logger (NoLoggingT(..)) -- LoggingT(..),
+import Control.Monad.Logger (LoggingT(..)) -- ,runStderrLoggingT
+import Control.Monad.IO.Class (MonadIO) 
-type SQL a= SqlPersistT (NoLoggingT (ResourceT IO)) a
+type SQL a= SqlPersistT (LoggingT (ResourceT IO)) a
+
+-- | wrapper around logging methods, so we can enable logging when we debug
+runLogging :: MonadIO m => LoggingT m a -> m a
+runLogging (LoggingT f) = f $ \_ _ _ _ -> return ()
+        -- runStderrLoggingT
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
 DbPackage
src/Scion/PersistentBrowser/Query.hs view
@@ -201,20 +201,20 @@                              return $ map entityVal consts
 
 -- | Gets a list of modules where a declaration may live
-getModulesWhereDeclarationIs :: String -> SQL [(DbModule,String)]
+getModulesWhereDeclarationIs :: String -> SQL [(DbModule,String,String)]
 getModulesWhereDeclarationIs declName =
-  do let sqlDecl = "SELECT DbModule.name, DbModule.doc, DbModule.packageId,''"
-                   ++ " FROM DbDecl, DbModule"
-                   ++ " WHERE DbDecl.moduleId = DbModule.id AND DbDecl.name = ?"
-         sqlCons = "SELECT DbModule.name, DbModule.doc, DbModule.packageId,DbDecl.name"
-                   ++ " FROM DbConstructor, DbDecl, DbModule"
+  do let sqlDecl = "SELECT DbModule.name, DbModule.doc, DbModule.packageId,'',DbPackage.name"
+                   ++ " FROM DbDecl, DbModule, DbPackage"
+                   ++ " WHERE DbDecl.moduleId = DbModule.id AND DbDecl.name = ? AND DbPackage.id=DbModule.packageId" 
+         sqlCons = "SELECT DbModule.name, DbModule.doc, DbModule.packageId,DbDecl.name,DbPackage.name"
+                   ++ " FROM DbConstructor, DbDecl, DbModule, DbPackage"
                    ++ " WHERE DbConstructor.declId = DbDecl.id AND DbDecl.moduleId = DbModule.id"
-                   ++ " AND DbConstructor.name = ?"
+                   ++ " AND DbConstructor.name = ? AND DbPackage.id=DbModule.packageId"
      decls <- queryDb sqlDecl [declName] action
      cons <- queryDb sqlCons [declName] action
      return (decls ++ cons)
-  where action :: [PersistValue] -> (DbModule,String)
-        action [PersistText name, doc, pkgId@(PersistInt64 _),PersistText decl] = (DbModule (T.unpack name) (fromDbText doc) (Key pkgId),T.unpack decl)
+  where action :: [PersistValue] -> (DbModule,String,String)
+        action [PersistText name, doc, pkgId@(PersistInt64 _),PersistText decl,PersistText pkgName] = (DbModule (T.unpack name) (fromDbText doc) (Key pkgId),T.unpack decl,T.unpack pkgName)
         action _ = error "This should not happen"
 
 -- |Executes a query.
src/Scion/PersistentHoogle.hs view
@@ -7,7 +7,6 @@ 
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
-import Database.Persist.Sqlite
 import Scion.PersistentBrowser ()
 import Scion.PersistentBrowser.Util
 import Scion.PersistentBrowser.DbTypes
@@ -29,10 +28,9 @@                                    ExitSuccess -> do 
                                                      liftIO $ logToStdout q
                                                      liftIO $ logToStdout output
-                                                     let search = runP hoogleElements () "hoogle-output" (output)
+                                                     let search = runP hoogleElements () "hoogle-output" output
                                                      case search of
-                                                       Right result -> do dbResult <- result
-                                                                          return dbResult
+                                                       Right result -> result
                                                        Left  perr      -> do
                                                         liftIO $ logToStdout $ show perr -- I like to see the error in the log
                                                         return []
src/Server/PersistentCommands.hs view
@@ -19,7 +19,6 @@ import Scion.Packages
 import System.Directory
 import Data.Conduit (runResourceT)
-import Control.Monad.Logger (runNoLoggingT) --runStderrLoggingT, 
 import Data.List (nub) import Data.Vector (fromList) @@ -75,7 +74,7 @@ runWithState' :: Bool -> Maybe FilePath -> SQL[a] -> IO [ a]
 runWithState' use mpath action = if use && isJust mpath
                                     then do let path = fromJust mpath
-                                            runResourceT $ runNoLoggingT $ withSqliteConn (T.pack path) $ runSqlConn action
+                                            runResourceT $ runLogging $ withSqliteConn (T.pack path) $ runSqlConn action
                                     else return []
 
 runDb :: CurrentDatabase -> (Maybe DbPackageIdentifier -> SQL [a]) -> BrowserM [a]
@@ -91,7 +90,7 @@   do fileExists <- lift $ doesFileExist path
      let fileExists' = fileExists `seq` fileExists
      when rebuild $
-          lift $ do runResourceT $ runNoLoggingT $ withSqliteConn (T.pack path) $ runSqlConn $ do
+          lift $ do runResourceT $ runLogging $ withSqliteConn (T.pack path) $ runSqlConn $ do
                          runMigration migrateAll
                          createIndexes
                     pkgInfos' <- getPkgInfos
@@ -108,7 +107,7 @@      when (not fileExists' || rebuild) $
           lift $ do when fileExists' (removeFile path)
                     logToStdout "Rebuilding Hackage database"
-                    runResourceT $ runNoLoggingT $ withSqliteConn (T.pack path) $ runSqlConn $ do
+                    runResourceT $ runLogging $ withSqliteConn (T.pack path) $ runSqlConn $ do
                         runMigration migrateAll
                         createIndexes
                     saveHackageDatabase path