mysql-effect-0.1.0.0: An extensible mysql effect using extensible-effects and mysql-simple

Safe HaskellNone

Control.Eff.MySQL

Description

A thin MySQL effect.

See the documentation of 'mysql-simple' for details regarding the various functions.

Synopsis

Documentation

query :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryResults a, QueryParams p) => Query -> p -> Eff r [a]Source

See query for details.

query_ :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryResults a) => Query -> Eff r [a]Source

See query_ for details.

execute :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryParams p) => Query -> p -> Eff r Int64Source

See execute for details.

execute_ :: (SetMember Lift (Lift IO) r, Member MySQL r) => Query -> Eff r Int64Source

See execute_ for details.

executeMany :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryParams p) => Query -> [p] -> Eff r Int64Source

See executeMany for details.

insertID :: (SetMember Lift (Lift IO) r, Member MySQL r) => Eff r Word64Source

See 'M.insertID ' for details.

autocommit :: (SetMember Lift (Lift IO) r, Member MySQL r) => Bool -> Eff r ()Source

See 'M.autocommit ' for details.

commit :: (SetMember Lift (Lift IO) r, Member MySQL r) => Eff r ()Source

See 'M.commit ' for details.

rollback :: (SetMember Lift (Lift IO) r, Member MySQL r) => Eff r ()Source

See 'M.rollback ' for details.

formatMany :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryParams p) => Query -> [p] -> Eff r ByteStringSource

See formatMany for details.

formatQuery :: (SetMember Lift (Lift IO) r, Member MySQL r, QueryParams p) => Query -> p -> Eff r ByteStringSource

See formatQuery for details.

runMySQL :: SetMember Lift (Lift IO) r => Eff (MySQL :> r) a -> ConnectInfo -> Eff r aSource

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.)

runMySQLWithConnection :: Eff (MySQL :> r) a -> Connection -> Eff r aSource

Run the MySQL effect with a given Connection.

reexports from mysql-simple

newtype In a

Wrap a list of values for use in an IN clause. Replaces a single "?" character with a parenthesized list of rendered values.

Example:

 query c "select * from whatever where id in ?" (In [3,4,5])

Constructors

In a 

Instances

Functor In 
Typeable1 In 
Eq a => Eq (In a) 
Ord a => Ord (In a) 
Read a => Read (In a) 
Show a => Show (In a) 

newtype Only a

A single-value "collection".

This is useful if you need to supply a single parameter to a SQL query, or extract a single column from a SQL result.

Parameter example:

query c "select x from scores where x > ?" (Only (42::Int))

Result example:

xs <- query_ c "select id from users"
forM_ xs $ \(Only id) -> {- ... -}

Constructors

Only 

Fields

fromOnly :: a
 

Instances

Functor Only 
Typeable1 Only 
Eq a => Eq (Only a) 
Ord a => Ord (Only a) 
Read a => Read (Only a) 
Show a => Show (Only a) 
Param a => QueryParams (Only a) 
Result a => QueryResults (Only a) 

data Query

A query string. This type is intended to make it difficult to construct a SQL query by concatenating string fragments, as that is an extremely common way to accidentally introduce SQL injection vulnerabilities into an application.

This type is an instance of IsString, so the easiest way to construct a query is to enable the OverloadedStrings language extension and then simply write the query in double quotes.

 {-# LANGUAGE OverloadedStrings #-}

 import Database.MySQL.Simple

 q :: Query
 q = "select ?"

The underlying type is a ByteString, and literal Haskell strings that contain Unicode characters will be correctly transformed to UTF-8.

class QueryParams a where

A collection type that can be turned into a list of rendering Actions.

Instances should use the render method of the Param class to perform conversion of each element of the collection.

Methods

renderParams :: a -> [Action]

Render a collection of values.

Instances

QueryParams () 
Param a => QueryParams [a] 
Param a => QueryParams (Only a) 
(Param a, Param b) => QueryParams (a, b) 
(Param a, Param b, Param c) => QueryParams (a, b, c) 
(Param a, Param b, Param c, Param d) => QueryParams (a, b, c, d) 
(Param a, Param b, Param c, Param d, Param e) => QueryParams (a, b, c, d, e) 
(Param a, Param b, Param c, Param d, Param e, Param f) => QueryParams (a, b, c, d, e, f) 
(Param a, Param b, Param c, Param d, Param e, Param f, Param g) => QueryParams (a, b, c, d, e, f, g) 
(Param a, Param b, Param c, Param d, Param e, Param f, Param g, Param h) => QueryParams (a, b, c, d, e, f, g, h) 
(Param a, Param b, Param c, Param d, Param e, Param f, Param g, Param h, Param i) => QueryParams (a, b, c, d, e, f, g, h, i) 
(Param a, Param b, Param c, Param d, Param e, Param f, Param g, Param h, Param i, Param j) => QueryParams (a, b, c, d, e, f, g, h, i, j) 

class QueryResults a where

A collection type that can be converted from a list of strings.

Instances should use the convert method of the Result class to perform conversion of each element of the collection.

This example instance demonstrates how to convert a two-column row into a Haskell pair. Each field in the metadata is paired up with each value from the row, and the two are passed to convert.

 instance (Result a, Result b) => QueryResults (a,b) where
     convertResults [fa,fb] [va,vb] = (a,b)
         where !a = convert fa va
               !b = convert fb vb
     convertResults fs vs  = convertError fs vs 2

Notice that this instance evaluates each element to WHNF before constructing the pair. By doing this, we guarantee two important properties:

  • Keep resource usage under control by preventing the construction of potentially long-lived thunks.
  • Ensure that any ResultError that might arise is thrown immediately, rather than some place later in application code that cannot handle it.

You can also declare Haskell types of your own to be instances of QueryResults.

data User = User { firstName :: String, lastName :: String }

instance QueryResults User where
    convertResults [fa,fb] [va,vb] = User $ a * b
        where !a = convert fa va
              !b = convert fb vb
    convertResults fs vs  = convertError fs vs 2

Methods

convertResults :: [Field] -> [Maybe ByteString] -> a

Convert values from a row into a Haskell collection.

This function will throw a ResultError if conversion of the collection fails.

Instances

Result a => QueryResults (Only a) 
(Result a, Result b) => QueryResults (a, b) 
(Result a, Result b, Result c) => QueryResults (a, b, c) 
(Result a, Result b, Result c, Result d) => QueryResults (a, b, c, d) 
(Result a, Result b, Result c, Result d, Result e) => QueryResults (a, b, c, d, e) 
(Result a, Result b, Result c, Result d, Result e, Result f) => QueryResults (a, b, c, d, e, f) 
(Result a, Result b, Result c, Result d, Result e, Result f, Result g) => QueryResults (a, b, c, d, e, f, g) 
(Result a, Result b, Result c, Result d, Result e, Result f, Result g, Result h) => QueryResults (a, b, c, d, e, f, g, h) 
(Result a, Result b, Result c, Result d, Result e, Result f, Result g, Result h, Result i) => QueryResults (a, b, c, d, e, f, g, h, i) 
(Result a, Result b, Result c, Result d, Result e, Result f, Result g, Result h, Result i, Result j) => QueryResults (a, b, c, d, e, f, g, h, i, j) 

defaultConnectInfo :: ConnectInfo

Default information for setting up a connection.

Defaults are as follows:

  • Server on localhost
  • User root
  • No password
  • Database test
  • Character set utf8

Use as in the following example:

 connect defaultConnectInfo { connectHost = "db.example.com" }