1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.Service.Notification
    3   ( Notifications(..)
    4   , initNotifications
    5   , triggerNotifications
    6   ) where
    7 
    8 import Control.Concurrent.MVar (MVar, newMVar, tryPutMVar, tryTakeMVar)
    9 import Control.Monad (unless)
   10 import qualified Data.ByteString as BS
   11 import qualified Text.Regex.Posix as Regex
   12 
   13 import Databrary.Model.Periodic (Period)
   14 import qualified Databrary.Store.Config as C
   15 
   16 data Notifications = Notifications
   17   { notificationsTrigger :: !(MVar (Maybe Period))
   18   , notificationsFilter :: !Regex.Regex
   19   , notificationsCopy :: !(Maybe BS.ByteString)
   20   }
   21 
   22 initNotifications :: C.Config -> IO Notifications
   23 initNotifications conf = do
   24   t <- newMVar Nothing -- run async notification pass at boot
   25   return Notifications
   26     { notificationsTrigger = t
   27     , notificationsFilter = Regex.makeRegexOpts Regex.compIgnoreCase Regex.blankExecOpt (conf C.! "filter" :: BS.ByteString)
   28     , notificationsCopy = conf C.! "copy"
   29     }
   30 
   31 triggerNotifications :: Maybe Period -> Notifications -> IO ()
   32 triggerNotifications p Notifications{ notificationsTrigger = t } = write p where
   33   -- poor man's LVar: would be much simpler with a nested MVar, but then the reader is harder (and ours is dumb anyway)
   34   write x = do
   35     r <- tryPutMVar t x
   36     unless r $ do
   37       y <- tryTakeMVar t
   38       write $ maybe id max y x