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\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.