summaryrefslogtreecommitdiff
path: root/Handler/InventoryListing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Handler/InventoryListing.hs')
-rw-r--r--Handler/InventoryListing.hs21
1 files changed, 14 insertions, 7 deletions
diff --git a/Handler/InventoryListing.hs b/Handler/InventoryListing.hs
index 12f36ba..6d4d8fa 100644
--- a/Handler/InventoryListing.hs
+++ b/Handler/InventoryListing.hs
@@ -8,19 +8,26 @@ getInventoryListingR = postInventoryListingR
8postInventoryListingR = do 8postInventoryListingR = do
9 ((insertResult, fsInsertForm), fsInsertEncoding) <- runFormPost $ itemForm Nothing 9 ((insertResult, fsInsertForm), fsInsertEncoding) <- runFormPost $ itemForm Nothing
10 10
11 mapM_ (addMessage "formError" . toHtml) =<< case insertResult of 11 case insertResult of
12 FormSuccess newItem -> [] <$ runDB (insert newItem) 12 FormSuccess (Item{..} `WithType` t) -> runDB $ do
13 FormFailure errors -> return errors 13 upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
14 _ -> return [] 14 insert Item{..}
15 return ()
16 FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
17 _ -> return ()
15 18
16 (sortOn entityVal -> stock) <- runDB $ selectList [] [] 19 (sortOn (entityVal . typedVal) -> stock) <- runDB $ mapM withType =<< selectList [] []
17 20
18 selectRep $ do 21 selectRep $ do
19 provideJson (stock :: [Entity Item]) 22 provideJson (stock :: [WithType (Entity Item)])
20 provideRep . defaultLayout $ inventoryListing InventoryState 23 provideRep . defaultLayout $ inventoryListing InventoryState
21 { invFormState = Just InsertForm{..} 24 { invFormState = Just InsertForm{..}
22 , .. 25 , ..
23 } 26 }
24 27
25putInventoryListingR :: Handler Value 28putInventoryListingR :: Handler Value
26putInventoryListingR = returnJson =<< runDB . insertEntity =<< (requireCheckJsonBody :: Handler Item) 29putInventoryListingR = do
30 (Item{..} `WithType` t) <- requireCheckJsonBody
31 returnJson <=< runDB $ do
32 upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
33 withType =<< insertEntity Item{..}