1 files changed, 19 insertions, 7 deletions
diff --git a/lib/Server/Frontend/Ticker.hs b/lib/Server/Frontend/Ticker.hs
index 861197a..7fc2874 100644
--- a/lib/Server/Frontend/Ticker.hs
+++ b/lib/Server/Frontend/Ticker.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE BlockArguments #-}
 
 module Server.Frontend.Ticker (tickerWidget, postTickerAnnounceR, postTickerDeleteR) where
 import           Data.Functor           ((<&>))
@@ -7,7 +8,8 @@ import           Persist                (EntityField (TickerAnnouncementArchived
                                          TickerAnnouncement (..))
 import           Server.Frontend.Routes (FrontendMessage (..), Handler,
                                          Route (..), Widget)
-import           Yesod
+import           Yesod hiding ((==.), (=.), update)
+import Database.Esqueleto.Experimental hiding ((<&>))
 
 
 tickerAnnounceForm
@@ -24,7 +26,10 @@ tickerAnnounceForm maybeCurrent = renderDivs $ TickerAnnouncement
 
 tickerWidget :: Handler Html
 tickerWidget = do
-  current <- runDB $ selectFirst [ TickerAnnouncementArchived ==. False ] []
+  current <- runDB $ selectOne do
+    ann <- from (table @TickerAnnouncement)
+    where_ (ann ^. TickerAnnouncementArchived ==. val False)
+    pure ann
 
   (widget, enctype) <-
     generateFormPost (tickerAnnounceForm (current <&> entityVal))
@@ -40,13 +45,19 @@ tickerWidget = do
 
 postTickerAnnounceR :: Handler Html
 postTickerAnnounceR = do
-  current <- runDB $ selectFirst [ TickerAnnouncementArchived ==. False ] []
+  current <- runDB $ selectOne do
+    ann <- from (table @TickerAnnouncement)
+    where_ (ann ^. TickerAnnouncementArchived ==. val False)
+    pure ann
+
   ((result, widget), enctype) <-
-    runFormPost (tickerAnnounceForm (current <&> entityVal))
+    runFormPost (tickerAnnounceForm (fmap entityVal current))
+
   case result of
     FormSuccess ann -> do
-      runDB $ do
-        updateWhere [] [ TickerAnnouncementArchived =. True ]
+      runDB do
+        update \t ->
+          set t [ TickerAnnouncementArchived =. val True ]
         insert ann
       redirect RootR
     _ -> defaultLayout
@@ -59,5 +70,6 @@ postTickerAnnounceR = do
 
 postTickerDeleteR :: Handler Html
 postTickerDeleteR = do
-  runDB $ updateWhere [] [ TickerAnnouncementArchived =. True ]
+  runDB $ update \t ->
+    set t [TickerAnnouncementArchived =. val True]
   redirect RootR