{-# LANGUAGE LambdaCase #-} module Groot.Exception.Task where import Control.Exception.Lens import Control.Lens import Control.Monad.Catch hiding (Handler) import Data.Typeable import Groot.Types data TaskException = TaskNotFound TaskNotFound | InvalidTaskStatus InvalidTaskStatus | TaskStatusTransitionFailed TaskStatusTransitionFailed deriving (Eq, Show, Typeable) instance Exception TaskException data TaskNotFound = TaskNotFound' TaskRef (Maybe ClusterRef) deriving (Eq, Show, Typeable) instance Exception TaskNotFound taskNotFound :: TaskRef -> Maybe ClusterRef -> SomeException taskNotFound taskRef clusterRef = toException . TaskNotFound $ TaskNotFound' taskRef clusterRef data InvalidTaskStatus = InvalidTaskStatus' TaskRef TaskStatus (Maybe TaskStatus) deriving (Eq, Show, Typeable) instance Exception InvalidTaskStatus invalidTaskStatus :: TaskRef -> TaskStatus -> Maybe TaskStatus -> SomeException invalidTaskStatus taskRef currentSt desiredSt = toException . InvalidTaskStatus $ InvalidTaskStatus' taskRef currentSt desiredSt data TaskStatusTransitionFailed = TaskStatusTransitionFailed' TaskRef TaskStatus TaskStatus deriving (Eq, Show, Typeable) taskStatusTransitionFailed :: TaskRef -> TaskStatus -> TaskStatus -> SomeException taskStatusTransitionFailed taskRef currentSt desiredSt = toException . TaskStatusTransitionFailed $ TaskStatusTransitionFailed' taskRef currentSt desiredSt instance Exception TaskStatusTransitionFailed class AsTaskException t where _TaskException :: Prism' t TaskException {-# MINIMAL _TaskException #-} _TaskNotFound :: Prism' t TaskNotFound _TaskNotFound = _TaskException . _TaskNotFound _InvalidTaskStatus :: Prism' t InvalidTaskStatus _InvalidTaskStatus = _TaskException . _InvalidTaskStatus _TaskStatusTransitionFailed :: Prism' t TaskStatusTransitionFailed _TaskStatusTransitionFailed = _TaskException . _TaskStatusTransitionFailed instance AsTaskException SomeException where _TaskException = exception instance AsTaskException TaskException where _TaskException = id _TaskNotFound = prism TaskNotFound $ \case TaskNotFound e -> Right e x -> Left x _InvalidTaskStatus = prism InvalidTaskStatus $ \case InvalidTaskStatus e -> Right e x -> Left x _TaskStatusTransitionFailed = prism TaskStatusTransitionFailed $ \case TaskStatusTransitionFailed e -> Right e x -> Left x