CabalSearch 0.0.1 → 0.0.2

raw patch · 2 files changed

+70/−1 lines, 2 files

Files

• CabalIndex.hs +68/−0
• CabalSearch.cabal +2/−1

@@ -0,0 +1,68 @@+module CabalIndex+       ( buildDatabase+       , queryPackages)+       where++import Control.Monad++import System.Directory      (renameFile)+import System.FilePath       ((</>))+import System.Process        (readProcess)++import Database.HDBC+import Database.HDBC.Sqlite3++import qualified Data.List as L+++{-| Insert packages into table -}+populate :: IConnection c => c -> [(String, String)] -> IO ()+populate conn ps =+  do stmt <- prepare conn "INSERT INTO packages VALUES (?, ?)"+     executeMany stmt $ map (\(n,m) -> [toSql n, toSql m]) ps++{-| Create table for packages -}+createTable :: IConnection c => c -> IO ()+createTable conn =+  void $ run conn "CREATE TABLE packages (name VARCHAR(16) PRIMARY KEY, meta VARCHAR(128))" []++{-| Create and populate a new database, replacing the old -}+buildDatabase :: FilePath -> String -> IO ()+buildDatabase dbDir dbName =+  do -- place tmp file in same dir as db to allow atomic move+     let tmpDb = dbDir </> dbName ++ "-partial"+     -- build database in temporary path+     conn <- connectSqlite3 tmpDb+     createTable conn+     populate conn =<< parseCabal+     -- commit and disconnect+     commit conn+     disconnect conn+     -- move new database over old one+     renameFile tmpDb $ dbDir </> dbName++{-| Query a database, using the output from Cabal -}+queryPackages :: FilePath -> String -> IO [(String, String)]+queryPackages db term =+  do conn <- connectSqlite3 db+     rows <- quickQuery conn "SELECT * FROM packages WHERE name LIKE ?" [toSql $ '%':term++"%"]+     return $ map (\[n,m] -> (fromSql n :: String, fromSql m :: String)) rows+++{-| List packages using Cabal and parse the result to (name, meta) -}+parseCabal :: IO [(String, String)]+parseCabal = go `fmap` lines `fmap` readProcess "cabal" ["list"] []+  where+    go [] = []+    go (('*':' ':name):rest) =+      let (meta, rest') = gm [] rest+      in (name, L.intercalate "\n" meta) : go rest'+    go l = error $ "Unexpected cabal output" ++ show l++    gm m [] = (m, [])+    gm m (rest@(('*':_):_)) = (m, rest)+    gm m (x:xs)+      | L.null x  = gm m xs+      | otherwise = gm (m ++ [x]) xs++

@@ -1,5 +1,5 @@ name:           CabalSearch-version:        0.0.1+version:        0.0.2 license:        BSD3 license-file:   LICENSE category:       Utils@@ -23,6 +23,7 @@  executable cabalsearch     main-is: Main.hs+    other-modules: CabalIndex      build-depends:         base == 4.*,