packages feed

sqlite 0.4.2.1 → 0.5

raw patch · 5 files changed

+100/−45 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Database.SQL.Types: SQLEnum :: [String] -> SQLType
- Database.SQL.Types: SQLSet :: [String] -> SQLType
+ Database.SQL.Types: Cascade :: ForeignUpdateAction
+ Database.SQL.Types: Deferrable :: Deferment
+ Database.SQL.Types: DeferrableInitiallyDeferred :: Deferment
+ Database.SQL.Types: DeferrableInitiallyImmediate :: Deferment
+ Database.SQL.Types: Match :: String -> ForeignUpdateCondition
+ Database.SQL.Types: NoAction :: ForeignUpdateAction
+ Database.SQL.Types: NotDeferrable :: Deferment
+ Database.SQL.Types: NotDeferrableInitiallyDeferred :: Deferment
+ Database.SQL.Types: NotDeferrableInitiallyImmediate :: Deferment
+ Database.SQL.Types: OnDelete :: ForeignUpdateAction -> ForeignUpdateCondition
+ Database.SQL.Types: OnUpdate :: ForeignUpdateAction -> ForeignUpdateCondition
+ Database.SQL.Types: Restrict :: ForeignUpdateAction
+ Database.SQL.Types: SetDefault :: ForeignUpdateAction
+ Database.SQL.Types: SetNull :: ForeignUpdateAction
+ Database.SQL.Types: data Deferment
+ Database.SQL.Types: data ForeignUpdateAction
+ Database.SQL.Types: data ForeignUpdateCondition
- Database.SQL.Types: ForeignKey :: TableName -> [ColumnName] -> Clause
+ Database.SQL.Types: ForeignKey :: TableName -> [ColumnName] -> [ForeignUpdateCondition] -> (Maybe Deferment) -> Clause

Files

