Support types

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
 postInventoryListingR = do
   ((insertResult, fsInsertForm), fsInsertEncoding) <- runFormPost $ itemForm Nothing
 
-  mapM_ (addMessage "formError" . toHtml) =<< case insertResult of 
-    FormSuccess newItem -> [] <$ runDB (insert newItem)
-    FormFailure errors -> return errors
-    _ -> return []
+  case insertResult of 
+    FormSuccess (Item{..} `WithType` t) -> runDB $ do
+      upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
+      insert Item{..}
+      return ()
+    FormFailure errors -> mapM_ (addMessage "formError" . toHtml) errors
+    _ -> return ()
 
-  (sortOn entityVal -> stock) <- runDB $ selectList [] []
+  (sortOn (entityVal . typedVal) -> stock) <- runDB $ mapM withType =<< selectList [] []
 
   selectRep $ do
-    provideJson (stock :: [Entity Item])
+    provideJson (stock :: [WithType (Entity Item)])
     provideRep . defaultLayout $ inventoryListing InventoryState
       { invFormState = Just InsertForm{..}
       , ..
       }
 
 putInventoryListingR :: Handler Value
-putInventoryListingR = returnJson =<< runDB . insertEntity =<< (requireCheckJsonBody :: Handler Item)
+putInventoryListingR = do
+  (Item{..} `WithType` t) <- requireCheckJsonBody
+  returnJson <=< runDB $ do
+    upsertBy (UniqueKind itemNormKind) (Kind itemNormKind t) [ KindType =. t ]
+    withType =<< insertEntity Item{..}