groundhog-mysql 0.7.0.1 → 0.8

raw patch · 3 files changed

+135/−124 lines, 3 filesdep +resourcetdep ~groundhogdep ~mysql-simpledep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: resourcet

Dependency ranges changed: groundhog, mysql-simple, transformers

API changes (from Hackage documentation)

Files

• Database/Groundhog/MySQL.hs +126/−120
• changelog +4/−0
• groundhog-mysql.cabal +5/−4

@@ -35,10 +35,11 @@ import Control.Arrow (first, second, (***)) import Control.Monad (liftM, liftM2, (>=>)) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Logger (MonadLogger, logDebugS) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.State (mapStateT)+import Data.Acquire (mkAcquire) import Data.ByteString.Char8 (ByteString) import Data.Char (toUpper) import Data.Function (on)@@ -67,53 +68,55 @@   log' a = mkExpr $ function "log" [toExpr a]   logBase' b x = mkExpr $ function "log" [toExpr b, toExpr x] -instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => PersistBackend (DbPersist MySQL m) where-  type PhantomDb (DbPersist MySQL m) = MySQL-  insert v = insert' v-  insert_ v = insert_' v-  insertBy u v = H.insertBy renderConfig queryRaw' True u v-  insertByAll v = H.insertByAll renderConfig queryRaw' True v-  replace k v = H.replace renderConfig queryRaw' executeRaw' insertIntoConstructorTable k v-  replaceBy k v = H.replaceBy renderConfig executeRaw' k v-  select options = H.select renderConfig queryRaw' preColumns noLimit options-  selectAll = H.selectAll renderConfig queryRaw'-  get k = H.get renderConfig queryRaw' k-  getBy k = H.getBy renderConfig queryRaw' k-  update upds cond = H.update renderConfig executeRaw' upds cond-  delete cond = H.delete renderConfig executeRaw' cond-  deleteBy k = H.deleteBy renderConfig executeRaw' k-  deleteAll v = H.deleteAll renderConfig executeRaw' v-  count cond = H.count renderConfig queryRaw' cond-  countAll fakeV = H.countAll renderConfig queryRaw' fakeV-  project p options = H.project renderConfig queryRaw' preColumns noLimit p options-  migrate fakeV = migrate' fakeV+instance PersistBackendConn MySQL where+  insert v = runDb' $ insert' v+  insert_ v = runDb' $ insert_' v+  insertBy u v = runDb' $ H.insertBy renderConfig queryRaw' True u v+  insertByAll v = runDb' $ H.insertByAll renderConfig queryRaw' True v+  replace k v = runDb' $ H.replace renderConfig queryRaw' executeRaw' insertIntoConstructorTable k v+  replaceBy k v = runDb' $ H.replaceBy renderConfig executeRaw' k v+  select options = runDb' $ H.select renderConfig queryRaw' preColumns noLimit options+  selectStream options = runDb' $ H.selectStream renderConfig queryRaw' preColumns noLimit options+  selectAll = runDb' $ H.selectAll renderConfig queryRaw'+  selectAllStream = runDb' $ H.selectAllStream renderConfig queryRaw'+  get k = runDb' $ H.get renderConfig queryRaw' k+  getBy k = runDb' $ H.getBy renderConfig queryRaw' k+  update upds cond = runDb' $ H.update renderConfig executeRaw' upds cond+  delete cond = runDb' $ H.delete renderConfig executeRaw' cond+  deleteBy k = runDb' $ H.deleteBy renderConfig executeRaw' k+  deleteAll v = runDb' $ H.deleteAll renderConfig executeRaw' v+  count cond = runDb' $ H.count renderConfig queryRaw' cond+  countAll fakeV = runDb' $ H.countAll renderConfig queryRaw' fakeV+  project p options = runDb' $ H.project renderConfig queryRaw' preColumns noLimit p options+  projectStream p options = runDb' $ H.projectStream renderConfig queryRaw' preColumns noLimit p options+  migrate fakeV = mapStateT runDb' $ migrate' fakeV -  executeRaw _ query ps = executeRaw' (fromString query) ps-  queryRaw _ query ps f = queryRaw' (fromString query) ps f+  executeRaw _ query ps = runDb' $ executeRaw' (fromString query) ps+  queryRaw _ query ps = runDb' $ queryRaw' (fromString query) ps -  insertList l = insertList' l-  getList k = getList' k+  insertList l = runDb' $ insertList' l+  getList k = runDb' $ getList' k -instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => SchemaAnalyzer (DbPersist MySQL m) where-  schemaExists schema = queryRaw' "SELECT 1 FROM information_schema.schemata WHERE schema_name=?" [toPrimitivePersistValue proxy schema] (fmap isJust)-  getCurrentSchema = queryRaw' "SELECT database()" [] (fmap (>>= fst . fromPurePersistValues proxy))-  listTables schema = queryRaw' "SELECT table_name FROM information_schema.tables WHERE table_schema=coalesce(?,database())" [toPrimitivePersistValue proxy schema] (mapAllRows $ return . fst . fromPurePersistValues proxy)-  listTableTriggers name = queryRaw' "SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,database()) AND event_object_table=?" (toPurePersistValues proxy name []) (mapAllRows $ return . fst . fromPurePersistValues proxy)-  analyzeTable = analyzeTable'-  analyzeTrigger name = do-    x <- queryRaw' "SELECT action_statement FROM information_schema.triggers WHERE trigger_schema=coalesce(?,database()) AND trigger_name=?" (toPurePersistValues proxy name []) id+instance SchemaAnalyzer MySQL where+  schemaExists schema = runDb' $ queryRaw' "SELECT 1 FROM information_schema.schemata WHERE schema_name=?" [toPrimitivePersistValue schema] >>= firstRow >>= return . isJust+  getCurrentSchema = runDb' $ queryRaw' "SELECT database()" [] >>= firstRow >>= return . (>>= fst . fromPurePersistValues)+  listTables schema = runDb' $ queryRaw' "SELECT table_name FROM information_schema.tables WHERE table_schema=coalesce(?,database())" [toPrimitivePersistValue schema] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList+  listTableTriggers name = runDb' $ queryRaw' "SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,database()) AND event_object_table=?" (toPurePersistValues name []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList+  analyzeTable = runDb' . analyzeTable'+  analyzeTrigger name = runDb' $ do+    x <- queryRaw' "SELECT action_statement FROM information_schema.triggers WHERE trigger_schema=coalesce(?,database()) AND trigger_name=?" (toPurePersistValues name []) >>= firstRow     return $ case x of       Nothing  -> Nothing-      Just src -> fst $ fromPurePersistValues proxy src-  analyzeFunction name = do-    result <- queryRaw' "SELECT param_list, returns, body_utf8 from mysql.proc WHERE db = coalesce(?, database()) AND name = ?" (toPurePersistValues proxy name []) id+      Just src -> fst $ fromPurePersistValues src+  analyzeFunction name = runDb' $ do+    result <- queryRaw' "SELECT param_list, returns, body_utf8 from mysql.proc WHERE db = coalesce(?, database()) AND name = ?" (toPurePersistValues name []) >>= firstRow     let read' typ = readSqlType typ typ (Nothing, Nothing, Nothing)     return $ case result of       Nothing  -> Nothing       -- TODO: parse param_list       Just result' -> Just (Just [DbOther (OtherTypeDef [Left param_list])], if ret == "" then Nothing else Just $ read' ret, src) where-        (param_list, ret, src) = fst . fromPurePersistValues proxy $ result'-  getMigrationPack = fmap (migrationPack . fromJust) getCurrentSchema+        (param_list, ret, src) = fst . fromPurePersistValues $ result'+  getMigrationPack = liftM (migrationPack . fromJust) getCurrentSchema  withMySQLPool :: (MonadBaseControl IO m, MonadIO m)               => MySQL.ConnectInfo@@ -142,19 +145,18 @@     liftIO $ MySQL.execute_ c $ "RELEASE SAVEPOINT" <> name'     return x -instance ConnectionManager MySQL MySQL where+instance ConnectionManager MySQL where   withConn f conn@(MySQL c) = do     liftIO $ MySQL.execute_ c "start transaction"     x <- onException (f conn) (liftIO $ MySQL.rollback c)     liftIO $ MySQL.commit c     return x-  withConnNoTransaction f conn = f conn -instance ConnectionManager (Pool MySQL) MySQL where-  withConn f pconn = withResource pconn (withConn f)-  withConnNoTransaction f pconn = withResource pconn (withConnNoTransaction f)+instance ExtractConnection MySQL MySQL where+  extractConn f conn = f conn -instance SingleConnectionManager MySQL MySQL+instance ExtractConnection (Pool MySQL) MySQL where+  extractConn f pconn = withResource pconn f  open' :: MySQL.ConnectInfo -> IO MySQL open' ci = do@@ -165,12 +167,12 @@ close' :: MySQL -> IO () close' (MySQL conn) = MySQL.close conn -insert' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist MySQL m (AutoKey v)+insert' :: PersistEntity v => v -> Action MySQL (AutoKey v) insert' v = do   -- constructor number and the rest of the field values   vals <- toEntityPersistValues' v   let e = entityDef proxy v-  let constructorNum = fromPrimitivePersistValue proxy (head vals)+  let constructorNum = fromPrimitivePersistValue (head vals)    liftM fst $ if isSimple (constructors e)     then do@@ -189,12 +191,12 @@       executeRaw' cQuery (vals' [])       pureFromPersistValue [rowid] -insert_' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist MySQL m ()+insert_' :: PersistEntity v => v -> Action MySQL () insert_' v = do   -- constructor number and the rest of the field values   vals <- toEntityPersistValues' v   let e = entityDef proxy v-  let constructorNum = fromPrimitivePersistValue proxy (head vals)+  let constructorNum = fromPrimitivePersistValue (head vals)    if isSimple (constructors e)     then do@@ -220,7 +222,7 @@     xs -> "(" <> commasJoin xs <> ") VALUES(" <> placeholders <> ")"   RenderS placeholders vals' = commasJoin $ map renderPersistValue vals -insertList' :: forall m a.(MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistField a) => [a] -> DbPersist MySQL m Int64+insertList' :: forall a. PersistField a => [a] -> Action MySQL Int64 insertList' (l :: [a]) = do   let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a))   executeRaw' ("INSERT INTO " <> escapeS mainName <> "()VALUES()") []@@ -228,34 +230,34 @@   let valuesName = mainName <> delim' <> "values"   let fields = [("ord", dbType proxy (0 :: Int)), ("value", dbType proxy (undefined :: a))]   let query = "INSERT INTO " <> escapeS valuesName <> "(id," <> renderFields escapeS fields <> ")VALUES(?," <> renderFields (const $ fromChar '?') fields <> ")"-  let go :: Int -> [a] -> DbPersist MySQL m ()+  let go :: Int -> [a] -> Action MySQL ()       go n (x:xs) = do        x' <- toPersistValues x-       executeRaw' query $ (k:) . (toPrimitivePersistValue proxy n:) . x' $ []+       executeRaw' query $ (k:) . (toPrimitivePersistValue n:) . x' $ []        go (n + 1) xs       go _ [] = return ()   go 0 l-  return $ fromPrimitivePersistValue proxy k+  return $ fromPrimitivePersistValue k   -getList' :: forall m a.(MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistField a) => Int64 -> DbPersist MySQL m [a]+getList' :: forall a . PersistField a => Int64 -> Action MySQL [a] getList' k = do   let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a))   let valuesName = mainName <> delim' <> "values"   let value = ("value", dbType proxy (undefined :: a))   let query = "SELECT " <> renderFields escapeS [value] <> " FROM " <> escapeS valuesName <> " WHERE id=? ORDER BY ord"-  queryRaw' query [toPrimitivePersistValue proxy k] $ mapAllRows (liftM fst . fromPersistValues)+  queryRaw' query [toPrimitivePersistValue k] >>= mapStream (liftM fst . fromPersistValues) >>= streamToList -getLastInsertId :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => DbPersist MySQL m PersistValue+getLastInsertId :: Action MySQL PersistValue getLastInsertId = do-  x <- queryRaw' "SELECT last_insert_id()" [] id+  x <- queryRaw' "SELECT last_insert_id()" [] >>= firstRow   return $ maybe (error "getLastInsertId: Nothing") head x  ---------- -executeRaw' :: (MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> DbPersist MySQL m ()+executeRaw' :: Utf8 -> [PersistValue] -> Action MySQL () executeRaw' query vals = do-  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals-  MySQL conn <- DbPersist ask+--  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals+  MySQL conn <- ask   let stmt = getStatement query   liftIO $ do     _ <- MySQL.execute conn stmt (map P vals)@@ -272,35 +274,36 @@ delim' :: Utf8 delim' = fromChar delim -toEntityPersistValues' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistEntity v) => v -> DbPersist MySQL m [PersistValue]+toEntityPersistValues' :: PersistEntity v => v -> Action MySQL [PersistValue] toEntityPersistValues' = liftM ($ []) . toEntityPersistValues  --- MIGRATION -migrate' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> Migration (DbPersist MySQL m)+migrate' :: PersistEntity v => v -> Migration (Action MySQL) migrate' v = do   migPack <- lift getMigrationPack   migrateRecursively (migrateSchema migPack) (migrateEntity migPack) (migrateList migPack) v -migrationPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => String -> GM.MigrationPack (DbPersist MySQL m)-migrationPack currentSchema = GM.MigrationPack-  compareTypes-  (compareRefs currentSchema)-  compareUniqs-  compareDefaults-  migTriggerOnDelete-  migTriggerOnUpdate-  GM.defaultMigConstr-  escape-  "BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY"-  mainTableId-  defaultPriority-  (\uniques refs -> ([], map AddUnique uniques ++ map AddReference refs))-  showSqlType-  showColumn-  (showAlterDb currentSchema)-  Restrict-  Restrict+migrationPack :: String -> GM.MigrationPack MySQL+migrationPack currentSchema = m where+  m = GM.MigrationPack+    compareTypes+    (compareRefs currentSchema)+    compareUniqs+    compareDefaults+    migTriggerOnDelete+    migTriggerOnUpdate+    (GM.defaultMigConstr m)+    escape+    "BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY"+    mainTableId+    defaultPriority+    (\uniques refs -> ([], map AddUnique uniques ++ map AddReference refs))+    showSqlType+    showColumn+    (showAlterDb currentSchema)+    Restrict+    Restrict  showColumn :: Column -> String showColumn (Column n nu t def) = concat@@ -314,7 +317,7 @@         Just s  -> " DEFAULT " ++ s     ] -migTriggerOnDelete :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> [(String, String)] -> DbPersist MySQL m (Bool, [AlterDB])+migTriggerOnDelete :: QualifiedName -> [(String, String)] -> Action MySQL (Bool, [AlterDB]) migTriggerOnDelete name deletes = do   let addTrigger = AddTriggerOnDelete name name (concatMap snd deletes)   x <- analyzeTrigger name@@ -330,7 +333,7 @@  -- | Schema name, table name and a list of field names and according delete statements -- assume that this function is called only for ephemeral fields-migTriggerOnUpdate :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> [(String, String)] -> DbPersist MySQL m [(Bool, [AlterDB])]+migTriggerOnUpdate :: QualifiedName -> [(String, String)] -> Action MySQL [(Bool, [AlterDB])] migTriggerOnUpdate tName deletes = do   let trigName = second (++ "_ON_UPDATE") tName       f (fieldName, del) = "IF NOT (NEW." ++ escape fieldName ++ " <=> OLD." ++ escape fieldName ++ ") THEN " ++ del ++ " END IF;"@@ -347,9 +350,9 @@         -- this can happen when an ephemeral field was added or removed.         else [DropTrigger trigName tName, addTrigger])   -analyzeTable' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> DbPersist MySQL m (Maybe TableInfo)+analyzeTable' :: QualifiedName -> Action MySQL (Maybe TableInfo) analyzeTable' name = do-  table <- queryRaw' "SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, database()) AND table_name = ?" (toPurePersistValues proxy name []) id+  table <- queryRaw' "SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, database()) AND table_name = ?" (toPurePersistValues name []) >>= firstRow   case table of     Just _ -> do       let colQuery = "SELECT c.column_name, c.is_nullable, c.data_type, c.column_type, c.column_default, c.character_maximum_length, c.numeric_precision, c.numeric_scale, c.extra\@@ -357,11 +360,11 @@ \  WHERE c.table_schema = coalesce(?, database()) AND c.table_name=?\ \  ORDER BY c.ordinal_position" -      cols <- queryRaw' colQuery (toPurePersistValues proxy name []) (mapAllRows $ return . first getColumn . fst . fromPurePersistValues proxy)+      cols <- queryRaw' colQuery (toPurePersistValues name []) >>= mapStream (return . first getColumn . fst . fromPurePersistValues) >>= streamToList       -- MySQL has no difference between unique keys and indexes       let constraintQuery = "SELECT u.constraint_name, u.column_name FROM information_schema.table_constraints tc INNER JOIN information_schema.key_column_usage u USING (constraint_catalog, constraint_schema, constraint_name, table_schema, table_name) WHERE tc.constraint_type=? AND tc.table_schema=coalesce(?,database()) AND u.table_name=? ORDER BY u.constraint_name, u.column_name"-      uniqConstraints <- queryRaw' constraintQuery (toPurePersistValues proxy ("UNIQUE" :: String, name) []) (mapAllRows $ return . fst . fromPurePersistValues proxy)-      uniqPrimary <- queryRaw' constraintQuery (toPurePersistValues proxy ("PRIMARY KEY" :: String, name) []) (mapAllRows $ return . fst . fromPurePersistValues proxy)+      uniqConstraints <- queryRaw' constraintQuery (toPurePersistValues ("UNIQUE" :: String, name) []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList+      uniqPrimary <- queryRaw' constraintQuery (toPurePersistValues ("PRIMARY KEY" :: String, name) []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList       let mkUniqs typ = map (\us -> UniqueDef (fst $ head us) typ (map (Left . snd) us)) . groupBy ((==) `on` fst)           isAutoincremented = case filter (\c -> colName (fst c) `elem` map snd uniqPrimary) cols of                                 [(c, extra)] -> colType c `elem` [DbInt32, DbInt64] && "auto_increment" `isInfixOf` (extra :: String)@@ -375,14 +378,14 @@ getColumn ((column_name, is_nullable, data_type, column_type, d), modifiers) = Column column_name (is_nullable == "YES") t d where   t = readSqlType data_type column_type modifiers -analyzeTableReferences :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> DbPersist MySQL m [(Maybe String, Reference)]+analyzeTableReferences :: QualifiedName -> Action MySQL [(Maybe String, Reference)] analyzeTableReferences name = do   let query = "SELECT tc.constraint_name, u.referenced_table_schema, u.referenced_table_name, rc.delete_rule, rc.update_rule, u.column_name, u.referenced_column_name FROM information_schema.table_constraints tc\ \  INNER JOIN information_schema.key_column_usage u USING (constraint_catalog, constraint_schema, constraint_name, table_schema, table_name)\ \  INNER JOIN information_schema.referential_constraints rc USING (constraint_catalog, constraint_schema, constraint_name)\ \  WHERE tc.constraint_type='FOREIGN KEY' AND tc.table_schema=coalesce(?, database()) AND tc.table_name=?\ \  ORDER BY tc.constraint_name"-  x <- queryRaw' query (toPurePersistValues proxy name []) $ mapAllRows (return . fst . fromPurePersistValues proxy)+  x <- queryRaw' query (toPurePersistValues name []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList   -- (refName, ((parentTableSchema, parentTable, onDelete, onUpdate), (childColumn, parentColumn)))   let mkReference xs = (Just refName, Reference parentTable pairs (mkAction onDelete) (mkAction onUpdate)) where         pairs = map (snd . snd) xs@@ -569,41 +572,44 @@ getStatement :: Utf8 -> MySQL.Query getStatement sql = MySQL.Query $ fromUtf8 sql -queryRaw' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> (RowPopper (DbPersist MySQL m) -> DbPersist MySQL m a) -> DbPersist MySQL m a-queryRaw' query vals func = do-  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals-  MySQL conn <- DbPersist ask-  liftIO $ MySQL.formatQuery conn (getStatement query) (map P vals) >>= MySQLBase.query conn-  result <- liftIO $ MySQLBase.storeResult conn-  -- Find out the type of the columns-  fields <- liftIO $ MySQLBase.fetchFields result-  let getters = [maybe PersistNull (getGetter (MySQLBase.fieldType f) f . Just) | f <- fields]-      convert = use getters where-        use (g:gs) (col:cols) = v `seq` vs `seq` (v:vs) where-          v  = g col-          vs = use gs cols-        use _ _ = []-  let go acc = do-        row <- MySQLBase.fetchRow result-        case row of-          [] -> return (acc [])-          _  -> let converted = convert row-                in converted `seq` go (acc . (converted:))-  -- TODO: this variable is ugly. Switching to pipes or conduit might help-  rowsVar <- liftIO $ flip finally (MySQLBase.freeResult result) (go id) >>= newIORef-  func $ do-    rows <- liftIO $ readIORef rowsVar-    case rows of-      [] -> return Nothing-      (x:xs) -> do-        liftIO $ writeIORef rowsVar xs-        return $ Just x+queryRaw' :: Utf8 -> [PersistValue] -> Action MySQL (RowStream [PersistValue])+queryRaw' query vals = do+--  $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals+  MySQL conn <- ask+  let open = do+      MySQL.formatQuery conn (getStatement query) (map P vals) >>= MySQLBase.query conn+      result <- MySQLBase.storeResult conn+      -- Find out the type of the columns+      fields <- MySQLBase.fetchFields result+      let getters = [maybe PersistNull (getGetter (MySQLBase.fieldType f) f . Just) | f <- fields]+          convert = use getters where+            use (g:gs) (col:cols) = v `seq` vs `seq` (v:vs) where+              v  = g col+              vs = use gs cols+            use _ _ = []+      let go acc = do+            row <- MySQLBase.fetchRow result+            case row of+              [] -> return (acc [])+              _  -> let converted = convert row+                    in converted `seq` go (acc . (converted:))+      -- TODO: this variable is ugly. Switching to pipes or conduit might help+      rowsVar <- flip finally (MySQLBase.freeResult result) (go id) >>= newIORef+      return $ do+        rows <- readIORef rowsVar+        case rows of+          [] -> return Nothing+          (x:xs) -> do+            writeIORef rowsVar xs+            return $ Just x+  return $ mkAcquire open (const $ return ())  -- | Avoid orphan instances. newtype P = P PersistValue  instance MySQL.Param P where   render (P (PersistString t))      = MySQL.render t+  render (P (PersistText t))        = MySQL.render t   render (P (PersistByteString bs)) = MySQL.render bs   render (P (PersistInt64 i))       = MySQL.render i   render (P (PersistDouble d))      = MySQL.render d@@ -651,8 +657,8 @@ -- Null getGetter MySQLBase.Null       = \_ _ -> PersistNull -- Controversial conversions-getGetter MySQLBase.Set        = convertPV PersistString-getGetter MySQLBase.Enum       = convertPV PersistString+getGetter MySQLBase.Set        = convertPV PersistText+getGetter MySQLBase.Enum       = convertPV PersistText -- Unsupported getGetter other = error $ "MySQL.getGetter: type " ++                   show other ++ " not supported."

@@ -1,3 +1,7 @@+0.8+* Support for GHC 8+* Bumped MySQL dependencies+ 0.7.0.1 * Support for monad-control 1.0 

@@ -1,5 +1,5 @@ name:            groundhog-mysql-version:         0.7.0.1+version:         0.8 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -16,16 +16,17 @@  library     build-depends:   base                     >= 4         && < 5-                   , mysql-simple             >= 0.2.2.3   && < 0.3+                   , mysql-simple             >= 0.2.2.3   && < 0.5                    , mysql                    >= 0.1.1.3   && < 0.2                    , bytestring               >= 0.9-                   , transformers             >= 0.2.1     && < 0.5-                   , groundhog                >= 0.7       && < 0.8+                   , transformers             >= 0.2.1     && < 0.6+                   , groundhog                >= 0.8       && < 0.9                    , monad-control            >= 0.3       && < 1.1                    , monad-logger             >= 0.3       && < 0.4                    , containers               >= 0.2                    , text                     >= 0.8                    , resource-pool            >= 0.2.1                    , time                     >= 1.1+                   , resourcet                >= 1.1.2     exposed-modules: Database.Groundhog.MySQL     ghc-options:     -Wall -fno-warn-unused-do-bind