selda-sqlite (empty) → 0.1.0.0

raw patch · 4 files changed

+131/−0 lines, 4 filesdep +basedep +direct-sqlitedep +exceptionssetup-changed

Dependencies added: base, direct-sqlite, exceptions, selda, text

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• selda-sqlite.cabal +37/−0
• src/Database/Selda/SQLite.hs +72/−0

@@ -0,0 +1,20 @@+Copyright (c) 2017 Anton Ekblad++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,37 @@+name:                selda-sqlite+version:             0.1.0.0+synopsis:            SQLite backend for the Selda database EDSL.+description:         SQLite backend for the Selda database EDSL.+homepage:            https://github.com/valderman/selda+license:             MIT+license-file:        LICENSE+author:              Anton Ekblad+maintainer:          anton@ekblad.cc+category:            Database+build-type:          Simple+cabal-version:       >=1.10++flag haste+  default: False+  description: Package is being installed for Haste.++library+  exposed-modules:+    Database.Selda.SQLite+  other-extensions:+    GADTs+    CPP+  build-depends:+      base          >=4.8 && <5+    , exceptions    >=0.8 && <0.9+    , selda         >=0.1 && <0.2+    , text          >=1.0 && <1.3+  if !flag(haste)+    build-depends:+      direct-sqlite >=2.2 && <2.4+  hs-source-dirs:+    src+  default-language:+    Haskell2010+  ghc-options:+    -Wall

@@ -0,0 +1,72 @@+{-# LANGUAGE GADTs, CPP #-}+-- | SQLite3 backend for Selda.+module Database.Selda.SQLite (withSQLite) where+import Database.Selda+import Database.Selda.Backend+import Data.Text (pack)+import Control.Monad.Catch+import Control.Concurrent+#ifndef __HASTE__+import Database.SQLite3+#endif++-- | Perform the given computation over an SQLite database.+--   The database is guaranteed to be closed when the computation terminates.+withSQLite :: (MonadIO m, MonadMask m) => FilePath -> SeldaT m a -> m a+#ifdef __HASTE__+withSQLite _ _ = return $ error "withSQLite called in JS context"+#else+withSQLite file m = do+  lock <- liftIO $ newMVar ()+  db <- liftIO $ open (pack file)+  runSeldaT m (sqliteBackend lock db) `finally` liftIO (close db)++sqliteBackend :: MVar () -> Database -> SeldaBackend+sqliteBackend lock db = SeldaBackend+  { runStmt       = \q ps -> snd <$> sqliteQueryRunner lock db q ps+  , runStmtWithPK = \q ps -> fst <$> sqliteQueryRunner lock db q ps+  , customColType = \_ _ -> Nothing+  }++sqliteQueryRunner :: MVar () -> Database -> QueryRunner (Int, (Int, [[SqlValue]]))+sqliteQueryRunner lock db qry params = do+    stm <- prepare db qry+    takeMVar lock+    go stm `finally` do+      putMVar lock ()+      finalize stm+  where+    go stm = do+      bind stm [toSqlData p | Param p <- params]+      rows <- getRows stm []+      rid <- lastInsertRowId db+      cs <- changes db+      return (fromIntegral rid, (cs, [map fromSqlData r | r <- rows]))++    getRows s acc = do+      res <- step s+      case res of+        Row -> do+          cs <- columns s+          getRows s (cs : acc)+        _ -> do+          return $ reverse acc++toSqlData :: Lit a -> SQLData+toSqlData (LitI i)    = SQLInteger $ fromIntegral i+toSqlData (LitD d)    = SQLFloat d+toSqlData (LitS s)    = SQLText s+toSqlData (LitTS s)   = SQLText s+toSqlData (LitDate s) = SQLText s+toSqlData (LitTime s) = SQLText s+toSqlData (LitB b)    = SQLInteger $ if b then 1 else 0+toSqlData (LitNull)   = SQLNull+toSqlData (LitJust x) = toSqlData x++fromSqlData :: SQLData -> SqlValue+fromSqlData (SQLInteger i) = SqlInt $ fromIntegral i+fromSqlData (SQLFloat f)   = SqlFloat f+fromSqlData (SQLText s)    = SqlString s+fromSqlData (SQLBlob _)    = error "Selda doesn't support blobs"+fromSqlData SQLNull        = SqlNull+#endif