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