packages feed

groundhog-sqlite 0.7.0.1 → 0.8

raw patch · 3 files changed

+102/−102 lines, 3 filesdep +resourcetdep −monad-loggerdep ~groundhogPVP ok

version bump matches the API change (PVP)

Dependencies added: resourcet

Dependencies removed: monad-logger

Dependency ranges changed: groundhog

API changes (from Hackage documentation)

- Database.Groundhog.Sqlite: instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => PersistBackend (DbPersist Sqlite m)
- Database.Groundhog.Sqlite: instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => SchemaAnalyzer (DbPersist Sqlite m)
- Database.Groundhog.Sqlite: instance ConnectionManager (Pool Sqlite) Sqlite
- Database.Groundhog.Sqlite: instance ConnectionManager Sqlite Sqlite
- Database.Groundhog.Sqlite: instance DbDescriptor Sqlite
- Database.Groundhog.Sqlite: instance Eq Affinity
- Database.Groundhog.Sqlite: instance Savepoint Sqlite
- Database.Groundhog.Sqlite: instance Show Affinity
- Database.Groundhog.Sqlite: instance SingleConnectionManager Sqlite Sqlite
- Database.Groundhog.Sqlite: instance SqlDb Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.ConnectionManager Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.DbDescriptor Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.ExtractConnection (Data.Pool.Pool Database.Groundhog.Sqlite.Sqlite) Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.ExtractConnection Database.Groundhog.Sqlite.Sqlite Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.PersistBackendConn Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Core.Savepoint Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Generic.Migration.SchemaAnalyzer Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance Database.Groundhog.Generic.Sql.SqlDb Database.Groundhog.Sqlite.Sqlite
+ Database.Groundhog.Sqlite: instance GHC.Classes.Eq Database.Groundhog.Sqlite.Affinity
+ Database.Groundhog.Sqlite: instance GHC.Show.Show Database.Groundhog.Sqlite.Affinity
- Database.Groundhog.Sqlite: runDbConn :: (MonadBaseControl IO m, MonadIO m, ConnectionManager cm conn) => DbPersist conn (NoLoggingT m) a -> cm -> m a
+ Database.Groundhog.Sqlite: runDbConn :: (MonadIO m, MonadBaseControl IO m, ConnectionManager conn, ExtractConnection cm conn) => Action conn a -> cm -> m a

Files

