2
\$\begingroup\$

I am making a key-value database using acid-state. It has three similar "pools", one for cookie records, one for email verification of new accounts, and the last for resetting passwords.

There are three Update/Query: 1. insert a new record 2. verify using records in the db 3. delete a record

Initially, I wrote three different functions for each Update/Query, resulting in disgust repetition. Later, I tried to use a type variable to reduce repetitious code.

-- data definition
data VCodeRecord k = VCodeRecord {
    primaryKey :: k
  , vcode      :: VCode
  , expireTime :: ExpireTime
  } deriving (Eq, Ord, Data, Typeable, Show)

$(deriveSafeCopy 0 'base ''VCodeRecord)

instance Indexable (VCodeRecord Email) where
  empty = ixSet [ ixFun $ \bp -> [ primaryKey bp ] ]
instance Indexable (VCodeRecord AccountId) where
  empty = ixSet [ ixFun $ \bp -> [ primaryKey bp ] ]

type VCodePool k = IxSet (VCodeRecord k)

data VCodePools = VCodePools {
    newAccountPool  :: VCodePool Email
  , resetPasswdPool :: VCodePool Email
  , cookiePool      :: VCodePool AccountId
  } deriving (Data, Typeable, Show)
$(deriveSafeCopy 0 'base ''VCodePools)

-- update/query methods
initialVCodePools :: VCodePools
initialVCodePools = VCodePools empty empty empty

updateNewAccountPool  pools pool = pools { newAccountPool  = pool }
updateResetPasswdPool pools pool = pools { resetPasswdPool = pool }
updateCookiePool      pools pool = pools { cookiePool      = pool }

newVCodeRecord
  :: (IxSet.Indexable (VCodeRecord k), Typeable k, Ord k)
  => (VCodePools -> VCodePool k)
  -> (VCodePools -> VCodePool k -> VCodePools)
  -> k -> VCode -> ExpireTime -> Update VCodePools ()
newVCodeRecord extract update key vcode expireTime = do
  let record = VCodeRecord key vcode expireTime
  pools <- get
  let pool = extract pools
  let pool' = IxSet.updateIx key record pool
  put $ update pools pool'

insertNewAccount  = newVCodeRecord newAccountPool updateNewAccountPool
insertResetPasswd = newVCodeRecord resetPasswdPool updateResetPasswdPool
insertCookie      = newVCodeRecord cookiePool updateCookiePool

$(makeAcidic ''VCodePools
  [ 'insertNewAccount
  , 'insertResetPasswd
  , 'insertCookie
  ])

(I only present one method implementation for clarity.)

I would like to know if there is any possible improvement. For example, could I remove those insertXxx and at invocation points use something like this?

insertRecord NewAccountPool arg1 arg2 arg3
\$\endgroup\$

0

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.