summaryrefslogtreecommitdiff
path: root/Handler/UpdateItem.hs
blob: ce6b30d3fd513f59eec32f4a6381d9ed14216664 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
module Handler.UpdateItem where

import Import

import Handler.Common

getUpdateItemR, postUpdateItemR :: ItemId -> Handler TypedContent
getUpdateItemR = postUpdateItemR
postUpdateItemR fsUpdateId = do
  Just entity <- fmap (Entity fsUpdateId) <$> runDB (get fsUpdateId)
  
  ((updateResult, fsUpdateForm), fsUpdateEncoding) <- runFormPost . itemForm . Just $ entityVal entity

  case updateResult of 
    FormSuccess (Item{..} `WithType` t) -> runDB $ do
      upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
      update fsUpdateId [ ItemKind =. itemKind
                        , ItemNormKind =. itemNormKind
                        , ItemBought =. itemBought
                        , ItemExpires =. itemExpires
                        , ItemOpened =. itemOpened
                        , ItemRunningLow =. itemRunningLow
                        ]
      return ()
    FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
    _ -> return ()

  selectRep $ do
    provideRep $ case updateResult of
      FormSuccess _ -> redirect $ InventoryListingR :#: fsUpdateId :: Handler Html
      _ -> do
        (stockSort -> stock) <- runDB $ withTypes =<< selectList [] []
        defaultLayout $ inventoryListing InventoryState
          { invFormState = Just UpdateForm{..}
          , ..
          }
    provideJson ()