Index current day in main

src/Yore/DB.hs

@@ -9,6 +9,7 @@ module Yore.DB
   , Error (..)
   , initDB
   , withConn
+  , withConn'
   , DayIndex (..)
   , DayFile (..)
   , createDayFile
@@ -28,6 +29,7 @@ import GHC.Generics (Generic)
 
 import qualified Database.PostgreSQL.Opium as Opium
 
+import Data.Bifunctor (Bifunctor (..))
 import Yore.Error (Error (..))
 
 newtype DB = DB (Pool (Either Opium.ConnectionError Opium.Connection))
@@ -45,13 +47,24 @@ initDB connString = do
           maxResources
       )
 
-withConn :: DB -> (Opium.Connection -> IO (Either Opium.Error a)) -> IO (Either Error a)
+-- TODO: This should probably also do something like bracket...
+-- For now let's assume no exceptions are thrown in f.
+withConn :: DB -> (Opium.Connection -> IO (Either Error a)) -> IO (Either Error a)
 withConn (DB connPool) f =
   withResource connPool $ \case
     Left connectionError ->
       pure $ Left $ ConnectionError connectionError
     Right conn ->
-      either (Left . DBError) Right <$> f conn
+      f conn >>= \case
+        Left err -> do
+          -- rollback open transactions and release transaction level locks.
+          _ <- Opium.execute_ "ROLLBACK" conn
+          pure $ Left err
+        Right x ->
+          pure $ Right x
+
+withConn' :: DB -> (Opium.Connection -> IO (Either Opium.Error a)) -> IO (Either Error a)
+withConn' db f = withConn db $ fmap (first DBError) . f
 
 data DayIndex = DayIndex
   { day_index_id :: Int

src/Yore/Index.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Yore.Index (createEntries) where
 
@@ -14,11 +13,9 @@ import qualified Yore.DB as DB
 
 createEntries :: Day -> [(Text, FilePath)] -> Opium.Connection -> IO ()
 createEntries date urls conn = do
-  confidently $ Opium.execute_ "BEGIN" conn
   dayIndex <- confidently $ DB.createDayIndex date conn
   forM_ urls $ \(text, url) ->
     confidently $ DB.createDayFile dayIndex.day_index_id text url conn
-  confidently $ Opium.execute_ "COMMIT" conn
 
 confidently :: (Exception e) => IO (Either e a) -> IO a
 confidently action = action >>= either throwIO pure