|
sourcecode:
|
module Database.KeyDatabaseSQLite (
Key, KeyPred,
Query, runQ, transformQ, getDB,
Transaction, TError(..), TErrorKind(..), showTError, runT, runJustT,
returnT, doneT, errorT, failT, (|>>=), (|>>),
sequenceT, sequenceT_, mapT, mapT_,
Dynamic, persistentSQLite, closeDBHandles,
existsDBKey,
allDBKeys, allDBInfos, allDBKeyInfos,
ColVal, (@=), someDBKeys, someDBInfos, someDBKeyInfos, someDBKeyProjections,
getDBInfo, getDBInfos,
deleteDBEntry, deleteDBEntries, updateDBEntry, newDBEntry, newDBKeyEntry,
cleanDB
) where
import Control.Monad ( when )
import Data.List ( init, intersperse, insertBy )
import Data.Maybe
import System.IO ( Handle, hPutStrLn, hGetLine, hFlush, hClose, stderr )
import Data.Global ( GlobalT, globalT, readGlobalT, writeGlobalT )
import System.IOExts ( connectToCommand )
import System.Process ( system )
infixl 1 |>>, |>>=
-- adjust this if 'sqlite3' is not in the PATH
path'to'sqlite3 :: String
path'to'sqlite3 = "sqlite3"
-- Query and Transaction types
--- Queries can read but not write to the database.
data Query a = Query (IO a)
--- Runs a database query in the IO monad.
runQ :: Query a -> IO a
runQ (Query a) = a
--- Applies a function to the result of a database query.
transformQ :: (a -> b) -> Query a -> Query b
transformQ f query = Query (runQ query >>= return . f)
--- Transactions can modify the database and are executed
--- atomically.
data Transaction a = Trans (IO (TransResult a))
data TransResult a = OK a | Error TError
unTrans :: Transaction a -> IO (TransResult a)
unTrans (Trans action) = action
--- Runs a transaction atomically in the IO monad.
---
--- Transactions are <em>immediate</em>, which means that locks are
--- acquired on all databases as soon as the transaction is
--- started. After one transaction is started, no other database
--- connection will be able to write to the database or start a
--- transaction. Other connections <em>can</em> read the database
--- during a transaction of another process.
---
--- The choice to use immediate rather than deferred transactions is
--- conservative. It might also be possible to allow multiple
--- simultaneous transactions that lock tables on the first database
--- access (which is the default in SQLite). However this leads to
--- unpredictable order in which locks are taken when multiple
--- databases are involved. The current implementation fixes the
--- locking order by sorting databases by their name and locking them
--- in order immediately when a transaction begins.
---
--- More information on
--- <a href="http://sqlite.org/lang_transaction.html">transactions</a>
--- in SQLite is available online.
---
runT :: Transaction a -> IO (Either a TError)
runT trans =
do beginTransaction
result <- catchTrans $ unTrans trans
case result of
Error err ->
do rollbackTransaction
return (Right err)
OK res ->
do commitTransaction
return (Left res)
catchTrans :: IO (TransResult a) -> IO (TransResult a)
catchTrans action =
action `catch` \terr ->
do err <- readGlobalT lastQueryError
writeGlobalT lastQueryError Nothing
return . Error $ maybe (TError ExecutionError (show terr)) id err
--- Executes a possibly composed transaction on the current state
--- of dynamic predicates as a single transaction.
--- Similar to <code>runT</code> but a run-time error is raised
--- if the execution of the transaction fails.
runJustT :: Transaction a -> IO a
runJustT t =
runT t >>=
return . either id
(\e -> error ("Transaction failed: " ++ showTError e))
--- Lifts a database query to the transaction type such that it can be
--- composed with other transactions. Run-time errors that occur
--- during the execution of the given query are transformed into
--- transaction errors.
getDB :: Query a -> Transaction a
getDB query = Trans . catchTrans $ runQ query >>= return . OK
-- not exported
transIO :: IO a -> Transaction a
transIO action = Trans (action >>= return . OK)
--- Returns the given value in a transaction that does not access the
--- database.
returnT :: a -> Transaction a
returnT = transIO . return
--- Returns the unit value in a transaction that does not access the
--- database. Useful to ignore results when composing transactions.
doneT :: Transaction ()
doneT = transIO (return ())
--- Aborts a transaction with an error.
errorT :: TError -> Transaction a
errorT = Trans . return . Error
--- Aborts a transaction with a user-defined error message.
failT :: String -> Transaction a
failT = errorT . TError UserDefinedError
--- Combines two transactions into a single transaction that executes
--- both in sequence. The first transaction is executed, its result
--- passed to the function which computes the second transaction,
--- which is then executed to compute the final result.
---
--- If the first transaction is aborted with an error, the second
--- transaction is not executed.
(|>>=) :: Transaction a -> (a -> Transaction b) -> Transaction b
Trans action |>>= f = Trans $
do result <- action
case result of
Error err -> return $ Error err
OK res -> unTrans $ f res
--- Combines two transactions to execute them in sequence. The result of
--- the first transaction is ignored.
(|>>) :: Transaction _ -> Transaction a -> Transaction a
t1 |>> t2 = t1 |>>= const t2
--- Executes a list of transactions sequentially and computes a list
--- of all results.
sequenceT :: [Transaction a] -> Transaction [a]
sequenceT = foldr seqT (returnT [])
where
--seqT t ts = t |>>= \x -> ts |>>= \xs -> returnT (x:xs)
seqT t ts = do x <- t
xs <- ts
return (x:xs)
--- Executes a list of transactions sequentially, ignoring their
--- results.
sequenceT_ :: [Transaction _] -> Transaction ()
sequenceT_ = foldr (|>>) doneT
--- Applies a function that yields transactions to all elements of a
--- list, executes the transaction sequentially, and collects their
--- results.
mapT :: (a -> Transaction b) -> [a] -> Transaction [b]
mapT f = sequenceT . map f
--- Applies a function that yields transactions to all elements of a
--- list, executes the transactions sequentially, and ignores their
--- results.
mapT_ :: (a -> Transaction _) -> [a] -> Transaction ()
mapT_ f = sequenceT_ . map f
-- Interface based on keys
type DBFile = String
type TableName = String
type ColName = String
--- Result type of database predicates.
data Dynamic = DBInfo DBFile TableName [ColName]
--- The general type of database keys.
type Key = Int
type KeyPred a = Key -> a -> Dynamic -- for interface compatibility
dbInfo :: KeyPred a -> (DBFile,(TableName,[ColName]))
dbInfo keyPred = (db,(table,cols))
where
DBInfo db table cols = keyPred ignored ignored
ignored :: a
ignored = error "unexpected access to argument of database predicate"
dbFile :: KeyPred _ -> DBFile
dbFile = fst . dbInfo
tableName :: KeyPred _ -> TableName
tableName = fst . snd . dbInfo
colNames :: KeyPred _ -> [ColName]
colNames = snd . snd . dbInfo
--- This function is used instead of <code>dynamic</code> or
--- <code>persistent</code> to declare predicates whose facts are stored
--- in an SQLite database.
---
--- If the provided database or the table do not exist they are created
--- automatically when the declared predicate is accessed for the first time.
---
--- Multiple column names can be provided if the second argument of
--- the predicate is a tuple with a matching arity. Other record types
--- are not supported. If no column names are provided a table with a
--- single column called <code>info</code> is created. Columns of name
--- <code>_rowid_</code> are not supported and lead to a run-time
--- error.
---
--- @param dbFile - the name of the associated database file
--- @param tableName - the name of the associated database table
--- @param colNames - the column names of the associated database table
persistentSQLite :: DBFile -> TableName -> [ColName] -> KeyPred a
persistentSQLite db table cols _ _
| null cols = DBInfo db table ["info"]
| "_rowid_" `elem` cols = error "columns must not be called _rowid_"
| otherwise = DBInfo db table cols
--- Checks whether the predicate has an entry with the given key.
existsDBKey :: KeyPred _ -> Key -> Query Bool
existsDBKey keyPred key = Query $
do n <- selectInt keyPred "count(*)" $ "where _rowid_ = " ++ show key
return $! n > 0
--- Returns a list of all stored keys. Do not use this function unless
--- the database is small.
allDBKeys :: KeyPred _ -> Query [Key]
allDBKeys keyPred = Query $
do rows <- selectRows keyPred "_rowid_" ""
mapM readIntOrExit rows
--- Returns a list of all info parts of stored entries. Do not use this
--- function unless the database is small.
allDBInfos :: (Read a, Show a) => KeyPred a -> Query [a]
allDBInfos keyPred = Query $
do rows <- selectRows keyPred "*" ""
return $!! map readInfo rows
readInfo :: Read a => String -> a
readInfo str = read $ "(" ++ str ++ ")"
--- Returns a list of all stored entries. Do not use this function
--- unless the database is small.
allDBKeyInfos :: (Read a, Show a) => KeyPred a -> Query [(Key,a)]
allDBKeyInfos keyPred = Query $
do rows <- selectRows keyPred "_rowid_,*" ""
mapM readKeyInfo rows
readKeyInfo :: (Read a, Show a) => String -> IO (Key,a)
readKeyInfo row =
do key <- readIntOrExit keyStr
return $!! (key, readInfo infoStr)
where
(keyStr,_:infoStr) = break (','==) row
--- Abstract type for value restrictions
data ColVal = ColVal Int String
--- Constructs a value restriction for the column given as first argument
(@=) :: Show a => Int -> a -> ColVal
n @= x = ColVal n . quote $ show x
--- Returns a list of those stored keys where the corresponding info
--- part matches the gioven value restriction. Safe to use even on
--- large databases if the number of results is small.
someDBKeys :: KeyPred _ -> [ColVal] -> Query [Key]
someDBKeys keyPred cvs = Query $
do rows <- selectSomeRows keyPred cvs "_rowid_"
mapM readIntOrExit rows
--- Returns a list of those info parts of stored entries that match
--- the given value restrictions for columns. Safe to use even on
--- large databases if the number of results is small.
someDBInfos :: (Read a, Show a) => KeyPred a -> [ColVal] -> Query [a]
someDBInfos keyPred cvs = Query $
do rows <- selectSomeRows keyPred cvs "*"
return $!! map readInfo rows
--- Returns a list of those entries that match the given value
--- restrictions for columns. Safe to use even on large databases if
--- the number of results is small.
someDBKeyInfos :: (Read a, Show a) => KeyPred a -> [ColVal] -> Query [(Key,a)]
someDBKeyInfos keyPred cvs = Query $
do rows <- selectSomeRows keyPred cvs "_rowid_,*"
mapM readKeyInfo rows
--- Returns a list of column projections on
--- those entries that match the given value
--- restrictions for columns. Safe to use even on large databases if
--- the number of results is small.
someDBKeyProjections :: (Read b, Show b) => KeyPred a -> [Int] -> [ColVal]
-> Query [(Key,b)]
someDBKeyProjections keyPred cols cvs = Query $
do let colnames = commaSep (map ((colNames keyPred) !!) cols)
rows <- selectSomeRows keyPred cvs ("_rowid_,"++colnames)
mapM readKeyInfo rows
--- Queries the information stored under the given key. Yields
--- <code>Nothing</code> if the given key is not present.
getDBInfo :: (Read a, Show a) => KeyPred a -> Key -> Query (Maybe a)
getDBInfo keyPred key = Query $
do rows <- selectRows keyPred "*" $ "where _rowid_ = " ++ show key
readHeadIfExists rows
where
readHeadIfExists [] = return Nothing
readHeadIfExists (x:_) = return $!! Just (readInfo x)
--- Queries the information stored under the given keys. Yields
--- <code>Nothing</code> if a given key is not present.
getDBInfos :: (Read a, Show a) => KeyPred a -> [Key] -> Query (Maybe [a])
getDBInfos keyPred keys = Query $
do rows <- selectRows keyPred "_rowid_,*" $
"where _rowid_ in (" ++ commaSep (map show keys) ++ ")"
sortByIndexInGivenList rows
where
sortByIndexInGivenList rows =
do keyInfos <- mapM readKeyInfo rows
return $ mapM (\key -> lookup key keyInfos) keys
commaSep :: [String] -> String
commaSep = concat . intersperse ", "
--- Deletes the information stored under the given key. If the given
--- key does not exist this transaction is silently ignored and no
--- error is raised.
deleteDBEntry :: KeyPred _ -> Key -> Transaction ()
deleteDBEntry keyPred key =
modify keyPred "delete from" $ "where _rowid_ = " ++ show key
--- Deletes the information stored under the given keys. No error is
--- raised if (some of) the keys do not exist.
deleteDBEntries :: KeyPred _ -> [Key] -> Transaction ()
deleteDBEntries keyPred keys =
modify keyPred "delete from" $
"where _rowid_ in (" ++ commaSep (map show keys) ++ ")"
--- Updates the information stored under the given key. The
--- transaction is aborted with a <code>KeyNotExistsError</code> if
--- the given key is not present in the database.
updateDBEntry :: Show a => KeyPred a -> Key -> a -> Transaction ()
updateDBEntry keyPred key info =
errorUnlessKeyExists keyPred key ("updateDBEntry, " ++ show key) |>>
modify keyPred "update"
("set " ++ commaSep (colVals keyPred info) ++
" where _rowid_ = " ++ show key)
errorUnlessKeyExists :: KeyPred a -> Key -> String -> Transaction ()
errorUnlessKeyExists keyPred key msg =
getDB (existsDBKey keyPred key) |>>= \exists ->
if not exists
then errorT $ TError KeyNotExistsError msg
else doneT
colVals :: Show a => KeyPred a -> a -> [String]
colVals keyPred info =
zipWith (\c v -> c ++ " = " ++ v) (colNames keyPred) (infoVals keyPred info)
infoVals :: Show a => KeyPred a -> a -> [String]
infoVals keyPred info
| null . tail $ colNames keyPred = [quote $ show info]
| otherwise = map quote $ showTupleArgs info
quote :: String -> String
quote s = "'" ++ concatMap quoteChar s ++ "'"
where
quoteChar c = if c == ''' then "''" else [c]
--- Stores new information in the database and yields the newly
--- generated key.
newDBEntry :: Show a => KeyPred a -> a -> Transaction Key
newDBEntry keyPred info =
modify keyPred "insert into"
("values (" ++ commaSep (infoVals keyPred info) ++ ")") |>>
getDB (Query $ selectInt keyPred "last_insert_rowid()" "")
--- Stores a new entry in the database under a given key.
--- The transaction fails if the key already exists.
--- @param db - the database (a dynamic predicate)
--- @param key - the key of the new entry (an integer)
--- @param info - the information to be stored in the new entry
newDBKeyEntry :: Show a => KeyPred a -> Key -> a -> Transaction ()
newDBKeyEntry keyPred key info =
getDB (existsDBKey keyPred key) |>>= \b ->
if b
then errorT . TError DuplicateKeyError $
"database already contains entry with key: " ++ show key
else modify keyPred "insert into"
("values (" ++ commaSep (infoVals keyPred info) ++ ")") |>>
getDB (Query $ selectInt keyPred "last_insert_rowid()" "") |>>= \k ->
modify keyPred "update" $
"set _rowid_ = " ++ show key ++ " where _rowid_ = " ++ show k
--- Deletes all entries from the database associated with a predicate.
cleanDB :: KeyPred _ -> Transaction ()
cleanDB keyPred = modify keyPred "delete from" ""
-- SQL access functions
-- These functions are not exported and abstract common functionality
-- used in the library functions above. Each database access is one of
-- the following: a modification, a selection of a numeric aggregate,
-- or a selection of rows.
sqlite3 :: KeyPred _ -> String -> IO Handle
sqlite3 keyPred sql =
do h <- getDBHandle keyPred
hPutAndFlush h $ sql ++ ";"
return h
hPutAndFlush :: Handle -> String -> IO ()
hPutAndFlush h s = hPutStrLn h s >> hFlush h
modify :: KeyPred _ -> String -> String -> Transaction ()
modify keyPred before after = transIO $ do
sqlite3 keyPred $
before ++ " " ++ tableName keyPred ++ " " ++ after
return ()
selectInt :: KeyPred _ -> String -> String -> IO Int
selectInt keyPred aggr cond =
do h <- sqlite3 keyPred $
"select distinct " ++ aggr ++
" from " ++ tableName keyPred ++ " " ++ cond
hGetLine h >>= readIntOrExit
-- yields 1 for "1a" and exits for ""
readIntOrExit :: String -> IO Int
readIntOrExit s = case reads s of
[(n,_)] -> return n
_ -> dbError ExecutionError $
"readIntOrExit: cannot parse integer from string '" ++
show s ++ "'"
-- When selecting an unknown number of rows it is necessary to know
-- when to stop. One way to be able to stop is to select 'count(*)'
-- instead of the actual colums before the query. As it is potentially
-- inefficient to execute the query twice, this implementation takes a
-- different approach: generate a random string before the query and
-- select it afterwards, then read all lines up to this random string.
type Row = String
selectRows :: KeyPred _ -> String -> String -> IO [Row]
selectRows keyPred cols cond =
do h <- sqlite3 keyPred "select hex(randomblob(8))"
rnd <- hGetLine h -- 8 random bytes = 16 random hex chars
hPutAndFlush h $
"select " ++ cols ++ " from " ++ tableName keyPred ++
" " ++ cond ++ "; select " ++ quote rnd ++ ";"
hGetLinesBefore h rnd
hGetLinesBefore :: Handle -> String -> IO [String]
hGetLinesBefore h stop =
do line <- hGetLine h
if line == stop
then return []
else do rest <- hGetLinesBefore h stop
return (line : rest)
selectSomeRows :: KeyPred _ -> [ColVal] -> String -> IO [Row]
selectSomeRows keyPred cvs cols =
selectRows keyPred cols $ if null cvs then ""
else "where " ++ showColVals keyPred cvs
showColVals :: KeyPred a -> [ColVal] -> String
showColVals _ [] = "1"
showColVals keyPred (c:vs) = concat . intersperse " AND " $ map showCV (c:vs)
where
showCV (ColVal n s) = colNames keyPred !! n ++ " = " ++ s
--- Closes all database connections. Should be called when no more
--- database access will be necessary.
closeDBHandles :: IO ()
closeDBHandles =
do withAllDBHandles hClose
writeGlobalT openDBHandles []
-- helper functions and globaly stored information
dbError :: TErrorKind -> String -> IO a
dbError kind msg =
do writeGlobalT lastQueryError . Just $ TError kind msg
error msg
lastQueryError :: GlobalT (Maybe TError)
lastQueryError = globalT "Database.KeyDatabaseSQLite.lastQueryError" Nothing
getDBHandle :: KeyPred _ -> IO Handle
getDBHandle keyPred =
do ensureDBFor keyPred
readDBHandle $ dbFile keyPred
-- Initializes the database and table for the given predicate. This
-- function must be called before the database for this predicate is
-- accessed and before a transaction that uses this predicate is
-- started.
ensureDBFor :: KeyPred _ -> IO ()
ensureDBFor keyPred =
do ensureDBHandle db
ensureDBTable db table cols
where
(db,(table,cols)) = dbInfo keyPred
readDBHandle :: DBFile -> IO Handle
readDBHandle db = readGlobalT openDBHandles >>= maybe err return . lookup db
where
err = dbError ExecutionError $ "readDBHandle: no handle for '" ++ db ++ "'"
openDBHandles :: GlobalT [(DBFile,Handle)]
openDBHandles = globalT "Database.KeyDatabaseSQLite.openDBHandles" []
withAllDBHandles :: (Handle -> IO _) -> IO ()
withAllDBHandles f =
do dbHandles <- readGlobalT openDBHandles
mapM_ (f . snd) dbHandles
ensureDBHandle :: DBFile -> IO ()
ensureDBHandle db =
do dbHandles <- readGlobalT openDBHandles
unless (db `elem` map fst dbHandles) $ addNewDBHandle dbHandles
where
addNewDBHandle dbHandles = do
exsqlite3 <- system $ "which " ++ path'to'sqlite3 ++ " > /dev/null"
when (exsqlite3>0) $
error "Database interface `sqlite3' not found. Please install package `sqlite3'!"
h <- connectToCommand $ path'to'sqlite3 ++ " " ++ db
hPutAndFlush h ".separator ','"
writeGlobalT openDBHandles $ -- sort against deadlock
insertBy ((<=) `on` fst) (db,h) dbHandles
isTrans <- readGlobalT currentlyInTransaction
unless (not isTrans) $ hPutStrLn h "begin immediate;"
unless :: Bool -> IO () -> IO ()
unless False action = action
unless True _ = return ()
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
on f g x y = f (g x) (g y)
ensureDBTable :: DBFile -> TableName -> [ColName] -> IO ()
ensureDBTable db table cols =
do dbTables <- readGlobalT knownDBTables
unless ((db,table) `elem` dbTables) $
do h <- readDBHandle db
hPutAndFlush h $
"create table if not exists " ++ table ++
" (" ++ commaSep cols ++ ");"
writeGlobalT knownDBTables $ (db,table) : dbTables
knownDBTables :: GlobalT [(DBFile,TableName)]
knownDBTables = globalT "Database.KeyDatabaseSQLite.knownDBTables" []
beginTransaction :: IO ()
beginTransaction =
do writeGlobalT currentlyInTransaction True
withAllDBHandles (`hPutAndFlush` "begin immediate;")
commitTransaction :: IO ()
commitTransaction =
do withAllDBHandles (`hPutAndFlush` "commit;")
writeGlobalT currentlyInTransaction False
rollbackTransaction :: IO ()
rollbackTransaction =
do withAllDBHandles (`hPutAndFlush` "rollback;")
writeGlobalT currentlyInTransaction False
currentlyInTransaction :: GlobalT Bool
currentlyInTransaction =
globalT "Database.KeyDatabaseSQLite.currentlyInTransaction" False
-- converting arguments of a tuple to strings
showTupleArgs :: Show a => a -> [String]
showTupleArgs = splitTLC . removeOuterParens . show
where
removeOuterParens s = case s of ('(':cs) -> init cs
_ -> s
-- split at top-level commas
splitTLC :: String -> [String]
splitTLC = parse ""
type Stack = String
parse :: Stack -> String -> [String]
parse _ "" = []
parse st (c:cs) =
case (st,c:cs) of -- Curry allows ''' for '\''
('\'':xs,'\'':'\'':ys) -> '\'' <: ('\'' <: parse xs ys)
_ -> next c st $ parse (updStack c st) cs
next :: Char -> Stack -> [String] -> [String]
next c [] xs = if c==',' then [] : xs else c <: xs
next c (_:_) xs = c <: xs
(<:) :: Char -> [String] -> [String]
c <: [] = [[c]]
c <: (x:xs) = (c:x):xs
updStack :: Char -> Stack -> Stack
updStack char stack =
case (char,stack) of
-- char is an escaped character
(_ ,'\\':xs) -> xs -- the next character is not
-- char is the escape character
('\\', xs) -> '\\':xs -- push it on the stack
-- char is the string terminator
('"' , '"':xs) -> xs -- closes current string literal
('"' , ''':xs) -> ''':xs -- ignored inside character
('"' , xs) -> '"':xs -- opens a new string
-- char is the character terminator
(''' , ''':xs) -> xs -- closes current character literal
(''' , '"':xs) -> '"':xs -- ignored inside string
(''' , xs) -> ''':xs -- opens a new character
-- parens and brackets
(_ , '"':xs) -> '"':xs -- are ignored inside strings
(_ , ''':xs) -> ''':xs -- and characters
('(' , xs) -> '(':xs -- new opening paren
(')' , '(':xs) -> xs -- closing paren
('[' , xs) -> '[':xs -- opening bracket
(']' , '[':xs) -> xs -- closing bracket
-- other characters don't modify the stack
(_ , xs) -> xs
-- for debugging
-- hPutStrLn h s =
-- do IO.hPutStrLn stderr $ " > " ++ s
-- IO.hPutStrLn h s
-- hGetLine h =
-- do l <- IO.hGetLine h
-- IO.hPutStrLn stderr $ "< " ++ l
-- return l
-- copied from Database:
--- The type of errors that might occur during a transaction.
data TError = TError TErrorKind String
deriving (Eq,Show)
--- The various kinds of transaction errors.
data TErrorKind = KeyNotExistsError
| NoRelationshipError
| DuplicateKeyError
| KeyRequiredError
| UniqueError
| MinError
| MaxError
| UserDefinedError
| ExecutionError
deriving (Eq,Show)
--- Transforms a transaction error into a string.
showTError :: TError -> String
showTError (TError k s) = "Transaction error " ++ show k ++ ": " ++ s
------------------------------------------------------------------------------
-- Define Monad instance for `Transaction`.
mapTransResult :: (a -> b) -> TransResult a -> TransResult b
mapTransResult f (OK a) = OK (f a)
mapTransResult _ (Error te) = Error te
mapTrans :: (a -> b) -> Transaction a -> Transaction b
mapTrans f (Trans act) = Trans (fmap (mapTransResult f) act)
instance Functor Transaction where
fmap = mapTrans
instance Applicative Transaction where
pure x = returnT x
tf <*> x = tf |>>= \f -> fmap f x
instance Monad Transaction where
a1 >>= a2 = a1 |>>= a2
a1 >> a2 = a1 |>> a2
------------------------------------------------------------------------------
|