From fe5cd6ad6c61eb13ca99acd1b69cd09b84051404 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 15 Mar 2017 14:47:31 +0100
Subject: Support types

---
 Handler/InventoryListing.hs | 21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

(limited to 'Handler/InventoryListing.hs')

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{..}
-- 
cgit v1.2.3