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/Item.hs | 27 ++++++++++++++++-----------
 1 file changed, 16 insertions(+), 11 deletions(-)

(limited to 'Handler/Item.hs')

diff --git a/Handler/Item.hs b/Handler/Item.hs
index 0f48261..abb1b12 100644
--- a/Handler/Item.hs
+++ b/Handler/Item.hs
@@ -4,26 +4,31 @@ import Import
 
 getItemR :: ItemId -> Handler TypedContent
 getItemR itemId = do
-  entity <- runDB $ Entity itemId <$> get404 itemId
+  entity <- runDB $ withType =<< Entity itemId <$> get404 itemId
   selectRep $ do
     provideJson entity
     provideRep (redirect $ InventoryListingR :#: itemId :: Handler Html)
 
 putItemR :: ItemId -> Handler Value
 putItemR itemId = do
-  Item{..} <- requireCheckJsonBody
-  returnJson . Entity itemId =<< runDB
-    (updateGet itemId [ ItemKind =. itemKind
-                      , ItemNormKind =. itemNormKind
-                      , ItemBought =. itemBought
-                      , ItemExpires =. itemExpires
-                      , ItemOpened =. itemOpened
-                      ])
+  (Item{..} `WithType` t) <- requireCheckJsonBody
+  returnJson <=< runDB $ do
+    entity <- Entity itemId <$> (updateGet itemId [ ItemKind =. itemKind
+                                                  , ItemNormKind =. itemNormKind
+                                                  , ItemBought =. itemBought
+                                                  , ItemExpires =. itemExpires
+                                                  , ItemOpened =. itemOpened
+                                                  ])
+    update (itemFkType $ entityVal entity) [ KindType =. t ]
+    withType entity
 
 patchItemR :: ItemId -> Handler Value
 patchItemR itemId = do
-  diffs <- (requireCheckJsonBody :: Handler ItemDiffs)
-  returnJson . Entity itemId =<< runDB (updateGet itemId $ toUpdate diffs)
+  (itemUpdates, typeUpdates) <- toUpdate <$> (requireCheckJsonBody :: Handler ItemDiffs)
+  returnJson <=< runDB $ do
+    entity <- Entity itemId <$> updateGet itemId itemUpdates
+    update (itemFkType $ entityVal entity) typeUpdates
+    withType entity
 
 deleteItemR :: ItemId -> Handler ()
 deleteItemR = runDB . delete
-- 
cgit v1.2.3