haskelldb-dynamic (empty) → 0.10
raw patch · 4 files changed
+184/−0 lines, 4 filesdep +basedep +haskell98dep +haskelldbbuild-type:Customsetup-changed
Dependencies added: base, haskell98, haskelldb, mtl, plugins
Files
- DBDirect.hs +83/−0
- Database/HaskellDB/DynConnect.hs +74/−0
- Setup.hs +4/−0
- haskelldb-dynamic.cabal +23/−0
+ DBDirect.hs view
@@ -0,0 +1,83 @@+-----------------------------------------------------------+-- |+-- Module : Main+-- Copyright : Daan Leijen (c) 1999, daan@cs.uu.nl+-- HWT Group (c) 2003,+-- Bjorn Bringert (c) 2005-2006, bjorn@bringert.net+-- License : BSD-style+-- +-- Maintainer : haskelldb-users@lists.sourceforge.net+-- Stability : experimental+-- Portability : portable+--+-- DBDirect generates a Haskell module from a database.+-- It first reads the system catalog of the database into+-- a 'Catalog' data type. After that it pretty prints that+-- data structure in an appropiate Haskell module which+-- can be used to perform queries on the database.+--+-----------------------------------------------------------++module Main where++import Data.List+import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO++import Database.HaskellDB+import Database.HaskellDB.DynConnect+import Database.HaskellDB.DBSpec+import Database.HaskellDB.DBSpec.PPHelpers+import Database.HaskellDB.DBSpec.DBSpecToDBDirect++createModules m useBStrT db = + do+ putStrLn "Getting database info..."+ spec <- dbToDBSpec useBStrT m db+ putStrLn "Writing modules..."+ dbInfoToModuleFiles "." m spec++-- | Command line driver+main = do+ putStrLn "DB/Direct: Daan Leijen (c) 1999, HWT (c) 2003-2004,"+ putStrLn " Bjorn Bringert (c) 2005-2006"+ putStrLn ""+ args <- getArgs+ let (flags,args') = partition ("-" `isPrefixOf`) args+ useBStrT = "-b" `elem` flags+ case args' of+ [m,d,o] -> + do+ let opts = splitOptions o+ putStrLn "Connecting to database..."+ dynConnect_ d opts (createModules m useBStrT)+ putStrLn "Done!"+ _ -> + do+ showHelp+ exitFailure++splitOptions :: String -> [(String,String)]+splitOptions = map (split2 '=') . split ','++split :: Char -> String -> [String]+split _ [] = []+split g xs = y : split g ys+ where (y,ys) = split2 g xs++split2 :: Char -> String -> (String,String)+split2 g xs = (ys, drop 1 zs)+ where (ys,zs) = break (==g) xs++-- | Shows usage information+showHelp = mapM_ (hPutStrLn stderr) t+ where+ t = ["Usage: DBDirect [-b] <module> <driver> <options>",+ "",+ "-b Use bounded string types",+ "<driver> One of: WX, HSQL.MySQL, HDBC.PostgreSQL, etc",+ "<options> Driver dependent,e.g.",+ " WX: dsn=<dsn>,uid=<uid>,pwd=<pwd>",+ " HSQL.MySQL: server=<server>,db=<db>,uid=<uid>,pwd=<pwd>",+ " HDBC.PostgreSQL: host=<server>,dbname=<db>,user=<uid>,password=<pwd>"]
+ Database/HaskellDB/DynConnect.hs view
@@ -0,0 +1,74 @@+-----------------------------------------------------------+-- |+-- Module : Database.HaskellDB.DynConnect+-- Copyright : Anders Hockersten 2004, chucky@dtek.chalmers.se+-- Bjorn Bringert 2005-2006+-- License : BSD-style+--+-- Maintainer : chucky@dtek.chalmers.se+-- Stability : experimental+-- Portability : portable+--+-- This contains functions for loading drivers dynamically +-- and connecting to databases using them.+-----------------------------------------------------------++module Database.HaskellDB.DynConnect (+ dynConnect,+ dynConnect_+ ) where++import Database.HaskellDB.Database (Database)+import Database.HaskellDB.DriverAPI+import Database.HaskellDB.Version++import System.Plugins (loadPackage,unloadPackage,resolveObjs,loadFunction_)+import System.Plugins.Utils (encode)++import Control.Monad.Trans (MonadIO, liftIO)+import Data.Char+import Data.List (isPrefixOf)+++-- | Loads a function from a package module, given the package name,+-- module name and symbol name.+loadPackageFunction :: MonadIO m => + String -- ^ Package name, including version number.+ -> String -- ^ Module name+ -> String -- ^ Symbol to lookup in the module+ -> m (Maybe a)+loadPackageFunction pkgName moduleName functionName =+ do+ liftIO $ loadPackage pkgName+ liftIO $ resolveObjs (unloadPackage pkgName)+ liftIO $ loadFunction_ (encode moduleName) functionName++-- | Loads a driver by package and module name.+dynConnect :: MonadIO m => + String -- ^ Driver package+ -> String -- ^ Driver module+ -> [(String,String)] -- ^ Options to the driver+ -> (Database -> m a) -- ^ Database action to run+ -> m a+dynConnect p m opts f = + do+ res <- loadPackageFunction p m "driver"+ v <- case res of+ Nothing -> fail $ "Couldn't load " ++ m ++ ".driver"+ ++ " from package " ++ p+ Just v -> return v+ connect v opts f++-- | Load a driver by a simple driver name corresponding to the+-- package suffix+dynConnect_ :: MonadIO m => + String -- ^ Driver package suffix, e.g. "WX", "HSQL.MySQL",+ -- "HDBC.PostgreSQL"+ -> [(String,String)] -- ^ Arguments to the driver + -> (Database -> m a) -- ^ Database action to run+ -> m a+dynConnect_ d opts f = + dynConnect p m opts f+ where p = "haskelldb-" ++ (map c d) ++ "-" ++ version+ m = "Database.HaskellDB." ++ d+ c x = if x == '.' then '-' else toLower x
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ haskelldb-dynamic.cabal view
@@ -0,0 +1,23 @@+Name: haskelldb-dynamic+Version: 0.10+Copyright: The authors+Maintainer: haskelldb-users@lists.sourceforge.net+Author: Daan Leijen, Conny Andersson, Martin Andersson, Mary Bergman, Victor Blomqvist, Bjorn Bringert, Anders Hockersten, Torbjorn Martin, Jeremy Shaw+License: BSD3+build-depends: haskell98, base, mtl, haskelldb, plugins+Extensions: ExistentialQuantification,+ OverlappingInstances,+ UndecidableInstances,+ MultiParamTypeClasses+Synopsis: HaskellDB support for the dynamically loaded drivers.+Exposed-Modules:+ Database.HaskellDB.DynConnect+ghc-options: -O2++executable: DBDirect+main-is: DBDirect.hs+Extensions: ExistentialQuantification,+ OverlappingInstances,+ UndecidableInstances,+ MultiParamTypeClasses+ghc-options: -O2