X.H.ManageHelpers: Make type of ManageHook combinators more general.

This commit is contained in:
sgf 2020-10-15 16:41:31 +03:00
parent 3a7399b56a
commit b2e16d3bf1

View File

@ -74,8 +74,8 @@ data Match a = Match Bool a
-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
-- a candidate returns a 'Just' value, effectively running only the first match -- a candidate returns a 'Just' value, effectively running only the first match
-- (whereas 'composeAll' continues and executes all matching rules). -- (whereas 'composeAll' continues and executes all matching rules).
composeOne :: [MaybeManageHook] -> ManageHook composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a
composeOne = foldr try idHook composeOne = foldr try (return mempty)
where where
try q z = do try q z = do
x <- q x <- q
@ -86,17 +86,17 @@ composeOne = foldr try idHook
infixr 0 -?>, -->>, -?>> infixr 0 -?>, -->>, -?>>
-- | q \/=? x. if the result of q equals x, return False -- | q \/=? x. if the result of q equals x, return False
(/=?) :: Eq a => Query a -> a -> Query Bool (/=?) :: (Eq a, Functor m) => m a -> a -> m Bool
q /=? x = fmap (/= x) q q /=? x = fmap (/= x) q
-- | q <==? x. if the result of q equals x, return True grouped with q -- | q <==? x. if the result of q equals x, return True grouped with q
(<==?) :: Eq a => Query a -> a -> Query (Match a) (<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
q <==? x = fmap (`eq` x) q q <==? x = fmap (`eq` x) q
where where
eq q' x' = Match (q' == x') q' eq q' x' = Match (q' == x') q'
-- | q <\/=? x. if the result of q notequals x, return True grouped with q -- | q <\/=? x. if the result of q notequals x, return True grouped with q
(</=?) :: Eq a => Query a -> a -> Query (Match a) (</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
q </=? x = fmap (`neq` x) q q </=? x = fmap (`neq` x) q
where where
neq q' x' = Match (q' /= x') q' neq q' x' = Match (q' /= x') q'
@ -104,19 +104,19 @@ q </=? x = fmap (`neq` x) q
-- | A helper operator for use in 'composeOne'. It takes a condition and an action; -- | A helper operator for use in 'composeOne'. It takes a condition and an action;
-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will -- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
-- go on and try the next rule. -- go on and try the next rule.
(-?>) :: Query Bool -> ManageHook -> MaybeManageHook (-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a)
p -?> f = do p -?> f = do
x <- p x <- p
if x then fmap Just f else return Nothing if x then fmap Just f else return Nothing
-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action. -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action. If 'p' is true, it executes the resulting action.
(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook (-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
p -->> f = do p -->> f = do
Match b m <- p Match b m <- p
if b then (f m) else mempty if b then (f m) else return mempty
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule. -- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook (-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
p -?>> f = do p -?>> f = do
Match b m <- p Match b m <- p
if b then fmap Just (f m) else return Nothing if b then fmap Just (f m) else return Nothing
@ -180,7 +180,7 @@ transience' :: ManageHook
transience' = maybeToDefinite transience transience' = maybeToDefinite transience
-- | converts 'MaybeManageHook's to 'ManageHook's -- | converts 'MaybeManageHook's to 'ManageHook's
maybeToDefinite :: MaybeManageHook -> ManageHook maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite = fmap (fromMaybe mempty) maybeToDefinite = fmap (fromMaybe mempty)