postgresql-tx (empty) → 0.1.0.0
raw patch · 7 files changed
+173/−0 lines, 7 filesdep +basedep +transformerssetup-changed
Dependencies added: base, transformers
Files
- CHANGELOG.md +5/−0
- LICENSE.md +30/−0
- README.md +3/−0
- Setup.hs +2/−0
- package.yaml +27/−0
- postgresql-tx.cabal +43/−0
- src/Database/PostgreSQL/Tx.hs +63/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Change log++## 0.1.0.0++Initial release
+ LICENSE.md view
@@ -0,0 +1,30 @@+Copyright SimSpace (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of SimSpace nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# postgresql-tx++[](http://travis-ci.org/Simspace/postgresql-tx)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ package.yaml view
@@ -0,0 +1,27 @@+name: postgresql-tx+version: 0.1.0.0+github: "simspace/postgresql-tx"+license: BSD3+license-file: LICENSE.md+author: "Cary Robbins"+maintainer: "carymrobbins@gmail.com"+copyright: "2020 SimSpace"+synopsis: A safe transaction monad for use with various PostgreSQL Haskell libraries.+category: Database+description: Please see the README on GitHub at <https://github.com/simspace/postgresql-tx#readme>++extra-source-files:+- CHANGELOG.md+- LICENSE.md+- package.yaml+- README.md++ghc-options:+ - -Wall++dependencies:+- base >= 4.7 && < 5+- transformers >= 0.5.6.2 && < 0.6++library:+ source-dirs: src
+ postgresql-tx.cabal view
@@ -0,0 +1,43 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: e101ce5ab3c06e184533b8848069104aed53c8b9449a654bac5cb7d9ca3adced++name: postgresql-tx+version: 0.1.0.0+synopsis: A safe transaction monad for use with various PostgreSQL Haskell libraries.+description: Please see the README on GitHub at <https://github.com/simspace/postgresql-tx#readme>+category: Database+homepage: https://github.com/simspace/postgresql-tx#readme+bug-reports: https://github.com/simspace/postgresql-tx/issues+author: Cary Robbins+maintainer: carymrobbins@gmail.com+copyright: 2020 SimSpace+license: BSD3+license-file: LICENSE.md+build-type: Simple+extra-source-files:+ CHANGELOG.md+ LICENSE.md+ package.yaml+ README.md++source-repository head+ type: git+ location: https://github.com/simspace/postgresql-tx++library+ exposed-modules:+ Database.PostgreSQL.Tx+ other-modules:+ Paths_postgresql_tx+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5+ , transformers >=0.5.6.2 && <0.6+ default-language: Haskell2010
+ src/Database/PostgreSQL/Tx.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+module Database.PostgreSQL.Tx+ ( TxM(unsafeRunTxM)+ , unsafeRunIOInTxM+ , Tx(TxEnv, tx)+ , UnsafeTx(unsafeIOTx)+ , unsafeReaderIOTx+ ) where++import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Reader (ReaderT(ReaderT, runReaderT), mapReaderT)+import GHC.TypeLits (ErrorMessage(Text), TypeError)++newtype TxM a = UnsafeTxM { unsafeRunTxM :: IO a }+ deriving newtype (Functor, Applicative, Monad)++instance+ ( TypeError+ ('Text "MonadIO is banned in TxM; use 'unsafeRunIOInTxM' if you are sure this is safe IO")+ ) => MonadIO TxM+ where+ liftIO = undefined++unsafeRunIOInTxM :: IO a -> TxM a+unsafeRunIOInTxM = UnsafeTxM++-- | Type class for converting an 'f' to 'TxM' given a 'TxEnv'.+class Tx (f :: * -> *) where+ -- | The runtime environment needed to convert 'f' to 'TxM'.+ type TxEnv f :: *+ -- | Converts an 'f' to a 'TxM'.+ tx :: TxEnv f -> f a -> TxM a++instance Tx (ReaderT r TxM) where+ type TxEnv (ReaderT r TxM) = r+ tx = flip runReaderT++-- | Promote an unsafe 'io' action to a safe 't' transaction (will be some form of 'TxM').+class UnsafeTx (io :: * -> *) (t :: * -> *) | t -> io where+ -- | Converts an 'io' action to a 't', which will be some form of 'TxM'.+ unsafeIOTx :: io a -> t a++instance UnsafeTx IO TxM where+ unsafeIOTx = unsafeRunIOInTxM++instance (UnsafeTx io t) => UnsafeTx (ReaderT r io) (ReaderT r t) where+ unsafeIOTx = mapReaderT unsafeIOTx++-- | Promotes an unsafe 'io' function to some 'ReaderT' over 'TxM'.+unsafeReaderIOTx+ :: (UnsafeTx (ReaderT r io) (ReaderT r t))+ => (r -> io a) -> ReaderT r t a+unsafeReaderIOTx = unsafeIOTx . ReaderT