scion-browser 0.2.16 → 0.2.17

raw patch · 4 files changed

+44/−38 lines, 4 filesdep +vector

Dependencies added: vector

Files

• scion-browser.cabal +29/−28
• src/Scion/PersistentBrowser/Query.hs +4/−4
• src/Scion/PersistentBrowser/ToDb.hs +1/−1
• src/Server/PersistentCommands.hs +10/−5

@@ -1,5 +1,5 @@ name:           scion-browser
-version:        0.2.16
+version:        0.2.17 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3
@@ -96,33 +96,34 @@ executable scion-browser
   hs-source-dirs:  src
   main-is:         Main.hs
-  build-depends:
-    haskeline >= 0.7,
-    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 && < 0.5,
-    zlib == 0.5.*,
-    HTTP >= 4000 && < 5000,
-    deepseq >= 1.1 && < 2,
-    aeson >= 0.4,
-    parallel-io >= 0.3,
-    utf8-string,
-    persistent >= 1.2,
-    persistent-sqlite >= 1.2,
-    persistent-template >= 1.2,
-    conduit>=1.0,
-    transformers,
-    unordered-containers >= 0.1.3,
-    zlib,
-    ghc-paths == 0.1.*,
-    monad-logger >= 0.3
+  build-depends:+    haskeline >= 0.7,+    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 && < 0.5,+    zlib == 0.5.*,+    HTTP >= 4000 && < 5000,+    deepseq >= 1.1 && < 2,+    aeson >= 0.4,+    parallel-io >= 0.3,+    utf8-string,+    persistent >= 1.2,+    persistent-sqlite >= 1.2,+    persistent-template >= 1.2,+    conduit>=1.0,+    transformers,+    unordered-containers >= 0.1.3,+    zlib,+    ghc-paths == 0.1.*,+    monad-logger >= 0.3,+    vector   
   if !os(mingw32)
     build-depends:

@@ -48,19 +48,19 @@ --  For getting the entire list of modules modules, use "" as initial name.
 getSubmodules :: String -> Maybe DbPackageIdentifier -> SQL [DbModule]
 getSubmodules "" Nothing =
-  do let sql = "SELECT name, doc, packageId FROM DbModule"
+  do let sql = "SELECT DISTINCT name, doc, packageId FROM DbModule"
      queryDb sql [] moduleAction
 getSubmodules "" (Just (DbPackageIdentifier pkgName pkgVersion)) =
-  do let sql = "SELECT DbModule.name, DbModule.doc, DbModule.packageId FROM DbModule, DbPackage"
+  do let sql = "SELECT DISTINCT DbModule.name, DbModule.doc, DbModule.packageId FROM DbModule, DbPackage"
                ++ " WHERE DbModule.packageId = DbPackage.id "
                ++ " AND DbPackage.name = ?"
                ++ " AND DbPackage.version = ?"
      queryDb sql [pkgName, pkgVersion] moduleAction
 getSubmodules modName Nothing =
-  do let sql = "SELECT name, doc, packageId FROM DbModule WHERE name LIKE ?"
+  do let sql = "SELECT DISTINCT name, doc, packageId FROM DbModule WHERE name LIKE ?"
      queryDb sql [modName ++ ".%"] moduleAction
 getSubmodules modName (Just (DbPackageIdentifier pkgName pkgVersion)) =
-  do let sql = "SELECT DbModule.name, DbModule.doc, DbModule.packageId FROM DbModule, DbPackage"
+  do let sql = "SELECT DISTINCT DbModule.name, DbModule.doc, DbModule.packageId FROM DbModule, DbPackage"
                ++ " WHERE name LIKE ?"
                ++ " AND DbModule.packageId = DbPackage.id "
                ++ " AND DbPackage.name = ?"

@@ -20,7 +20,7 @@      mapM_ (saveModuleToDb pkgId) (M.elems modules)    -- saveModuleToDb :: PersistBackend backend m => DbPackageId -> Documented Module -> backend m ()-saveModuleToDb pkgId (Module doc (Just (ModuleHead _ (ModuleName _ name) _ _)) _ _ decls) =+saveModuleToDb pkgId (Module doc (Just (ModuleHead _ (ModuleName _ name)_ _)) _ _ decls) =   do moduleId <- insert $ DbModule name (docToString doc) pkgId      mapM_ (saveDeclToDb moduleId) decls saveModuleToDb _ _ = error "This should never happen"

@@ -20,6 +20,9 @@ import System.Directory
 import Data.Conduit (runResourceT)
 import Control.Monad.Logger (runNoLoggingT) --runStderrLoggingT, 
+import Data.List (nub)+import Data.Vector (fromList)+ 
 data Command = LoadLocalDatabase FilePath Bool
              | LoadHackageDatabase FilePath Bool
@@ -115,20 +118,20 @@         else modify (\s -> s { hackageDb = Nothing })
      return (String "ok", True)   
 executeCommand (GetPackages cdb)         = do pkgs <- runDb cdb allPackages
-                                              return (toJSON pkgs, True)
+                                              return (nubJSON pkgs, True)
 executeCommand (GetModules cdb mname)  = 
                                            do smods <- runDb cdb (getSubmodules mname)
-                                              return (toJSON smods, True)
+                                              return (nubJSON smods, True)
 executeCommand (GetDeclarations cdb mname) = 
                                            do decls <- runDb cdb (getDeclsInModule mname)
-                                              return (toJSON decls, True)
+                                              return (nubJSON decls, True)
 executeCommand (GetDeclarationsFromPrefix cdb prefix) = 
                                            do decls <- runDb cdb (getDeclsFromPrefix prefix)
-                                              return (toJSON decls, True)
+                                              return (nubJSON decls, True)
 executeCommand (HoogleQuery cdb query)       = 
                                            do extraH <- fmap extraHooglePath get
                                               results <- runDb cdb (\_ -> H.query extraH query)
-                                              return (toJSON results, True)
+                                              return (nubJSON results, True)
 executeCommand HoogleDownloadData        = do extraH <- fmap extraHooglePath get
                                               ret <- lift $ H.downloadData extraH
                                               return (String $ T.pack $ show ret, True)
@@ -142,6 +145,8 @@                                               return (toJSON mods, True)
 executeCommand Quit                      = return (String "ok", False)
 
+nubJSON :: (ToJSON a)=> [a] -> Value
+nubJSON = Array . fromList . nub . map toJSON 
 
 instance FromJSON Command where
   parseJSON (Object v) = case M.lookup (T.pack "command") v of