2
\$\begingroup\$

The following is some code that is used to provide the frontend with certain parameters when rendering a form. The parameters are conditional based around what data is being changed, getNewSaleFormOptions provides a way of quering these options using a GET request and url params (ie /sales/new?dealership=11&vehicle=2), and another getEditSaleFormOptions when returning to edit, but through the entity id, ie /sales/1 (this will pull necessary data, dealership, vehicle, from Sale 1).

I've tried to use MaybeT here to simplify a lot of the calls that return m (Maybe a), though its possible i'm not using it in the most efficient way. There are lots of MaybeT and runMaybeT calls (though this might be okay), and a few spots where there is duplicated code... I'm just not sure of the best way to eliminate them.

{-# LANGUAGE GADTs            #-}
{-# LANGUAGE FlexibleContexts #-}

module Forms.SaleForm
  ( SaleFormOptions(..)
  , getNewSaleFormOptions
  , getEditSaleFormOptions
  ) where

import           Control.Monad (join)
import           Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import qualified Data.Aeson as Aeson
import           Data.Aeson ((.=), ToJSON)
import qualified Data.Maybe as M
import           Data.Text (Text)
import           Database.Esqueleto (SqlPersistT, get)
import           Yesod.Core (MonadHandler(..), PathPiece(..))

data SaleFormOptions = SaleFormOptions
  { saleFormOptionsCampaigns :: Maybe MarketingCampaigns
  , saleFormOptionsDiscountElegible :: Bool
  }

instance ToJSON SaleFormOptions where
  toJSON SaleFormOptions{..} =
    Aeson.object [ "campaigns" .= saleFormOptionsCampaigns
                 , "discount_elegible" .= saleFormOptionsDiscountElegible
                 ]

getNewSaleFormOptions :: MonadHandler m => Key User -> SqlPersistT m SaleFormOptions
getNewSaleFormOptions userKey = NewTenancyFormFields <$> campaigns <*> discountElegible
 where
    campaigns =
      runMaybeT (MaybeT . fetchCampaigns userKey =<< lookupIdGetParamM "dealership")

    discountElegible =
      M.fromMaybe False <$> runMaybeT (MaybeT . fmap Just . isDiscountElegible =<< lookupIdGetParamM "vehicle")

getEditSaleFormOptions
  :: MonadHandler m
  => Key User
  -> Key Sale
  -> SqlPersistT m SaleFormOptions
getEditSaleFormOptions userKey saleKey = do
  sale <- get saleKey
  EditTenancyTenantFormFields <$> fmap join (mapM (fetchCampaigns userKey) (saleDealership <$> sale))
                              <*> (M.fromMaybe False <$> mapM isDiscountElegible (saleVehicle <$> sale))

fetchCampaigns :: MonadHandler m => Key User -> Key Dealership -> SqlPersistT m (Maybe MarketingCampaigns)
fetchCampaigns userKey dealershipKey = do
  enabled <- campaignsEnabled userKey dealershipKey
  if enabled then Just <$> getCampaigns dealershipKey
             else return Nothing

isDiscountElegible :: MonadHandler m => Key Vehicle -> SqlPersistT m Bool
isDiscountElegible vehicleKey = M.fromMaybe False <$> runMaybeT checkElegible
  where
    checkElegible = do
      vehicle <- MaybeT (get vehicleKey)
      vehicleHasDiscount <$> (MaybeT . get $ vehicleManufacturer vehicle)
                         <*> pure vehicle

lookupIdGetParamM
  :: (PathPiece (Key a), MonadHandler m)
  => Text
  -> MaybeT m (Key a)
lookupIdGetParamM = MaybeT . lookupIdGetParam

And this is the code for lookupIdGetParam:

lookupIdGetParam :: (PathPiece (Key a), MonadHandler m) => Text -> m (Maybe (Key a))
lookupIdGetParam name = do
  mraw <- lookupGetParam name
  case mraw of
    Nothing  -> return Nothing
    Just raw -> return (fromPathPiece raw)
\$\endgroup\$
1
+50
\$\begingroup\$

I'd suggest these points to simplify your code:

  • Make everything that returns Maybe something into MaybeT, and as close to the origin as possible. This will make composition of your functions much easier. For example:

    lookupIdGetParam :: (PathPiece (Key a), MonadHandler m) => Text -> MaybeT m (Key a)
    lookupIdGetParam name = liftM fromPathPiece (MaybeT $ lookupGetParam name)
    

    Notice using MaybeT just at lookupGetParam, then we don't need to duplicate MaybeT's functionality in the case expression.

    This also helps you to avoid complicated code with two nested monads (such as SqlPersistT m (Maybe MarketingCampaigns)) and then complex and hard-to-read operations on them like fmap join (mapM ...).

  • MaybeT . fmap Just is equivalent to lift.
  • Whenever applicable, use functions from MonadPlus. Not just mzero (which is here equivalent to Nothing) and mplus, there are also some other very useful ones such as mfilter or guard. Like in:

    fetchCampaigns :: MonadHandler m => Key User -> Key Dealership -> MaybeT (SqlPersistT m) MarketingCampaigns
    fetchCampaigns userKey dealershipKey = do
      enabled <- lift $ campaignsEnabled userKey dealershipKey
      guard enabled
      lift $ getCampaigns dealershipKey
    
  • Something to try out, I'm not sure if this will help you, but it might: Instead of a function that returns a Bool in a monad, return MaybeT MyMonad () such that original False corresponds to a failure in MaybeT and True to a () value. To be specific, instead of isDiscountEligible, you could have

    checkDiscountElegible :: MonadHandler m => Key Vehicle -> MaybeT (SqlPersistT m) ()
    checkDiscountElegible vehicleKey = do
      vehicle <- MaybeT (get vehicleKey)
      hasDiscount <- vehicleHasDiscount <$> (MaybeT . get $ vehicleManufacturer vehicle)
                                        <*> pure vehicle
      guard hasDiscount
    

    The idea is that this will make these functions composable with the other MaybeT ... ones, and avoid the tedious M.fromMaybe False <$> runMaybeT.

    In other words, in MaybeT m Bool there are two failure modes: One failing within the monad, and another returning False. If you know from the beginning that they're both equivalent, just collapse them instead of keeping the distinction.

Disclaimer: I haven't tried to compile any of the above, so there might be syntax errors, but hopefully the meaning is clear.

\$\endgroup\$

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.