tonatona-persistent-sqlite (empty) → 0.1.0.0

raw patch · 7 files changed

+269/−0 lines, 7 filesdep +Globdep +basedep +doctestsetup-changed

Dependencies added: Glob, base, doctest, monad-logger, persistent, persistent-sqlite, resource-pool, rio, tonaparser, tonatona

Files

• LICENSE +21/−0
• README.md +3/−0
• Setup.hs +2/−0
• src/Tonatona/Persist/Sqlite.hs +93/−0
• test/DocTest.hs +58/−0
• test/Spec.hs +8/−0
• tonatona-persistent-sqlite.cabal +84/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Kadzuya Okamoto https://arow.info++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,3 @@+# tonatona-db-sqlite++A plugin for `tonatona` that adds features to access a SQLite DB.

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

@@ -0,0 +1,93 @@+module Tonatona.Persist.Sqlite+  ( run+  , TonaDbM+  , Config(..)+  , DbConnStr(..)+  , DbConnNum(..)+  , runMigrate+  ) where++import RIO++import Control.Monad.Logger as Logger (Loc, LoggingT(..), LogLevel, LogSource, LogStr, runStdoutLoggingT)+import Data.Pool (Pool)+import Database.Persist.Sqlite (withSqlitePool, wrapConnection)+import Database.Persist.Sql (Migration, SqlBackend, runMigration, runSqlPool)+import Database.Sqlite (open)++import Tonatona (HasConfig(..), HasParser(..))+import TonaParser ((.||), argLong, envVar, liftWith, optionalVal)++type TonaDbM env+  = ReaderT SqlBackend (RIO env)++runMigrate :: (HasConfig env Config) => Migration -> RIO env ()+runMigrate migration = run $ runMigration migration++-- | Main function.+run :: (HasConfig env Config) => TonaDbM env a -> RIO env a+run query = do+  connType <- asks (sqliteConn . config)+  case connType of+    SqliteConn sqlBackend -> runReaderT query sqlBackend+    SqliteConnPool pool -> runSqlPool query pool++------------+-- Config --+------------++newtype DbConnStr = DbConnStr+  { unDbConnStr :: ByteString+  } deriving (Eq, IsString, Read, Show)++instance HasParser DbConnStr where+  parser = DbConnStr <$>+    optionalVal+      "Formatted string to connect postgreSQL"+      (argLong "db-conn-string" .|| envVar "DB_CONN_STRING")+      ":memory:"++newtype DbConnNum = DbConnNum { unDbConnNum :: Int }+  deriving (Eq, Num, Read, Show)++instance HasParser DbConnNum where+  parser = DbConnNum <$>+    optionalVal+      "Number of connections which connection pool uses"+      ( argLong "db-conn-num" .|| envVar "DB_CONN_NUM")+      10++data Config = Config+  { dbConnString :: DbConnStr+  , dbConnNum :: DbConnNum+  , sqliteConn :: SqliteConn+  }++instance HasParser Config where+  parser = do+    connStr <- parser+    connNum <- parser+    let textConnStr = decodeUtf8Lenient $ unDbConnStr connStr+    liftWith $ \action -> do+      case connStr of+        ":memory:" -> do+          conn <- open ":memory:"+          backend <- wrapConnection conn stdoutLogger+          action $+            Config connStr connNum (SqliteConn backend)+        _ ->+          runLoggingT+            (withSqlitePool+               textConnStr+               (unDbConnNum connNum)+               (lift . action . Config connStr connNum . SqliteConnPool))+            stdoutLogger++data SqliteConn+  = SqliteConn SqlBackend+  | SqliteConnPool (Pool SqlBackend)++stdoutLogger :: Loc -> Logger.LogSource -> Logger.LogLevel -> LogStr -> IO ()+stdoutLogger loc source level msg = do+  func <- runStdoutLoggingT $ LoggingT pure+  func loc source level msg

@@ -0,0 +1,58 @@+module Main (main) where++import RIO++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "src/**/*.hs" >>= doDocTest++doDocTest :: [String] -> IO ()+doDocTest options =+  doctest $+    options <>+    ghcExtensions++ghcExtensions :: [String]+ghcExtensions =+    [ "-XAutoDeriveTypeable"+    , "-XBangPatterns"+    , "-XBinaryLiterals"+    , "-XConstraintKinds"+    , "-XDataKinds"+    , "-XDefaultSignatures"+    , "-XDeriveDataTypeable"+    , "-XDeriveFoldable"+    , "-XDeriveFunctor"+    , "-XDeriveGeneric"+    , "-XDeriveTraversable"+    , "-XDoAndIfThenElse"+    , "-XEmptyDataDecls"+    , "-XExistentialQuantification"+    , "-XFlexibleContexts"+    , "-XFlexibleInstances"+    , "-XFunctionalDependencies"+    , "-XGADTs"+    , "-XGeneralizedNewtypeDeriving"+    , "-XInstanceSigs"+    , "-XKindSignatures"+    , "-XLambdaCase"+    , "-XMonadFailDesugaring"+    , "-XMultiParamTypeClasses"+    , "-XMultiWayIf"+    , "-XNamedFieldPuns"+    , "-XNoImplicitPrelude"+    , "-XOverloadedStrings"+    , "-XPartialTypeSignatures"+    , "-XPatternGuards"+    , "-XPolyKinds"+    , "-XRankNTypes"+    , "-XRecordWildCards"+    , "-XScopedTypeVariables"+    , "-XStandaloneDeriving"+    , "-XTupleSections"+    , "-XTypeFamilies"+    , "-XTypeSynonymInstances"+    , "-XViewPatterns"+    ]

@@ -0,0 +1,8 @@+{-# LANGUAGE QuasiQuotes #-}++module Main where++import RIO++main :: IO ()+main = pure ()

@@ -0,0 +1,84 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 38e0396e6300339d6ada47a6a313cb9607fb4baf3b37562c7808bc9288675c1e++name:           tonatona-persistent-sqlite+version:        0.1.0.0+synopsis:       tonatona plugin for accessing Sqlite database.+description:    Tonatona plugin for accessing Sqlite database. This package provides a tonatona plugin for accessing Sqlite database. This plugin uses persistent to actually accessing Sqlite.+category:       Database, Library, Tonatona+homepage:       https://github.com/tonatona-project/tonatona#readme+bug-reports:    https://github.com/tonatona-project/tonatona/issues+author:         Kadzuya Okamoto, Dennis Gosnell+maintainer:     arow.okamoto+github@gmail.com+copyright:      2018 Kadzuya Okamoto+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/tonatona-project/tonatona++library+  exposed-modules:+      Tonatona.Persist.Sqlite+  other-modules:+      Paths_tonatona_persistent_sqlite+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , rio >=0.1+    , tonaparser >=0.1+    , tonatona >=0.1+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: DocTest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      Glob+    , base >=4.7 && <5+    , doctest+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , rio >=0.1+    , tonaparser >=0.1+    , tonatona >=0.1+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving Strict StrictData TupleSections TypeFamilies TypeSynonymInstances ViewPatterns+  ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , monad-logger >=0.3+    , persistent >=2.8+    , persistent-sqlite >=2.8+    , resource-pool >=0.2+    , rio >=0.1+    , tonaparser >=0.1+    , tonatona+  default-language: Haskell2010