mysql-effect (empty) → 0.1.0.0
raw patch · 6 files changed
+239/−0 lines, 6 filesdep +basedep +bytestringdep +extensible-effectssetup-changed
Dependencies added: base, bytestring, extensible-effects, mysql-simple
Files
- Changelog.md +6/−0
- LICENSE +21/−0
- Setup.hs +2/−0
- mysql-effect.cabal +28/−0
- src/Control/Eff/MySQL.hs +150/−0
- src/Control/Eff/MySQL/Helper.hs +32/−0
+ Changelog.md view
@@ -0,0 +1,6 @@+# Changelog++## Version 0.1++Introduces all the `mysql-simple`-API except the various `fold`s.+The `bracket`-like `runMySQL` does not yet catch Exceptions.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2014 Tobias Florek (me@ibotty.net)++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mysql-effect.cabal view
@@ -0,0 +1,28 @@+-- Initial mysql-effect.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: mysql-effect+version: 0.1.0.0+synopsis: An extensible mysql effect using extensible-effects and mysql-simple+description: Any help (especially documentation) is very welcome,+homepage: https://github.com/ibotty/mysql-effect+license: MIT+license-file: LICENSE+author: Tobias Florek+maintainer: tob@butter.sh+-- copyright: +category: Database, Effect+build-type: Simple+extra-source-files: Changelog.md+cabal-version: >=1.10++library+ exposed-modules: Control.Eff.MySQL+ other-modules: Control.Eff.MySQL.Helper+ -- other-extensions: + build-depends: base >=4.6 && <4.7+ , bytestring + , extensible-effects >=1.2 && <1.3+ , mysql-simple >=0.2 && <0.3+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Control/Eff/MySQL.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE StandaloneDeriving #-}+-- | A thin MySQL effect.+--+-- See the documentation of 'mysql-simple' for details regarding the+-- various functions.+module Control.Eff.MySQL+ ( query+ , query_+ -- , fold+ -- , fold_+ -- , forEach+ -- , forEach_+ , execute+ , execute_+ , executeMany+ , insertID+ -- , withTransaction+ , autocommit+ , commit+ , rollback+ , formatMany+ , formatQuery+ , runMySQL+ , runMySQLWithConnection+ -- | reexports from mysql-simple+ , M.ConnectInfo(..)+ , M.In(..)+ , M.Only(..)+ , M.Query+ , M.QueryParams(..)+ , M.QueryResults(..)+ , M.defaultConnectInfo+ ,+ ) where++import Control.Eff+import Control.Eff.Lift+import Control.Eff.MySQL.Helper+import Control.Eff.Reader.Strict+import Data.ByteString (ByteString)+import Data.Int (Int64)+import Data.Typeable (Typeable)+import Data.Word (Word64)+import qualified Database.MySQL.Simple as M+import qualified Database.MySQL.Simple.QueryParams as M+import qualified Database.MySQL.Simple.QueryResults as M+++type MySQL = Reader M.Connection++deriving instance Typeable M.Connection++-- | Run the MySQL effect. In case of exceptions it will not close the+-- connection. (That will still be done by the GC at one point.)+runMySQL+ :: (SetMember Lift (Lift IO) r)+ => Eff (MySQL :> r) a -> M.ConnectInfo -> Eff r a+runMySQL e c = do+ conn <- lift $ M.connect c+ let res = runMySQLWithConnection e conn+ lift $ M.close conn+ res++-- | Run the MySQL effect with a given 'M.Connection'.+runMySQLWithConnection :: Eff (MySQL :> r) a -> M.Connection -> Eff r a+runMySQLWithConnection = runReader++-- | See 'M.query' for details.+query+ :: ( SetMember Lift (Lift IO) r, Member MySQL r+ , M.QueryResults a, M.QueryParams p)+ => M.Query -> p -> Eff r [a]+query = askLift2 M.query++-- | See 'M.query_' for details.+query_+ :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryResults a)+ => M.Query -> Eff r [a]+query_ = askLift M.query_++-- -- | See 'M.fold' for details.+-- fold+-- :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryResults b, M.QueryParams p)+-- => M.Query -> p -> a -> (a -> b -> Eff r a) -> Eff r [a]+-- -- | See 'M.fold_' for details.+-- fold_+-- :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryResults b)+-- => M.Query -> q -> a -> (a -> b -> Eff r a) -> Eff r [a]+-- -- | See 'M.forEach' for details.+-- forEach+-- :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryResults b, M.QueryParams p)+-- => M.Query -> p -> (b -> Eff r ()) -> Eff r ()+-- -- | See 'M.forEach_' for details.+-- forEach_+-- :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryResults b)+-- => M.Query -> (b -> Eff r ()) -> Eff r ()++-- | See 'M.execute' for details.+execute+ :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryParams p)+ => M.Query -> p -> Eff r Int64+execute = askLift2 M.execute++-- | See 'M.execute_' for details.+execute_+ :: (SetMember Lift (Lift IO) r, Member MySQL r)+ => M.Query -> Eff r Int64+execute_ = askLift M.execute_++-- | See 'M.executeMany' for details.+executeMany+ :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryParams p)+ => M.Query -> [p] -> Eff r Int64+executeMany = askLift2 M.executeMany++-- | See 'M.insertID ' for details.+insertID :: (SetMember Lift (Lift IO) r, Member MySQL r) => Eff r Word64+insertID = askLift0 M.insertID++-- -- | See 'M.withTransaction' for details.+-- withTransaction+-- :: (SetMember Lift (Lift IO) r, Member MySQL r)+-- => Eff r a -> Eff r a++-- | See 'M.autocommit ' for details.+autocommit :: (SetMember Lift (Lift IO ) r, Member MySQL r) => Bool -> Eff r ()+autocommit = askLift M.autocommit++-- | See 'M.commit ' for details.+commit :: (SetMember Lift (Lift IO ) r, Member MySQL r) => Eff r ()+commit = askLift0 M.commit++-- | See 'M.rollback ' for details.+rollback :: (SetMember Lift (Lift IO ) r, Member MySQL r) => Eff r ()+rollback = askLift0 M.rollback++-- | See 'M.formatMany' for details.+formatMany+ :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryParams p)+ => M.Query -> [p] -> Eff r ByteString+formatMany = askLift2 M.formatMany++-- | See 'M.formatQuery' for details.+formatQuery+ :: (SetMember Lift (Lift IO) r, Member MySQL r, M.QueryParams p)+ => M.Query -> p -> Eff r ByteString+formatQuery = askLift2 M.formatQuery
+ src/Control/Eff/MySQL/Helper.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleContexts #-}+module Control.Eff.MySQL.Helper+ ( askLift0+ , askLift+ , askLift2+ , askLift3+ ) where++import Control.Eff+import Control.Eff.Lift+import Control.Eff.Reader.Strict+import Data.Typeable (Typeable, Typeable1)++askLift0+ :: (Typeable a, Typeable1 m, SetMember Lift (Lift m) r, Member (Reader a) r)+ => (a -> m b) -> Eff r b+askLift0 f = ask >>= lift . f++askLift+ :: (Typeable a, Typeable1 m, SetMember Lift (Lift m) r, Member (Reader a) r)+ => (a -> t -> m b) -> t -> Eff r b+askLift f a = ask >>= \x -> lift (f x a)++askLift2+ :: (Typeable a, Typeable1 m, SetMember Lift (Lift m) r, Member (Reader a) r)+ => (a -> t -> t1 -> m b) -> t -> t1 -> Eff r b+askLift2 f a b = ask >>= \x -> lift (f x a b)++askLift3+ :: (Typeable a, Typeable1 m, SetMember Lift (Lift m) r, Member (Reader a) r)+ => (a -> t -> t1 -> t2 -> m b) -> t -> t1 -> t2 -> Eff r b+askLift3 f a b c = ask >>= \x -> lift (f x a b c)