Permalink
Browse files

Add deepseq support.

  • Loading branch information...
1 parent 147c23e commit 5f11108e6e20098e7ac4e026d83c87bc1aa80114 @bos bos committed Apr 29, 2011
View
@@ -2,11 +2,13 @@ module Database.MySQL.Simple
(
execute
, query
+ , query_
, formatQuery
) where
import Control.Applicative
import Data.Int (Int64)
+import Control.DeepSeq
import Control.Monad.Fix
import Blaze.ByteString.Builder
import qualified Data.ByteString.Char8 as B
@@ -44,6 +46,15 @@ execute conn template qs = do
query :: (QueryParams q, QueryResults r) => Connection -> Query -> q -> IO [r]
query conn template qs = do
Base.query conn =<< formatQuery conn template qs
+ finishQuery conn
+
+query_ :: (QueryResults r) => Connection -> Query -> IO [r]
+query_ conn (Query q) = do
+ Base.query conn q
+ finishQuery conn
+
+finishQuery :: (QueryResults r) => Connection -> IO [r]
+finishQuery conn = do
r <- Base.storeResult conn
ncols <- Base.fieldCount (Right r)
if ncols == 0
@@ -54,7 +65,8 @@ query conn template qs = do
row <- Base.fetchRow r
case row of
[] -> return (reverse acc)
- _ -> loop (convertResults fs row:acc)
+ _ -> let c = convertResults fs row
+ in rnf c `seq` loop (c:acc)
fmtError :: String -> a
fmtError msg = error $ "Database.MySQL.formatQuery: " ++ msg
@@ -0,0 +1,40 @@
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Database.MySQL.Simple.Orphans () where
+
+import Data.Time.Calendar (Day(..))
+import Data.Time.Clock (UTCTime(..))
+import Data.Time.LocalTime (TimeOfDay(..))
+import qualified Data.ByteString.Internal as SB
+import qualified Data.ByteString.Lazy.Internal as LB
+import Control.DeepSeq (NFData(..))
+
+instance NFData SB.ByteString where
+ rnf (SB.PS _ _ _) = ()
+ {-# INLINE rnf #-}
+
+instance NFData LB.ByteString where
+ rnf (LB.Chunk (SB.PS _ _ _) cs) = rnf cs
+ rnf LB.Empty = ()
+
+instance NFData Day where
+ rnf (ModifiedJulianDay !_) = ()
+ {-# INLINE rnf #-}
+
+instance NFData TimeOfDay where
+ rnf (TimeOfDay !_ !_ !_) = ()
+ {-# INLINE rnf #-}
+
+instance NFData UTCTime where
+ rnf (UTCTime !_ !_) = ()
+ {-# INLINE rnf #-}
+
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ NFData g, NFData h, NFData i, NFData j) =>
+ NFData (a,b,c,d,e,f,g,h,i,j)
+ where
+ rnf (a,b,c,d,e,f,g,h,i,j) =
+ rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq`
+ rnf f `seq` rnf g `seq` rnf h `seq` rnf i `seq` rnf j
+ {-# INLINE rnf #-}
@@ -3,64 +3,76 @@ module Database.MySQL.Simple.QueryResults
QueryResults(..)
) where
+import Control.DeepSeq (NFData(..))
import Data.ByteString (ByteString)
import Database.MySQL.Base.Types
import Database.MySQL.Simple.Result
import Database.MySQL.Simple.Types
-class QueryResults a where
+class (NFData a) => QueryResults a where
convertResults :: [Field] -> [Maybe ByteString] -> a
-instance (Result a) => QueryResults (Only a) where
+instance (NFData a, Result a) => QueryResults (Only a) where
convertResults [fa] [va] = Only (convert fa va)
convertResults fs vs = convError fs vs
-instance (Result a, Result b) => QueryResults (a,b) where
+instance (NFData a, NFData b,
+ Result a, Result b) => QueryResults (a,b) where
convertResults [fa,fb] [va,vb] = (convert fa va, convert fb vb)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c) => QueryResults (a,b,c) where
+instance (NFData a, NFData b, NFData c,
+ Result a, Result b, Result c) => QueryResults (a,b,c) where
convertResults [fa,fb,fc] [va,vb,vc] =
(convert fa va, convert fb vb, convert fc vc)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d) =>
+instance (NFData a, NFData b, NFData c, NFData d,
+ Result a, Result b, Result c, Result d) =>
QueryResults (a,b,c,d) where
convertResults [fa,fb,fc,fd] [va,vb,vc,vd] =
(convert fa va, convert fb vb, convert fc vc, convert fd vd)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e) =>
+instance (NFData a, NFData b, NFData c, NFData d, NFData e,
+ Result a, Result b, Result c, Result d, Result e) =>
QueryResults (a,b,c,d,e) where
convertResults [fa,fb,fc,fd,fe] [va,vb,vc,vd,ve] =
(convert fa va, convert fb vb, convert fc vc, convert fd vd,
convert fe ve)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e, Result f) =>
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ Result a, Result b, Result c, Result d, Result e, Result f) =>
QueryResults (a,b,c,d,e,f) where
convertResults [fa,fb,fc,fd,fe,ff] [va,vb,vc,vd,ve,vf] =
(convert fa va, convert fb vb, convert fc vc, convert fd vd,
convert fe ve, convert ff vf)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e, Result f,
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ NFData g,
+ Result a, Result b, Result c, Result d, Result e, Result f,
Result g) =>
QueryResults (a,b,c,d,e,f,g) where
convertResults [fa,fb,fc,fd,fe,ff,fg] [va,vb,vc,vd,ve,vf,vg] =
(convert fa va, convert fb vb, convert fc vc, convert fd vd,
convert fe ve, convert ff vf, convert fg vg)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e, Result f,
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ NFData g, NFData h,
+ Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h) =>
QueryResults (a,b,c,d,e,f,g,h) where
convertResults [fa,fb,fc,fd,fe,ff,fg,fh] [va,vb,vc,vd,ve,vf,vg,vh] =
(convert fa va, convert fb vb, convert fc vc, convert fd vd,
convert fe ve, convert ff vf, convert fg vg, convert fh vh)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e, Result f,
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ NFData g, NFData h, NFData i,
+ Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h, Result i) =>
QueryResults (a,b,c,d,e,f,g,h,i) where
convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi] [va,vb,vc,vd,ve,vf,vg,vh,vi] =
@@ -69,7 +81,9 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
convert fi vi)
convertResults fs vs = convError fs vs
-instance (Result a, Result b, Result c, Result d, Result e, Result f,
+instance (NFData a, NFData b, NFData c, NFData d, NFData e, NFData f,
+ NFData g, NFData h, NFData i, NFData j,
+ Result a, Result b, Result c, Result d, Result e, Result f,
Result g, Result h, Result i, Result j) =>
QueryResults (a,b,c,d,e,f,g,h,i,j) where
convertResults [fa,fb,fc,fd,fe,ff,fg,fh,fi,fj]
@@ -9,6 +9,8 @@ module Database.MySQL.Simple.Result
#include "MachDeps.h"
import Data.Typeable
+import Database.MySQL.Simple.Orphans ()
+import Control.DeepSeq (NFData)
import Control.Applicative
import Control.Exception
import Data.ByteString (ByteString)
@@ -44,7 +46,7 @@ data ResultError = Incompatible { errSourceType :: String
instance Exception ResultError
-class Result a where
+class (NFData a) => Result a where
convert :: Field -> Maybe ByteString -> a
instance (Result a) => Result (Maybe a) where
@@ -1,3 +1,5 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
module Database.MySQL.Simple.Types
(
Null(..)
@@ -6,6 +8,7 @@ module Database.MySQL.Simple.Types
) where
import Control.Arrow
+import Control.DeepSeq (NFData)
import Blaze.ByteString.Builder
import Data.String (IsString(..))
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8
@@ -27,4 +30,4 @@ instance IsString Query where
fromString = Query . toByteString . Utf8.fromString
newtype Only a = Only a
- deriving (Eq, Ord, Read, Show)
+ deriving (Eq, Ord, Read, Show, NFData)
View
@@ -38,12 +38,16 @@ library
Database.MySQL.Simple.Result
Database.MySQL.Simple.Types
+ other-modules:
+ Database.MySQL.Simple.Orphans
+
build-depends:
attoparsec >= 0.8.5.3,
base < 5,
blaze-builder,
blaze-textual,
- bytestring >= 0.9 && < 1.0,
+ bytestring >= 0.9,
+ deepseq,
mysql,
old-locale,
text >= 0.11.0.2,

0 comments on commit 5f11108

Please sign in to comment.