/h-xproto-mysql

Haskell Client Library for MySQL XProtocol

Primary LanguageHaskellMIT LicenseMIT

Haskell Client Library for MySQL XProtocol

WORK IN PROGRESS, MANY CHANGES ARE EXPECTED.

Worklog

Overview

Description

Examples

Session Management (open and close)

Open a node session.

nodeSess <- openNodeSession $ defaultNodeSesssionInfo {
      database = "your_database"
    , user     = "your_username"
    , password = "your_password"
    -- , host = default host is 127.0.0.1
    -- , port = default port is 33060
    }

Close a node session.

closeNodeSession nodeSess

Transaction

Begin a transaction.

begenTrxNodeSession nodeSess

Commit a transaction.

commitNodeSession nodeSess

Rollback a transaction.

rollbackNodeSession nodeSess

SQL interface

Update

ret0 <- updateSql "create table bar (id int(5), data varchar(100));" [] nodeSess

ret1 <- updateSql "insert into foo values (1,\"aaa\")" [] nodeSess
print $ "insert result = " ++ (show ret1)

ret2 <- updateSql "update foo set v = ? where id = ?"  [XM.any "ccc", XM.any $ (1 :: Int)] nodeSess
print $ "update result = " ++ (show ret2)

ret3 <- updateSql "delete from foo where id = ?"  [XM.any $ (1 :: Int)] nodeSess
print $ "delete result = " ++ (show ret3)

Select (using Template Haskell)

data MyRecord = MyRecord {
      id           :: Int
    , name         :: String
    , country_code :: String
    , district     :: String
    , info         :: String
} deriving (Show, Eq)

ret@(x:xs) <- executeRawSql "select * from city limit 2" nodeSess
print ( $(retrieveRow ''MyRecord) x )

Select (without Template Haskell)

see example

Document interface

Find

let f = PB.defaultValue 
        `setCollection` (mkCollection "world_x" "countryinfo") 
        `setDataModel`  PDM.DOCUMENT 
        `setCriteria`   (exprDocumentPathItem "name" @== expr "Mike" )

ret <- CRUD.find f nodeSess
print ret

Update

let f = PB.defaultValue 
        `setCollection` (mkCollection "x_protocol_test" "foo_doc") 
        `setDataModel`  PDM.DOCUMENT 
        `setCriteria`   (exprDocumentPathItem "name" @== expr "Jone" )
        `setOperation`  [updateItemReplace "age" (999 :: Int)]
ret <- CRUD.update f nodeSess
print ret

Insert

-- Note that your json needs an uuid whose key is _id.
json1 <- insertUUIDIO "{\"name\" : \"Tom\" , \"age\" : 18 }"
 
let i1 = PB.defaultValue 
          `setCollection` (mkCollection "x_protocol_test" "foo_doc") 
          `setDataModel`  PDM.DOCUMENT 

ret <- CRUD.insert (i1 `setTypedRow` [mkExpr2TypedRow' $ expr json1]) nodeSess
print ret

Delete

let f = PB.defaultValue 
        `setCollection` (mkCollection "x_protocol_test" "foo_doc") 
        `setDataModel` PDM.DOCUMENT
ret <- CRUD.delete f nodeSess
print ret

Pipeline

sql1 = "insert into test_users values (1, 'mike'  , 'mike@example.com'  ,  45);"
sql2 = "insert into test_users values (2, 'nancy' , 'nancy@example.com' , 115);"
sql3 = "insert into test_users XXXXXX (3, 'steve' , 'steve@example.com' , 298);"  -- invalid sql
sql4 = "insert into test_users values (4, 'james' , 'steve@example.com' , 444);"  -- rejected by server
sql5 = "insert into test_users values (5, 'jhon'  , 'steve@example.com' , 555);"  -- rejected by server

-- short cut
exec = sendStmtExecuteSql 

-- Make a bulk of inserts
bulk :: ReaderT NodeSession IO ()
bulk = exec sql1 [] >> exec sql2 [] >> exec sql3 [] >> exec sql4 [] >> exec sql5 [] 

-- Make a pipeline
makeNoExpect sqls = do  
  sendExpectNoError
  sqls
  sendExpectClose

-- Run the pipeline
runReaderT (makeNoExpect bulk) nodeSess

-- Retreive the resultset.
ret <- runReaderT (repeatreadMessagesR True 5 ([],[])) nodeSess

Do you want try-catch-finally?

Loan pattern and try-catch-finally.

bracket
-- frist
(do
    nodeSess <- openNodeSession $ defaultNodeSesssionInfo {
          database = "x_protocol_test"
        , user     = "your_user"
        , password = "your_password"
        }
    begenTrxNodeSession nodeSess
    return nodeSess
)
-- last
(\nodeSess -> do
    closeNodeSession nodeSess
    return nodeSess
)
-- in between
(\nodeSess -> do
        ret1 <- updateRawSql "insert into bazz values (1)" nodeSess
        ret2 <- updateRawSql "insert into bazz values (1)" nodeSess
        print $ "ret1=" ++ (show ret1) ++ ", " ++ "ret2=" ++ (show ret2)
        commitNodeSession nodeSess
        return nodeSess
    `catches`
        [
          handleError (\ex -> do
            print $ "catching XProtocolError :" ++ (show ex)
            rollbackNodeSession nodeSess
            return nodeSess
        )
        , handleException $ (\ex -> do
            print $ "catching XProtocolException :" ++ (show ex)
            rollbackNodeSession nodeSess
            return nodeSess
        )
        , Handler $ (\(ex :: SomeException) -> do
            print $ "catching SomeException :" ++ (show ex)
            rollbackNodeSession nodeSess
            return nodeSess
        )
        ]
)

Requirement

Install

Contribution

NOTE

Licence

MIT

Author

naoto-ogawa

References