Database/SQL/Types.hs view
@@ -32,6 +32,9 @@        , SQLDrop(..)         , Clause(..)+       , ForeignUpdateCondition(..)+       , ForeignUpdateAction(..)+       , Deferment(..)        , Constraint(..)        , Table(..)        , Column(..)@@ -62,9 +65,31 @@  | DefaultValue String  | PrimaryKey Bool    -- ^ Auto-increment?  | ForeignKey TableName [ColumnName]+              [ForeignUpdateCondition]+              (Maybe Deferment)  | Clustered Bool  | Unique +data ForeignUpdateCondition+ = OnDelete ForeignUpdateAction+ | OnUpdate ForeignUpdateAction+ | Match String++data ForeignUpdateAction+ = SetNull+ | SetDefault+ | Cascade+ | Restrict+ | NoAction++data Deferment+ = Deferrable+ | DeferrableInitiallyDeferred+ | DeferrableInitiallyImmediate+ | NotDeferrable+ | NotDeferrableInitiallyDeferred+ | NotDeferrableInitiallyImmediate+ data Constraint   = TablePrimaryKey [ColumnName]   | TableUnique [ColumnName]@@ -106,8 +131,6 @@                (Maybe Int){-digits after dec. point (the scale)-}  | SQLFloat    (Maybe Int){-total number of digits-}                (Maybe Int){-digits following dec. point-}- | SQLEnum     [String]- | SQLSet      [String]  data IntType  = TINY | SMALL | MEDIUM | NORMAL | BIG@@ -163,15 +186,7 @@         case sequence [mbDig,mbScale] of             Nothing -> ""            Just xs -> '(':concat (intersperse "," (map show xs)) ++ ")"-    SQLEnum tgs ->  -        "ENUM(" ++ toTags tgs ++ ")"-    SQLSet tgs -> -        "SET(" ++ toTags tgs ++ ")"-  where-    toTags xs = concat $ intersperse "," (map quote xs) -    quote nm = '\'':nm ++ "'"- showClause :: Clause -> String showClause c =    case c of @@ -180,11 +195,38 @@       | otherwise -> "NOT NULL"     DefaultValue x -> "DEFAULT " ++ toSQLString x     PrimaryKey auto -> "PRIMARY KEY" ++ if auto then " AUTOINCREMENT" else ""-    ForeignKey tb cs -> "FOREIGN KEY " ++ tb ++ '(':concat (intersperse ", " cs) ++ ")"+    ForeignKey tb cs fcs mdf ->+      "REFERENCES " ++ tb ++ "(" ++ concat (intersperse ", " cs) ++ ")" +++        concatMap showUpdateCondition fcs ++ showDeferment mdf     Clustered flg       | flg -> "CLUSTERED"       | otherwise -> "NONCLUSTERED"     Unique  -> "UNIQUE"+ where+  showUpdateCondition (OnDelete a) = " ON DELETE " ++ showAction a+  showUpdateCondition (OnUpdate a) = " ON UPDATE " ++ showAction a+  showUpdateCondition (Match n)    = " MATCH " ++ n+  --+  showAction SetNull    = "SET NULL"+  showAction SetDefault = "SET DEFAULT"+  showAction Cascade    = "CASCADE"+  showAction Restrict   = "RESTRICT"+  showAction NoAction   = "NO ACTION"+  --+  showDeferment Nothing =+    ""+  showDeferment (Just Deferrable) =+    " DEFERRABLE"+  showDeferment (Just DeferrableInitiallyDeferred) =+    " DEFERRABLE INITIALLY DEFERRED"+  showDeferment (Just DeferrableInitiallyImmediate) =+    " DEFERRABLE INITIALLY IMMEDATE"+  showDeferment (Just NotDeferrable) =+    " NOT DEFERRABLE"+  showDeferment (Just NotDeferrableInitiallyDeferred) =+    " NOT DEFERRABLE INITIALLY DEFERRED"+  showDeferment (Just NotDeferrableInitiallyImmediate) =+    " NOT DEFERRABLE INITIALLY IMMEDIATE"  toSQLString :: String -> String toSQLString "" = ""
Database/SQLite.hs view
@@ -19,7 +19,6 @@ -- -- * <http://www.sqlite.org/c3ref/funclist.html> --- module Database.SQLite        ( module Database.SQLite.Base        , module Database.SQLite.Types@@ -63,7 +62,6 @@  import Foreign.Marshal import Foreign.C-import Foreign.C.String (newCStringLen, peekCString) import Foreign.Storable import qualified Foreign.Concurrent as Conc import Foreign.Ptr@@ -71,7 +69,6 @@ import Foreign.ForeignPtr import Data.List import Data.Int-import Data.Char ( isDigit ) import Data.ByteString (ByteString, packCStringLen, useAsCStringLen) import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen) import Control.Monad ((<=<),when)@@ -152,11 +149,15 @@    toVal f p = f p -- ($ f)     quote "" = "''"-   quote nm@(x:_)-    | isDigit x = nm+   quote nm+    | isNumber nm = nm     | otherwise = '\'':toSQLString nm ++ "'" +   isNumber x = case reads x of+                  [(_ :: Float, "")] -> True+                  _                  -> False + -- | Return the rowid (as an Integer) of the most recent -- successful INSERT into the database. --@@ -266,7 +267,7 @@    then_finalize db m stmt = do     e <- m-    sqlite3_finalize stmt+    _ <- sqlite3_finalize stmt     case e of       Left _ -> to_error db       Right r -> return (Right r)@@ -353,9 +354,9 @@ addRegexpSupport h f =  withCString "REGEXP" $ \ zFunctionName ->   do xFunc <- mkStepHandler $ regexp_callback f-     withPrim h $ \ db ->-       sqlite3_create_function db zFunctionName 2 sQLITE_UTF8 nullPtr-                               xFunc noCallback noCallback+     _ <- withPrim h $ \ db ->+            sqlite3_create_function db zFunctionName 2 sQLITE_UTF8 nullPtr+                                    xFunc noCallback noCallback      addSQLiteHandleFinalizer h (freeCallback xFunc)  -- | Internal function to marshall the C types into Haskell types to@@ -497,17 +498,17 @@ createFunctionPrim :: SQLiteHandle -> FunctionName -> Arity -> FunctionHandler -> IO () createFunctionPrim h name arity f = do     xFunc <- mkStepHandler $ function_callback f-    withPrim h $ \db -> do-        withCString name $ \zFunctionName -> do-            sqlite3_create_function-                db-                zFunctionName-                (toEnum arity)-                sQLITE_UTF8-                nullPtr-                xFunc-                noCallback-                noCallback+    _ <- withPrim h $ \db -> do+           withCString name $ \zFunctionName -> do+               sqlite3_create_function+                   db+                   zFunctionName+                   (toEnum arity)+                   sQLITE_UTF8+                   nullPtr+                   xFunc+                   noCallback+                   noCallback     addSQLiteHandleFinalizer h (freeCallback xFunc)  finalize_callback :: IsValue v => a -> (a -> IO v) -> FinalizeContextHandler@@ -545,17 +546,17 @@ createAggregatePrim h name arity step x finalize = do     stepFunc <- mkStepHandler $ step_callback x step     finalizeFunc <- mkFinalizeContextHandler $ finalize_callback x finalize-    withPrim h $ \db -> do-        withCString name $ \zFunctionName -> do-            sqlite3_create_function-                db-                zFunctionName-                (toEnum arity)-                sQLITE_UTF8-                nullPtr-                noCallback-                stepFunc-                finalizeFunc+    _ <- withPrim h $ \db -> do+           withCString name $ \zFunctionName -> do+               sqlite3_create_function+                   db+                   zFunctionName+                   (toEnum arity)+                   sQLITE_UTF8+                   nullPtr+                   noCallback+                   stepFunc+                   finalizeFunc     addSQLiteHandleFinalizer h (freeCallback stepFunc)     addSQLiteHandleFinalizer h (freeCallback finalizeFunc)
Database/SQLite/Base.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ForeignFunctionInterface #-}+{-# OPTIONS_GHC -fno-warn-dodgy-foreign-imports #-} -------------------------------------------------------------------- -- | -- Module    : Database.SQLite.Base
sqlite.cabal view
@@ -1,5 +1,5 @@ Name:            sqlite-Version:         0.4.2.1+Version:         0.5 Synopsis:        Haskell binding to sqlite3 Description:     Haskell binding to sqlite3 <http://sqlite.org/>.@@ -28,14 +28,14 @@   sqlite.buildinfo  flag builtin-sqlite3-  default: True+  default: False   description: Compile sqlite3 as a part of the library.  library   Build-depends:   base >= 3 && < 5, pretty, utf8-string, bytestring, time,                    directory   Extensions:      ForeignFunctionInterface, GeneralizedNewtypeDeriving,-                   TypeSynonymInstances,+                   TypeSynonymInstances, ScopedTypeVariables,                    FlexibleInstances, UndecidableInstances, OverlappingInstances, IncoherentInstances   Ghc-options:     -Wall   Cc-options:      -Wall -DSQLITE_ENABLE_FTS3=1 -O3 -DNDEBUG=1
tests/Main.hs view
@@ -32,19 +32,30 @@               (\ err -> putStrLn ("Error (but ignoring) -- " ++ show err) >> return ())   h <- openConnection dbFile   ign $ defineTable h (newTable "names")+  --   ign $ insertRow h "Poststed" [("Postnr", "4278"),("Poststed", "Veakrossen")]   ls <- execStatement h "SELECT * FROM Poststed WHERE PostNr=4276;"   print (ls :: Either String [[Row Value]])+  --+  ign $ insertRow h "names" [("id", "2357"), ("name", "1,5m bis 3,0m"), ("age","35")]+  -- This test a bug reported by Nikolas Mayr+  ls <- execStatement h "SELECT * FROM names WHERE id=2357;"+  print (ls :: Either String [[Row Value]])+  --   ign $ insertRow h "names" [("id", "1"),("name", "foo"), ("age", "30")]   ls <- execStatement h "SELECT * FROM names;"   print (ls :: Either String [[Row String]])+  --   ls <- execStatement h "SELECT * FROM names where id=1;"   print (ls :: Either String [[Row String]])+  --   createFunction h "hi" (sum :: [Int] -> Int)   ls <- execStatement h "SELECT hi(1,2,3,4,5) AS greeting"   print (ls :: Either String [[Row String]])+  --   createFunction h "say" putStrLn   ls <- execStatement h "SELECT say('Hi') AS greeting"   print (ls :: Either String [[Row String]])+  --   closeConnection h