groundhog-sqlite 0.4.1 → 0.4.2

raw patch · 2 files changed

+30/−36 lines, 2 filesdep ~groundhog

Dependency ranges changed: groundhog

Files

• Database/Groundhog/Sqlite.hs +28/−34
• groundhog-sqlite.cabal +2/−2

@@ -11,6 +11,7 @@  import Database.Groundhog import Database.Groundhog.Core+import Database.Groundhog.Expression import Database.Groundhog.Generic import Database.Groundhog.Generic.Migration hiding (MigrationPack(..)) import qualified Database.Groundhog.Generic.Migration as GM@@ -47,28 +48,34 @@   backendName _ = "sqlite"  instance SqlDb Sqlite where-  append a b = Expr $ operator 50 "||" a b+  append a b = mkExpr $ operator 50 "||" a b+  signum' x = mkExpr $ Snippet $ \esc _ -> let+       x' = renderExpr esc (toExpr x)+    in ["case when (" <> x' <> ") > 0 then 1 when (" <> x' <> ") < 0 then -1 else 0 end"]+  quotRem' x y = (mkExpr $ operator 70 "/" x y, mkExpr $ operator 70 "%" x y)+  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 escapeS queryRawTyped True u v-  insertByAll v = H.insertByAll escapeS queryRawTyped True v-  replace k v = H.replace escapeS queryRawTyped executeRawCached' insertIntoConstructorTable k v-  replaceBy k v = H.replaceBy escapeS executeRawCached' k v-  select options = H.select escapeS queryRawTyped "LIMIT -1" renderCond' options -- select' options-  selectAll = H.selectAll escapeS queryRawTyped-  get k = H.get escapeS queryRawTyped k-  getBy k = H.getBy escapeS queryRawTyped k-  update upds cond = H.update escapeS executeRawCached' renderCond' upds cond-  delete cond = H.delete escapeS executeRawCached' renderCond' cond-  deleteBy k = H.deleteBy escapeS executeRawCached' k-  deleteAll v = H.deleteAll escapeS executeRawCached' v-  count cond = H.count escapeS queryRawTyped renderCond' cond-  countAll fakeV = H.countAll escapeS queryRawTyped fakeV-  project p options = H.project escapeS queryRawTyped "LIMIT -1" renderCond' p options+  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' "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' "LIMIT -1" p options   migrate fakeV = migrate' fakeV    executeRaw False query ps = executeRaw' (fromString query) ps@@ -408,7 +415,7 @@   let valuesName = mainName <> delim' <> "values"   let value = ("value", dbType (undefined :: a))   let query = "SELECT " <> renderFields escapeS [value] <> " FROM " <> escapeS valuesName <> " WHERE id=? ORDER BY ord"-  queryRawTyped query (getDbTypes (dbType (undefined :: a)) []) [toPrimitivePersistValue proxy k] $ mapAllRows (liftM fst . fromPersistValues)+  queryRawCached' query [toPrimitivePersistValue proxy k] $ mapAllRows (liftM fst . fromPersistValues)      getLastInsertRowId :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => DbPersist Sqlite m PersistValue getLastInsertRowId = do@@ -477,19 +484,6 @@         S.Done -> return Nothing         S.Row  -> fmap (Just . map pFromSql) $ S.columns stmt -queryRawTyped :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [DbType] -> [PersistValue] -> (RowPopper (DbPersist Sqlite m) -> DbPersist Sqlite m a) -> DbPersist Sqlite m a-queryRawTyped query types vals f = do-  $logDebugS "SQL" $ T.pack $ show (fromUtf8 query) ++ " " ++ show vals-  stmt <- getStatementCached query-  let types' = map typeToSqlite $ foldr getDbTypes [] types-  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.typedColumns stmt types'- typeToSqlite :: DbType -> Maybe S.ColumnType typeToSqlite (DbTypePrimitive t nullable _ _) = case t of   _ | nullable -> Nothing@@ -527,10 +521,10 @@ escapeS :: Utf8 -> Utf8 escapeS a = let q = fromChar '"' in q <> a <> q -renderCond' :: Cond Sqlite r -> Maybe (RenderS Sqlite r)-renderCond' = renderCond escapeS renderEquals renderNotEquals where-  renderEquals a b = a <> " IS " <> b-  renderNotEquals a b = a <> " IS NOT " <> b+renderConfig :: RenderConfig+renderConfig = RenderConfig {+    esc = escapeS+}  defaultPriority, triggerPriority :: Int defaultPriority = 0

@@ -1,5 +1,5 @@ name:            groundhog-sqlite-version:         0.4.1+version:         0.4.2 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -15,7 +15,7 @@     build-depends:   base                    >= 4         && < 5                    , bytestring              >= 0.9                    , transformers            >= 0.2.1-                   , groundhog               >= 0.4.1     && < 0.5.0+                   , groundhog               >= 0.4.2     && < 0.5.0                    , monad-control           >= 0.3                    , monad-logger            >= 0.3                    , containers              >= 0.2