DSH 0.7.2 → 0.7.3

raw patch · 7 files changed

+105/−29 lines, 7 files

Files

• DSH.cabal +2/−1
• examples/Example01.hs +2/−2
• examples/Example02.hs +14/−0
• examples/Makefile +2/−1
• src/Database/DSH.hs +5/−3
• src/Database/DSH/Combinators.hs +3/−3
• src/Database/DSH/TH.hs +77/−19

@@ -1,5 +1,5 @@ Name:                DSH-Version:             0.7.2+Version:             0.7.3 Synopsis:            Database Supported Haskell Description:   This is a Haskell library for database-supported program execution. Using@@ -43,6 +43,7 @@ Build-type:          Simple  Extra-source-files:  examples/Example01.hs+                     examples/Example02.hs                      examples/Makefile                      tests/Main.hs                      tests/Makefile

@@ -2,7 +2,7 @@  module Main where -import qualified Prelude as P +import qualified Prelude as P import Database.DSH import Database.DSH.Compiler @@ -22,7 +22,7 @@           | (view -> (i1,i2)) <- query1           , i1 == i2           ]-          + getConn :: IO Connection getConn = connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'" 

@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances, MultiParamTypeClasses #-}++module Main where++import qualified Prelude as P+import Database.DSH++import Database.HDBC.PostgreSQL+          +$(generateDatabaseRecordInstances (connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'"))+$(generateTableDeclarations       (connectPostgreSQL "user = 'giorgidz' password = '' host = 'localhost' dbname = 'giorgidz'"))++main :: IO ()+main = P.return ()

@@ -1,6 +1,7 @@ all: clean 		ghc -Wall -O3 --make Example01.hs+		ghc -Wall -O3 --make Example02.hs 		rm -rf *.hi *.o  clean:-		rm -rf *.hi *.o Example01+		rm -rf *.hi *.o Example01 Example02

@@ -26,8 +26,10 @@   , View, view, fromView, tuple, record      -- * Template Haskell: Creating Table Representations-  , generateRecords-  , generateInstances+  , generateDatabaseRecordInstances+  , generateTableRecordInstances+  , generateRecordInstances+  , generateTableDeclarations    , module Database.DSH.CSV @@ -39,7 +41,7 @@   where  import Database.DSH.Data (Q, QA, TA, table, tableDB, tableCSV, tableWithKeys, BasicType, View, view, fromView, tuple, record)-import Database.DSH.TH (generateRecords, generateInstances)+import Database.DSH.TH (generateDatabaseRecordInstances, generateTableRecordInstances, generateRecordInstances, generateTableDeclarations) import Database.DSH.CSV (csvExport)  import Database.DSH.Combinators

@@ -352,9 +352,9 @@  -- 'QA', 'TA' and 'View' instances for tuples up to the defined length. -$(generateDeriveTupleQARange   3 8)-$(generateDeriveTupleTARange   3 8)-$(generateDeriveTupleViewRange 3 8)+$(generateDeriveTupleQARange   3 16)+$(generateDeriveTupleTARange   3 16)+$(generateDeriveTupleViewRange 3 16)   -- * Missing Combinators

