yammat/Handler/Supplier.hs

module Handler.Supplier where

import Import
import Handler.Common
import Data.Maybe

getSupplierR :: Handler Html
getSupplierR = do
  sups <- runDB $ selectList [] [Asc SupplierIdent]
  defaultLayout $ do
    setTitleI MsgSuppliers
    $(widgetFile "supplier")

getNewSupplierR :: Handler Html
getNewSupplierR = do
  (newSupplierWidget, enctype) <- generateFormPost
    $ renderBootstrap3 BootstrapBasicForm newSupplierForm
  defaultLayout $ do
    setTitleI MsgNewSupplier
    $(widgetFile "newSupplier")

postNewSupplierR :: Handler Html
postNewSupplierR = do
  ((res, _), _) <- runFormPost
    $ renderBootstrap3 BootstrapBasicForm newSupplierForm
  case res of
    FormSuccess sup -> do
      runDB $ insert_ sup
      setMessageI MsgSupplierCreated
      redirect SupplierR
    _ -> do
      setMessageI MsgSupplierNotCreated
      redirect SupplierR

newSupplierForm :: AForm Handler Supplier
newSupplierForm = Supplier
  <$> areq textField (bfs MsgName) Nothing
  <*> areq textareaField (bfs MsgAddress) Nothing
  <*> areq textField (bfs MsgTelNr) Nothing
  <*> areq emailField (bfs MsgEmail) Nothing
  <*> areq textField (bfs MsgCustomerId) Nothing
  <*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
  <*  bootstrapSubmit (msgToBSSubmit MsgSubmit)
  where
    avatars = do
      ents <- runDB $ selectList [] [Asc AvatarIdent]
      optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents

data SupConf = SupConf
  { supConfIdent :: Text
  , supConfAddr :: Textarea
  , supConfTel :: Text
  , supConfEmail :: Text
  , supConfCustomerId :: Text
  , supConfAvatar :: Maybe AvatarId
  }

getModifySupplierR :: SupplierId -> Handler Html
getModifySupplierR sId = do
  mSup <- runDB $ get sId
  case mSup of
    Just sup -> do
      (modifySupplierWidget, enctype) <- generateFormPost
        $ renderBootstrap3 BootstrapBasicForm
        $ modifySupplierForm sup
      defaultLayout $ do
        setTitleI MsgEditSupplier
        $(widgetFile "modifySupplier")
    Nothing -> do
      setMessageI MsgSupplierUnknown
      redirect $ SupplierR

postModifySupplierR :: SupplierId -> Handler Html
postModifySupplierR sId = do
  mSup <- runDB $ get sId
  case mSup of
    Just sup -> do
      ((res, _), _) <- runFormPost
        $ renderBootstrap3 BootstrapBasicForm
        $ modifySupplierForm sup
      case res of
        FormSuccess msup -> do
          runDB $ update sId
            [ SupplierIdent =. supConfIdent msup
            , SupplierAddress =. supConfAddr msup
            , SupplierTel =. supConfTel msup
            , SupplierEmail =. supConfEmail msup
            , SupplierCustomerId =. supConfCustomerId msup
            , SupplierAvatar =. supConfAvatar msup
            ]
          setMessageI MsgSupplierEdited
          redirect SupplierR
        _ -> do
          setMessageI MsgSupplierNotEdited
          redirect SupplierR
    Nothing -> do
      setMessageI MsgSupplierUnknown
      redirect SupplierR

modifySupplierForm :: Supplier -> AForm Handler SupConf
modifySupplierForm sup = SupConf
  <$> areq textField (bfs MsgName) (Just $ supplierIdent sup)
  <*> areq textareaField (bfs MsgAddress) (Just $ supplierAddress sup)
  <*> areq textField (bfs MsgTelNr) (Just $ supplierTel sup)
  <*> areq textField (bfs MsgEmail) (Just $ supplierEmail sup)
  <*> areq textField (bfs MsgCustomerId) (Just $ supplierCustomerId sup)
  <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup)
  <*  bootstrapSubmit (msgToBSSubmit MsgSubmit)
  where
    avatars = do
      ents <- runDB $ selectList [] [Asc AvatarIdent]
      optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents