yesod-mangopay-1.0: app/Handler/Card.hs

-- | cards handling
module Handler.Card where

import Import
import Web.MangoPay
import Yesod.MangoPay
import Control.Arrow ((&&&))

-- | get card list
getCardsR :: AnyUserID -> Handler Html
getCardsR uid=do
  -- no paging, should be reasonable
  cards<-runYesodMPTToken $ getAll $ listCards uid
  defaultLayout $ do
        aDomId <- newIdent
        setTitleI MsgTitleCards
        $(widgetFile "cards")
        
-- | get card registration form
getCardR :: AnyUserID -> Handler Html
getCardR uid=do
    (widget, enctype) <- generateFormPost cardInfoForm
    defaultLayout $ do
        aDomId <- newIdent
        setTitleI MsgTitleCard
        $(widgetFile "card")

-- | register card
postCardR :: AnyUserID -> Handler Html
postCardR uid=do
  ((result, widget), enctype) <- runFormPost cardInfoForm
  case result of
    FormSuccess (c,ci)->
            catchMP (do
              _<-runYesodMPTToken $ fullRegistration uid c ci
              setMessageI MsgCardDone
              redirect $ CardsR uid
              )
               (\e->do
                setMessage $ toHtml $ show e
                defaultLayout $ do
                  aDomId <- newIdent
                  setTitleI MsgTitleCard
                  $(widgetFile "card")
                  )
    _ -> do
            setMessageI MsgErrorData
            defaultLayout $ do
                  aDomId <- newIdent
                  setTitleI MsgTitleCard
                  $(widgetFile "card")
        
cardInfoForm :: Html -> MForm Handler (FormResult (Currency,CardInfo), Widget)
cardInfoForm = renderDivs $ (\a b c d-> (a,CardInfo b c d))
  <$> areq (selectFieldList (map (id &&& id) supportedCurrencies)) (localizedFS MsgCardCurrency) Nothing
  <*> areq textField (localizedFS MsgCardNumber) Nothing
  <*> areq textField (localizedFS MsgCardExpire) Nothing
  <*> areq textField (localizedFS MsgCardCSC) Nothing