{-# LANGUAGE TemplateHaskell #-} -- | This module holds the functions to access and modify the program -- preferences in the reactive model. module Model.ReactiveModel.Preferences where -- External imports import Data.Maybe import qualified Hails.MVC.Model.ReactiveFields as RFs import Hails.MVC.Model.ReactiveFields (fieldGetter, fieldSetter, preTrue) import Hails.MVC.Model.THFields -- Internal imports import Model.Model import Model.ReactiveModel.ReactiveModelInternals import Model.ReactiveModel.ModelEvents -- A Field of type A lets us access a reactive field of type a from -- a Model, and it triggers a ModelEvent type Field a = RFs.Field a Model ModelEvent -- | Basic settings reactiveField "Language" [t|Maybe Language|] reactiveField "CheckUpdates" [t|Bool|] reactiveField "SendReports" [t|Bool|] reactiveField "FirstRun" [t|Maybe Bool|] -- | Settings with non-true preconditions for set functions -- | Notification params -- -- | Should the system notify the user? setNotificationEnabled :: ReactiveModel -> Bool -> ReactiveModel setNotificationEnabled rm n -- Nothing has changed | getNotificationEnabled rm == n = rm -- Wrong params | not n && st == StatusNotifying = rm | n && isNothing cal = rm -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { notificationEnabled = n }) ev = NotificationEnabledChanged st = status $ basicModel rm cal = getCalibrationParams rm -- | Determine whether notification is enabled getNotificationEnabled :: ReactiveModel -> Bool getNotificationEnabled = notificationEnabled . basicModel -- | Should the icon change to notify the user? setNotificationIconEnabled :: ReactiveModel -> Bool -> ReactiveModel setNotificationIconEnabled rm n -- Nothing has changed | getNotificationIconEnabled rm == n = rm -- Incorrect change | noNotificationMethod nm' = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { notificationMethods = nm' }) nm' = nm { notificationIconEnabled = n } nm = notificationMethods $ basicModel rm ev = NotificationIconEnabledChanged -- | Determine whether icon-based notification is enabled getNotificationIconEnabled :: ReactiveModel -> Bool getNotificationIconEnabled = notificationIconEnabled . notificationMethods . basicModel -- -- | Should the icon change to notify the user? -- setNotificationBubbleEnabled :: ReactiveModel -> Bool -> ReactiveModel -- setNotificationBubbleEnabled rm n -- -- Nothing has changed -- | getNotificationBubbleEnabled rm == n = rm -- -- -- Incorrect change -- | noNotificationMethod nm' = triggerEvent rm ev -- -- -- Ok -- | otherwise = triggerEvent rm' ev -- where rm' = rm `onBasicModel` (\b -> b { notificationMethods = nm' }) -- nm' = nm { notificationBubbleEnabled = n } -- nm = notificationMethods $ basicModel rm -- ev = NotificationBubbleChanged -- -- getNotificationBubbleEnabled :: ReactiveModel -> Bool -- getNotificationBubbleEnabled = notificationBubbleEnabled . notificationMethods . basicModel -- | Should the sound play to notify the user? setNotificationSoundEnabled :: ReactiveModel -> Bool -> ReactiveModel setNotificationSoundEnabled rm n -- Nothing has changed | getNotificationSoundEnabled rm == n = rm -- Incorrect change | noNotificationMethod nm' = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { notificationMethods = nm' }) nm' = nm { notificationSoundEnabled = n } nm = notificationMethods $ basicModel rm ev = NotificationSoundEnabledChanged -- | Determine whether sound notification is enabled getNotificationSoundEnabled :: ReactiveModel -> Bool getNotificationSoundEnabled = notificationSoundEnabled . notificationMethods . basicModel -- | Should a popup window be shown to notify the user? setNotificationOverlayEnabled :: ReactiveModel -> Bool -> ReactiveModel setNotificationOverlayEnabled rm n -- Nothing has changed | getNotificationOverlayEnabled rm == n = rm -- Incorrect change | noNotificationMethod nm' = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { notificationMethods = nm' }) nm' = nm { notificationOverlayEnabled = n } nm = notificationMethods $ basicModel rm ev = NotificationOverlayEnabledChanged -- | Determine whether an overlay-window will be used to notify the user getNotificationOverlayEnabled :: ReactiveModel -> Bool getNotificationOverlayEnabled = notificationOverlayEnabled . notificationMethods . basicModel -- | Change notification delay (time between detection and notification) setNotificationDelay :: ReactiveModel -> Int -> ReactiveModel setNotificationDelay rm n -- Nothing has changed | getNotificationDelay rm == n = rm -- Incorrect change | n < 1 = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { notificationDelay = n }) ev = NotificationDelayChanged -- | Obtain current notification delay getNotificationDelay :: ReactiveModel -> Int getNotificationDelay = notificationDelay . basicModel -- | Should we notify when the user slouches? setDetectionSlouchingEnabled :: ReactiveModel -> Bool -> ReactiveModel setDetectionSlouchingEnabled rm n -- Nothing has changed | getDetectionSlouchingEnabled rm == n = rm -- Incorrect change | noDetectionMethod dm' = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { detectionMethods = dm' }) dm' = dm { detectionSlouchingEnabled = n } dm = detectionMethods $ basicModel rm ev = DetectionSlouchingEnabledChanged -- | Get the current slouching notification status getDetectionSlouchingEnabled :: ReactiveModel -> Bool getDetectionSlouchingEnabled = detectionSlouchingEnabled . detectionMethods . basicModel -- | Should we notify when the user hunches? setDetectionHunchingEnabled :: ReactiveModel -> Bool -> ReactiveModel setDetectionHunchingEnabled rm n -- Nothing has changed | getDetectionHunchingEnabled rm == n = rm -- Incorrect change | noDetectionMethod dm' = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { detectionMethods = dm' }) dm' = dm { detectionHunchingEnabled = n } dm = detectionMethods $ basicModel rm ev = DetectionHunchingEnabledChanged -- | Get the current hunching notification status getDetectionHunchingEnabled :: ReactiveModel -> Bool getDetectionHunchingEnabled = detectionHunchingEnabled . detectionMethods . basicModel -- Auxiliary function that should not be exported -- -- Determine whether any notification method is enabled noNotificationMethod :: NotificationMethods -> Bool noNotificationMethod nm = not $ notificationIconEnabled nm -- || notificationBubbleEnabled nm || notificationSoundEnabled nm || notificationOverlayEnabled nm -- Auxiliary function that should not be exported -- -- Determine whether any detection method is enabled noDetectionMethod :: DetectionMethods -> Bool noDetectionMethod nm = not $ detectionSlouchingEnabled nm || detectionHunchingEnabled nm -- -- | Change the camera selection -- -- -- -- The model remains unchanged if the list is the same that the model holds -- -- currently or if any id is negative. -- setCameraList :: ReactiveModel -> [(Int, String)] -> ReactiveModel -- setCameraList rm n -- | getCameraList rm == n = rm -- | all ((0 <=) . fst) n = triggerEvent rm ev -- | otherwise = triggerEvent rm' ev -- where rm' = rm `onBasicModel` (\b -> b { cameraList = n }) -- ev = CameraListChanged -- -- getCameraList :: ReactiveModel -> [(Int, String)] -- getCameraList = cameraList . basicModel -- Invariant: it cannot be the case that the camera is changed -- and the status remains set. -- | Change the camera selection setCamera :: ReactiveModel -> Int -> ReactiveModel setCamera rm n | getCamera rm == n = rm | n < 0 = triggerEvent rm ev | otherwise = setCameraStatus rm'' Nothing where rm'' = triggerEvent rm' ev rm' = rm `onBasicModel` (\b -> b { camera = n }) ev = CameraChanged -- | Get the camera selection getCamera :: ReactiveModel -> Int getCamera = camera . basicModel -- | Change the camera status setCameraStatus :: ReactiveModel -> Maybe Bool -> ReactiveModel setCameraStatus rm n | getCameraStatus rm == n = rm | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { cameraStatus = n }) ev = CameraStatusChanged -- | Change the camera status getCameraStatus :: ReactiveModel -> Maybe Bool getCameraStatus = cameraStatus . basicModel -- | Change Calibration parameters setCalibrationParams :: ReactiveModel -> Maybe (Int, Int, Int, Int) -> ReactiveModel setCalibrationParams rm n -- Nothing has changed | getCalibrationParams rm == n = rm -- Wrong parameters | isJust n && (x < 0 || y < 0 || w < 0 || h < 0) = triggerEvent rm ev -- -- It's set to nothing, so the notification cannot be enabled | isNothing n && det = setNotificationEnabled rm'' False -- Ok | otherwise = rm'' where rm'' = triggerEvent rm' ev rm' = rm `onBasicModel` (\b -> b { calibrationParams = n }) ev = CalibrationParamsChanged det = getNotificationEnabled rm (Just (x, y, w, h)) = n -- | Get the current calibration parameters getCalibrationParams :: ReactiveModel -> Maybe (Int, Int, Int, Int) getCalibrationParams = calibrationParams . basicModel -- | Set the correction factor to be used by the detection system setCorrectionFactor :: ReactiveModel -> Int -> ReactiveModel setCorrectionFactor rm n -- Nothing has changed | getCorrectionFactor rm == n = rm -- Wrong parameters | n < 0 || n > 10 = triggerEvent rm ev -- Ok | otherwise = triggerEvent rm' ev where rm' = rm `onBasicModel` (\b -> b { correctionFactor = n }) ev = CorrectionFactorChanged -- | Get the correction factor getCorrectionFactor :: ReactiveModel -> Int getCorrectionFactor = correctionFactor . basicModel