@@ -16,8 +16,10 @@     , deriveTAForRecord     , deriveTAForRecord' -    , generateRecords-    , generateInstances+    , generateDatabaseRecordInstances+    , generateTableRecordInstances+    , generateRecordInstances+    , generateTableDeclarations     ) where  @@ -27,6 +29,7 @@ import Control.Applicative import Control.Monad import Data.Convertible+import Data.Char import Data.List import Database.HDBC import Data.Text (Text)@@ -443,25 +446,80 @@ -- * Exported enduser functions -- +-- | Generate table declarations for all tables in the database. This function+-- should be used in conjunction with generateDatabaseRecordInstances. For+-- example, this function generates the following code for the table 'users':+--+-- > users :: Q [User]+-- > users = table "users"+--+generateTableDeclarations :: (IConnection conn)+                             => (IO conn)  -- ^ Database connection+                             -> TH.Q [Dec]+generateTableDeclarations conn = do+  tables <- runIO $ do  c <- conn+                        r <- getTables c+                        disconnect c+                        return r+  declss <- mapM generateTableDeclaration tables+  return (concat declss)++generateTableDeclaration :: String -> TH.Q [Dec]+generateTableDeclaration s = return+  [ TH.SigD (mkName s) (TH.AppT (TH.ConT ''Q) (TH.AppT TH.ListT (TH.ConT (mkName (dataTypeName s)))))+  , TH.FunD (mkName s) [TH.Clause [] (TH.NormalB (TH.AppE (TH.VarE (mkName "table")) (TH.LitE (TH.StringL s)))) []]+  ]++-- | Create corresponding Haskell record data types and generate QA and View+-- instances for all tables in the database (except for system tables).+--+-- Example usage:+--+-- > $(generateDatabaseRecordInstances myConnection)+--+-- Note that the database information is queried at compile time, not at run time!+generateDatabaseRecordInstances :: (IConnection conn)+                             => (IO conn)  -- ^ Database connection+                             -> TH.Q [Dec]+generateDatabaseRecordInstances conn = do+  tables <- runIO $ do  c <- conn+                        r <- getTables c+                        disconnect c+                        return r+  decss <- mapM (\t -> generateTableRecordInstances conn t (dataTypeName t) [''Show,''Eq]) tables+  return (concat decss)++dataTypeName :: String -> String+dataTypeName []       = []+dataTypeName [c]      = map toUpper (cleanUnderscores [c])+dataTypeName (c : cs) = toUpper c : cleanUnderscores (init cs)++cleanUnderscores :: String -> String+cleanUnderscores []             = []+cleanUnderscores ['_']          = [] +cleanUnderscores ('_' : c : cs) = toUpper c : cleanUnderscores cs+cleanUnderscores (c : cs)       = c : cleanUnderscores cs+ -- | Lookup a database table, create corresponding Haskell record data types -- and generate QA and View instances -- -- Example usage: ----- > $(generateRecords myConnection "users" "User" [''Show,''Eq])+-- > $(generateTableRecordInstances myConnection "users" "User" [''Show,''Eq]) ----- Note that the da is created at compile time, not at run time!-generateRecords :: (IConnection conn)-                    => (IO conn)  -- ^ Database connection-                    -> String     -- ^ Table name-                    -> String     -- ^ Data type name for each row of the table-                    -> [Name]     -- ^ Default deriving instances-                    -> TH.Q [Dec]-generateRecords conn t dname dnames = do-    tdesc <- runIO $ do-        c <- conn-        describeTable c t-    generateInstances (createDataType (sortWith fst tdesc))+-- Note that the table information is queried at compile time, not at run time!+generateTableRecordInstances  :: (IConnection conn)+                              => (IO conn)  -- ^ Database connection+                              -> String     -- ^ Table name+                              -> String     -- ^ Data type name for each row of the table+                              -> [Name]     -- ^ Default deriving instances+                              -> TH.Q [Dec]+generateTableRecordInstances conn t dname dnames = do+    tdesc <- runIO $ do c <- conn+                        r <- describeTable c t+                        disconnect c+                        return r+    generateRecordInstances (createDataType (sortWith fst tdesc))    where     createDataType :: [(String, SqlColDesc)] -> TH.Q [Dec]@@ -495,7 +553,7 @@ -- -- Example usage: ----- > $(generateInstances [d|+-- > $(generateRecordInstances [d| -- > -- >     data User = User -- >         { userId    :: Int@@ -517,11 +575,11 @@ -- -- > userIdQ      :: Q User -> Q Int -- > userNameQ    :: Q User -> Q String-generateInstances :: TH.Q [Dec] -> TH.Q [Dec]-generateInstances q = do+generateRecordInstances :: TH.Q [Dec] -> TH.Q [Dec]+generateRecordInstances q = do     d  <- q     qa <- deriveQAForRecord' q     v  <- deriveViewForRecord' q     ta <- deriveTAForRecord' q     rs <- recordQSelectors' q-    return $ d ++ qa ++ v ++ ta ++ rs+    return (d ++ qa ++ v ++ ta ++ rs)