multi color filter tail

root / Util.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
module Util 
  ( initLast
  , nop
  , (?>)
  , justWhen
  , catchWhen
  , forkIOUnmasked
  ) where

import Control.Applicative (Alternative, empty)
import Control.Arrow (first)
import Control.Concurrent (ThreadId, forkIOWithUnmask)
import Control.Exception (Exception, catchJust)
import Control.Monad (guard)

initLast :: [a] -> ([a], a)
initLast [] = error "initlast: empty list"
initLast [x] = ([], x)
initLast (x:l) = first (x:) $ initLast l

nop :: Monad m => m ()
nop = return ()

-- |@'($>)' . guard@
(?>) :: Alternative f => Bool -> a -> f a
False ?> _ = empty
True ?> a = pure a
infixr 1 ?>

justWhen :: Monad m => Bool -> m a -> m (Maybe a)
justWhen False _ = return Nothing
justWhen True r = Just <$> r

catchWhen :: Exception e => (e -> Bool) -> IO a -> IO a -> IO a
catchWhen t f h = catchJust (guard . t) f (\() -> h)

forkIOUnmasked :: IO () -> IO ThreadId
forkIOUnmasked f = forkIOWithUnmask $ \u -> u f