Database/Groundhog/Sqlite.hs view
@@ -24,11 +24,12 @@  import Control.Arrow ((***)) import Control.Monad (liftM, forM)-import Control.Monad.Logger (MonadLogger, NoLoggingT, logDebugS) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Reader (ask)+import Control.Monad.Trans.Reader (ask, runReaderT)+import Control.Monad.Trans.State (mapStateT) import qualified Data.ByteString.Char8 as BS+import Data.Acquire (mkAcquire) import Data.Char (toUpper) import Data.Function (on) import Data.Int (Int64)@@ -57,49 +58,50 @@   equalsOperator a b = a <> " IS " <> b   notEqualsOperator a b = a <> " IS NOT " <> b -instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => PersistBackend (DbPersist Sqlite m) where-  {-# SPECIALIZE instance PersistBackend (DbPersist Sqlite (NoLoggingT IO)) #-}-  type PhantomDb (DbPersist Sqlite m) = Sqlite-  insert v = insert' v-  insert_ v = insert_' v-  insertBy u v = H.insertBy renderConfig queryRawCached' True u v-  insertByAll v = H.insertByAll renderConfig queryRawCached' True v-  replace k v = H.replace renderConfig queryRawCached' executeRawCached' insertIntoConstructorTable k v-  replaceBy k v = H.replaceBy renderConfig executeRawCached' k v-  select options = H.select renderConfig queryRawCached' preColumns "LIMIT -1"  options-  selectAll = H.selectAll renderConfig queryRawCached'-  get k = H.get renderConfig queryRawCached' k-  getBy k = H.getBy renderConfig queryRawCached' k-  update upds cond = H.update renderConfig executeRawCached' upds cond-  delete cond = H.delete renderConfig executeRawCached' cond-  deleteBy k = H.deleteBy renderConfig executeRawCached' k-  deleteAll v = H.deleteAll renderConfig executeRawCached' v-  count cond = H.count renderConfig queryRawCached' cond-  countAll fakeV = H.countAll renderConfig queryRawCached' fakeV-  project p options = H.project renderConfig queryRawCached' preColumns "LIMIT -1" p options-  migrate fakeV = migrate' fakeV+instance PersistBackendConn Sqlite where+  insert v = runDb' $ insert' v+  insert_ v = runDb' $ insert_' v+  insertBy u v = runDb' $ H.insertBy renderConfig queryRawCached' True u v+  insertByAll v = runDb' $ H.insertByAll renderConfig queryRawCached' True v+  replace k v = runDb' $ H.replace renderConfig queryRawCached' executeRawCached' insertIntoConstructorTable k v+  replaceBy k v = runDb' $ H.replaceBy renderConfig executeRawCached' k v+  select options = runDb' $ H.select renderConfig queryRawCached' preColumns "LIMIT -1"  options+  selectStream options = runDb' $ H.selectStream renderConfig queryRawCached' preColumns "LIMIT -1"  options+  selectAll = runDb' $ H.selectAll renderConfig queryRawCached'+  selectAllStream = runDb' $ H.selectAllStream renderConfig queryRawCached'+  get k = runDb' $ H.get renderConfig queryRawCached' k+  getBy k = runDb' $ H.getBy renderConfig queryRawCached' k+  update upds cond = runDb' $ H.update renderConfig executeRawCached' upds cond+  delete cond = runDb' $ H.delete renderConfig executeRawCached' cond+  deleteBy k = runDb' $ H.deleteBy renderConfig executeRawCached' k+  deleteAll v = runDb' $ H.deleteAll renderConfig executeRawCached' v+  count cond = runDb' $ H.count renderConfig queryRawCached' cond+  countAll fakeV = runDb' $ H.countAll renderConfig queryRawCached' fakeV+  project p options = runDb' $ H.project renderConfig queryRawCached' preColumns "LIMIT -1" p options+  projectStream p options = runDb' $ H.projectStream renderConfig queryRawCached' preColumns "LIMIT -1" p options+  migrate fakeV = mapStateT runDb' $ migrate' fakeV -  executeRaw False query ps = executeRaw' (fromString query) ps-  executeRaw True query ps = executeRawCached' (fromString query) ps-  queryRaw False query ps f = queryRaw' (fromString query) ps f-  queryRaw True query ps f = queryRawCached' (fromString query) ps f+  executeRaw False query ps = runDb' $ executeRaw' (fromString query) ps+  executeRaw True query ps = runDb' $ executeRawCached' (fromString query) ps+  queryRaw False query ps = runDb' $ queryRaw' (fromString query) ps+  queryRaw True query ps = runDb' $ queryRawCached' (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 Sqlite m) where+instance SchemaAnalyzer Sqlite where   schemaExists = fail "schemaExists: is not supported by Sqlite"   getCurrentSchema = return Nothing-  listTables Nothing = queryRaw' "SELECT name FROM sqlite_master WHERE type='table'" [] (mapAllRows $ return . fst . fromPurePersistValues proxy)+  listTables Nothing = runDb' $ queryRaw' "SELECT name FROM sqlite_master WHERE type='table'" [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList   listTables sch = fail $ "listTables: schemas are not supported by Sqlite: " ++ show sch-  listTableTriggers (Nothing, name) = queryRaw' "SELECT name FROM sqlite_master WHERE type='trigger' AND tbl_name=?" [toPrimitivePersistValue proxy name] (mapAllRows $ return . fst . fromPurePersistValues proxy)+  listTableTriggers (Nothing, name) = runDb' $ queryRaw' "SELECT name FROM sqlite_master WHERE type='trigger' AND tbl_name=?" [toPrimitivePersistValue name] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList   listTableTriggers (sch, _) = fail $ "listTableTriggers: schemas are not supported by Sqlite: " ++ show sch-  analyzeTable = analyzeTable'-  analyzeTrigger (Nothing, name) = do-    x <- queryRaw' "SELECT sql FROM sqlite_master WHERE type='trigger' AND name=?" [toPrimitivePersistValue proxy name] id+  analyzeTable = runDb' . analyzeTable'+  analyzeTrigger (Nothing, name) = runDb' $ do+    x <- queryRaw' "SELECT sql FROM sqlite_master WHERE type='trigger' AND name=?" [toPrimitivePersistValue name] >>= firstRow     case x of       Nothing  -> return Nothing-      Just src -> return (fst $ fromPurePersistValues proxy src)+      Just src -> return (fst $ fromPurePersistValues src)   analyzeTrigger (sch, _) = fail $ "analyzeTrigger: schemas are not supported by Sqlite: " ++ show sch   analyzeFunction = error "analyzeFunction: is not supported by Sqlite"   getMigrationPack = return migrationPack@@ -131,19 +133,18 @@     liftIO $ S.exec c $ "RELEASE " <> name'     return x -instance ConnectionManager Sqlite Sqlite where+instance ConnectionManager Sqlite where   withConn f conn@(Sqlite c _) = do     liftIO $ S.exec c "BEGIN"     x <- onException (f conn) (liftIO $ S.exec c "ROLLBACK")     liftIO $ S.exec c "COMMIT"     return x-  withConnNoTransaction f conn = f conn -instance ConnectionManager (Pool Sqlite) Sqlite where-  withConn f pconn = withResource pconn (withConn f)-  withConnNoTransaction f pconn = withResource pconn (withConnNoTransaction f)+instance ExtractConnection Sqlite Sqlite where+  extractConn f conn = f conn -instance SingleConnectionManager Sqlite Sqlite+instance ExtractConnection (Pool Sqlite) Sqlite where+  extractConn f pconn = withResource pconn f  open' :: String -> IO Sqlite open' s = do@@ -157,10 +158,10 @@   readIORef smap >>= mapM_ S.finalize . Map.elems   S.close conn -migrate' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> Migration (DbPersist Sqlite m)+migrate' :: PersistEntity v => v -> Migration (Action Sqlite) migrate' = migrateRecursively (const $ return $ Right []) (migrateEntity migrationPack) (migrateList migrationPack) -migrationPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => GM.MigrationPack (DbPersist Sqlite m)+migrationPack :: GM.MigrationPack Sqlite migrationPack = GM.MigrationPack   compareTypes   compareRefs@@ -168,7 +169,7 @@   compareDefaults   migTriggerOnDelete   migTriggerOnUpdate-  GM.defaultMigConstr+  (GM.defaultMigConstr migrationPack)   escape   "INTEGER PRIMARY KEY NOT NULL"   mainTableId@@ -184,7 +185,7 @@ addUniquesReferences uniques refs = (map sqlUnique constraints ++ map sqlReference refs, map AddUnique indexes) where   (constraints, indexes) = partition ((/= UniqueIndex) . uniqueDefType) uniques -migTriggerOnDelete :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> [(String, String)] -> DbPersist Sqlite m (Bool, [AlterDB])+migTriggerOnDelete :: QualifiedName -> [(String, String)] -> Action Sqlite (Bool, [AlterDB]) migTriggerOnDelete qualifiedName deletes = do   let addTrigger = AddTriggerOnDelete qualifiedName qualifiedName (concatMap snd deletes)   x <- analyzeTrigger qualifiedName@@ -200,7 +201,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 Sqlite m [(Bool, [AlterDB])]+migTriggerOnUpdate :: QualifiedName -> [(String, String)] -> Action Sqlite [(Bool, [AlterDB])] migTriggerOnUpdate name dels = forM dels $ \(fieldName, del) -> do   let trigName = (Nothing, snd name ++ delim : fieldName)   let addTrigger = AddTriggerOnUpdate trigName name (Just fieldName) del@@ -211,10 +212,10 @@         then []         else [DropTrigger trigName name, addTrigger]) -analyzeTable' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> DbPersist Sqlite m (Maybe TableInfo)+analyzeTable' :: QualifiedName -> Action Sqlite (Maybe TableInfo) analyzeTable' (Nothing, tName) = do   let fromName = escapeS . fromString-  tableInfo <- queryRaw' ("pragma table_info(" <> fromName tName <> ")") [] $ mapAllRows (return . fst . fromPurePersistValues proxy)+  tableInfo <- queryRaw' ("pragma table_info(" <> fromName tName <> ")") [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList   case tableInfo of     [] -> return Nothing     rawColumns -> do@@ -222,17 +223,17 @@           mkColumn (_, (name, typ, isNotNull, defaultValue, _)) = Column name (isNotNull == 0) (readSqlType typ) defaultValue           primaryKeyColumnNames = foldr (\(_ , (name, _, _, _, primaryIndex)) xs -> if primaryIndex > 0 then name:xs else xs) [] rawColumns           columns = map mkColumn rawColumns-      indexList <- queryRaw' ("pragma index_list(" <> fromName tName <> ")") [] $ mapAllRows (return . fst . fromPurePersistValues proxy)+      indexList <- queryRaw' ("pragma index_list(" <> fromName tName <> ")") [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList       let uniqueNames = map (\(_ :: Int, name, _) -> name) $ filter (\(_, _, isUnique) -> isUnique) indexList       uniques <- forM uniqueNames $ \name -> do-        uFields <- queryRaw' ("pragma index_info(" <> fromName name <> ")") [] $ mapAllRows (return . fst . fromPurePersistValues proxy)-        sql <- queryRaw' ("select sql from sqlite_master where type = 'index' and name = ?") [toPrimitivePersistValue proxy name] id+        uFields <- queryRaw' ("pragma index_info(" <> fromName name <> ")") [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList+        sql <- queryRaw' ("select sql from sqlite_master where type = 'index' and name = ?") [toPrimitivePersistValue name] >>= firstRow         let columnNames = map (\(_, _, columnName) -> columnName) (uFields :: [(Int, Int, String)])             uType = if sql == Just [PersistNull]               then if sort columnNames == sort primaryKeyColumnNames then UniquePrimary False else UniqueConstraint               else UniqueIndex         return $ UniqueDef (Just name) uType (map Left columnNames)-      foreignKeyList <- queryRaw' ("pragma foreign_key_list(" <> fromName tName <> ")") [] $ mapAllRows (return . fst . fromPurePersistValues proxy)+      foreignKeyList <- queryRaw' ("pragma foreign_key_list(" <> fromName tName <> ")") [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList       (foreigns :: [(Maybe String, Reference)]) <- do           let foreigns :: [[(Int, (Int, String, (String, Maybe String), (String, String, String)))]]               foreigns = groupBy ((==) `on` fst) . sort $ foreignKeyList -- sort by foreign key number and column number inside key (first and second integers)@@ -257,18 +258,18 @@       return $ Just $ TableInfo columns uniques' foreigns analyzeTable' (sch, _) = fail $ "analyzeTable: schemas are not supported by Sqlite: " ++ show sch -analyzePrimaryKey :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => String -> DbPersist Sqlite m (Maybe [String])+analyzePrimaryKey :: String -> Action Sqlite (Maybe [String]) analyzePrimaryKey tName = do-  tableInfo <- queryRaw' ("pragma table_info(" <> escapeS (fromString tName) <> ")") [] $ mapAllRows (return . fst . fromPurePersistValues proxy)+  tableInfo <- queryRaw' ("pragma table_info(" <> escapeS (fromString tName) <> ")") [] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList   let cols = map (\(_ , (name, _, _, _, primaryIndex)) -> (primaryIndex, name)) (tableInfo ::  [(Int, (String, String, Int, Maybe String, Int))])       cols' = map snd $ sort $ filter ((> 0) . fst) cols   return $ if null cols'     then Nothing     else Just cols' -getStatementCached :: (MonadBaseControl IO m, MonadIO m) => Utf8 -> DbPersist Sqlite m S.Statement+getStatementCached :: Utf8 -> Action Sqlite S.Statement getStatementCached sql = do-  Sqlite conn smap <- DbPersist ask+  Sqlite conn smap <- ask   liftIO $ do     smap' <- readIORef smap     let sql' = fromUtf8 sql@@ -279,9 +280,9 @@         return stmt       Just stmt -> return stmt -getStatement :: (MonadBaseControl IO m, MonadIO m) => Utf8 -> DbPersist Sqlite m S.Statement+getStatement :: Utf8 -> Action Sqlite S.Statement getStatement sql = do-  Sqlite conn _ <- DbPersist ask+  Sqlite conn _ <- ask   liftIO $ S.prepareUtf8 conn $ SD.Utf8 $ fromUtf8 sql  showSqlType :: DbTypePrimitive -> String@@ -351,12 +352,12 @@       UniqueConstraint -> "UNIQUE("       UniqueIndex -> error "sqlUnique: does not handle indexes" -insert' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist Sqlite m (AutoKey v)+insert' :: PersistEntity v => v -> Action Sqlite (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@@ -375,12 +376,12 @@       executeRawCached' cQuery (vals' [])       pureFromPersistValue [rowid] -insert_' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist Sqlite m ()+insert_' :: PersistEntity v => v -> Action Sqlite () 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@@ -407,7 +408,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 Sqlite m Int64+insertList' :: forall a . PersistField a => [a] -> Action Sqlite Int64 insertList' l = do   let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a))   executeRawCached' ("INSERT INTO " <> escapeS mainName <> " DEFAULT VALUES") []@@ -415,26 +416,26 @@   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 Sqlite m ()+  let go :: Int -> [a] -> Action Sqlite ()       go n (x:xs) = do        x' <- toPersistValues x-       executeRawCached' query $ (k:) . (toPrimitivePersistValue proxy n:) . x' $ []+       executeRawCached' 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 Sqlite m [a]+getList' :: forall a . PersistField a => Int64 -> Action Sqlite [a] getList' k = do   let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a))       valuesName = mainName <> delim' <> "values"       value = ("value", dbType proxy (undefined :: a))       query = "SELECT " <> renderFields escapeS [value] <> " FROM " <> escapeS valuesName <> " WHERE id=? ORDER BY ord"-  queryRawCached' query [toPrimitivePersistValue proxy k] $ mapAllRows (liftM fst . fromPersistValues)+  queryRawCached' query [toPrimitivePersistValue k] >>= mapStream (liftM fst . fromPersistValues) >>= streamToList     -getLastInsertRowId :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => DbPersist Sqlite m PersistValue+getLastInsertRowId :: Action Sqlite PersistValue getLastInsertRowId = do-  Sqlite conn _ <- DbPersist ask+  Sqlite conn _ <- ask   liftIO (SD.lastInsertRowId conn) >>= toSinglePersistValue  ----------@@ -445,6 +446,7 @@   go i (x:xs) = do     case x of       PersistInt64 int64      -> S.bindInt64 stmt i int64+      PersistText text        -> S.bindText stmt i $ text       PersistString text      -> S.bindText stmt i $ T.pack text       PersistDouble double    -> S.bindDouble stmt i double       PersistBool b           -> S.bindInt64 stmt i $ if b then 1 else 0@@ -457,52 +459,47 @@       PersistCustom _ _       -> error "bind: unexpected PersistCustom"     go (i + 1) xs -executeRaw' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> DbPersist Sqlite m ()+executeRaw' :: Utf8 -> [PersistValue] -> Action Sqlite () executeRaw' query vals = do-  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals+--  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals   stmt <- getStatement query   liftIO $ flip finally (S.finalize stmt) $ do     bind stmt vals     S.Done <- S.step stmt     return () -executeRawCached' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> DbPersist Sqlite m ()+executeRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite () executeRawCached' query vals = do-  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals+--  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals   stmt <- getStatementCached query   liftIO $ flip finally (S.reset stmt) $ do     bind stmt vals     S.Done <- S.step stmt     return () -queryRaw' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> (RowPopper (DbPersist Sqlite m) -> DbPersist Sqlite m a) -> DbPersist Sqlite m a-queryRaw' query vals f = do-  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals-  stmt <- getStatement query-  flip finally (liftIO $ S.finalize stmt) $ do-    liftIO $ bind stmt vals-    f $ liftIO $ do-      x <- S.step stmt-      case x of-        S.Done -> return Nothing-        S.Row  -> fmap (Just . map pFromSql) $ S.columns stmt+runQuery :: (Utf8 -> Action Sqlite S.Statement) -> (S.Statement -> IO ()) -> Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])+runQuery getStmt close query vals = do+  --  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals+  conn <- ask+  let open = do+        stmt <- runReaderT (getStmt query) conn+        bind stmt vals+        return stmt+      mkNext stmt = do+        x <- S.step stmt+        case x of+          S.Done -> return Nothing+          S.Row  -> fmap (Just . map pFromSql) $ S.columns stmt+  return $ fmap mkNext $ mkAcquire open close -queryRawCached' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> (RowPopper (DbPersist Sqlite m) -> DbPersist Sqlite m a) -> DbPersist Sqlite m a-queryRawCached' query vals f = do-  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals-  stmt <- getStatementCached query-  flip finally (liftIO $ S.reset stmt) $ do-    liftIO $ bind stmt vals-    f $ liftIO $ do-      x <- S.step stmt-      case x of-        S.Done -> return Nothing-        S.Row  -> fmap (Just . map pFromSql) $ S.columns stmt+queryRaw', queryRawCached' :: Utf8 -> [PersistValue] -> Action Sqlite (RowStream [PersistValue])+queryRaw' = runQuery getStatement S.finalize+queryRawCached' = runQuery getStatementCached S.reset  pFromSql :: S.SQLData -> PersistValue pFromSql (S.SQLInteger i) = PersistInt64 i pFromSql (S.SQLFloat i)   = PersistDouble i-pFromSql (S.SQLText s)    = PersistString (T.unpack s)+pFromSql (S.SQLText s)    = PersistText s pFromSql (S.SQLBlob bs)   = PersistByteString bs pFromSql (S.SQLNull)      = PersistNull @@ -528,7 +525,7 @@ delim' :: Utf8 delim' = fromChar delim -toEntityPersistValues' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistEntity v) => v -> DbPersist Sqlite m [PersistValue]+toEntityPersistValues' :: PersistEntity v => v -> Action Sqlite [PersistValue] toEntityPersistValues' = liftM ($ []) . toEntityPersistValues  compareUniqs :: UniqueDefInfo -> UniqueDefInfo -> Bool
changelog view
@@ -1,3 +1,6 @@+0.8+* Support for GHC 8+ 0.7.0.1 * Support for monad-control 1.0 
groundhog-sqlite.cabal view
@@ -1,5 +1,5 @@ name:            groundhog-sqlite-version:         0.7.0.1+version:         0.8 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -18,14 +18,14 @@     build-depends:   base                     >= 4         && < 5                    , bytestring               >= 0.9                    , transformers             >= 0.2.1-                   , groundhog                >= 0.7       && < 0.8+                   , groundhog                >= 0.8       && < 0.9                    , monad-control            >= 0.3       && < 1.1-                   , monad-logger             >= 0.3       && < 0.4                    , containers               >= 0.2                    , text                     >= 0.8                    , direct-sqlite            >= 2.3.5                    , resource-pool            >= 0.2.1                    , unordered-containers+                   , resourcet                >= 1.1.2     exposed-modules: Database.Groundhog.Sqlite     ghc-options:     -Wall -fno-warn-unused-do-bind