Support types

1 files changed, 8 insertions, 9 deletions

diff --git a/Handler/ReferenceItem.hs b/Handler/ReferenceItem.hs
index 738c9f3..44cd0a8 100644
--- a/Handler/ReferenceItem.hs
+++ b/Handler/ReferenceItem.hs
@@ -4,7 +4,7 @@ import Import
 
 getReferenceItemR :: ReferenceId -> Handler TypedContent
 getReferenceItemR referenceId = do
-  entity <- runDB $ Entity referenceId <$> get404 referenceId
+  entity <- runDB $ withType =<< Entity referenceId <$> get404 referenceId
   selectRep $ do
     provideJson entity
     provideRep (redirect $ ReferenceListingR :#: referenceId :: Handler Html)
@@ -12,14 +12,13 @@ getReferenceItemR referenceId = do
 
 putReferenceItemR :: ReferenceId -> Handler Value
 putReferenceItemR referenceId = do
-  Reference{..} <- requireCheckJsonBody
-  returnJson . Entity referenceId =<< runDB
-    (updateGet referenceId [ ReferenceKind =. referenceKind
-                           , ReferenceNormKind =. referenceNormKind
-                           ])
-
-patchReferenceItemR :: ReferenceId -> Handler Value
-patchReferenceItemR = putReferenceItemR -- Just one field
+  (Reference{..} `WithType` t) <- requireCheckJsonBody
+  returnJson <=< runDB $ do
+    entity <- Entity referenceId <$> updateGet referenceId [ ReferenceKind =. referenceKind
+                                                           , ReferenceNormKind =. referenceNormKind
+                                                           ]
+    update (referenceFkType $ entityVal entity) [ KindType =. t ]
+    withType entity
 
 deleteReferenceItemR :: ReferenceId -> Handler ()
 deleteReferenceItemR = runDB . delete