1 {-# LANGUAGE GeneralizedNewtypeDeriving, ViewPatterns #-}
    2 -- |
    3 -- FIXME: There is a lot of duplication of standard library tools in here.
    4 module Databrary.Ops
    5   ( useWhen -- (<?)
    6   , thenUse --   (?>)
    7   , unlessUse -- , (?!>)
    8   -- , (?$>)
    9   , thenReturn
   10   , unlessReturn -- , (?!$>)
   11   , rightJust
   12   , fromMaybeM
   13   , orElseM
   14   , flatMapM
   15   , groupTuplesBy
   16   , mergeBy
   17   ) where
   18 
   19 import Control.Applicative
   20 import qualified Data.Either.Combinators as EC
   21 
   22 -- infixl 1 <?
   23 -- infixr 1 ?!>
   24 
   25 -- |@'($>)' . guard@
   26 thenUse :: Alternative f => Bool -> a -> f a
   27 False `thenUse` _ = empty
   28 True `thenUse` a = pure a
   29 
   30 -- |@flip '(?>)'@
   31 useWhen :: Alternative f => a -> Bool -> f a
   32 _ `useWhen` False = empty
   33 a `useWhen` True = pure a
   34 
   35 -- |@'(?>)' . not@
   36 unlessUse :: Alternative f => Bool -> a -> f a
   37 True `unlessUse` _ = empty
   38 False `unlessUse` a = pure a
   39 
   40 {-# SPECIALIZE thenUse :: Bool -> a -> Maybe a #-}
   41 {-# SPECIALIZE useWhen :: a -> Bool -> Maybe a #-}
   42 {-# SPECIALIZE unlessUse :: Bool -> a -> Maybe a #-}
   43 
   44 -- |@liftM . (?>)@
   45 thenReturn :: (Applicative m, Alternative f) => Bool -> m a -> m (f a)
   46 False `thenReturn` _ = pure empty
   47 True `thenReturn` f = pure <$> f
   48 -- TODO: get rid of this
   49 
   50 -- |@'(?$>)' . not@
   51 unlessReturn :: (Applicative m, Alternative f) => Bool -> m a -> m (f a)
   52 True `unlessReturn` _ = pure empty
   53 False `unlessReturn` f = pure <$> f
   54 -- TODO: get rid of this
   55 
   56 {-# SPECIALIZE thenReturn :: Applicative m => Bool -> m a -> m (Maybe a) #-}
   57 {-# SPECIALIZE unlessReturn :: Applicative m => Bool -> m a -> m (Maybe a) #-}
   58 
   59 rightJust :: Either a b -> Maybe b
   60 rightJust = EC.rightToMaybe
   61 
   62 -- TODO: get rid of this
   63 fromMaybeM :: Monad m => m a -> Maybe a -> m a
   64 fromMaybeM _ (Just a) = return a
   65 fromMaybeM m Nothing = m
   66 
   67 infixl 3 `orElseM`
   68 
   69 -- TODO: get rid of this
   70 orElseM :: Monad m => Maybe a -> m (Maybe a) -> m (Maybe a)
   71 orElseM Nothing m = m
   72 orElseM m _ = return m
   73 
   74 -- TODO: get rid of this
   75 flatMapM :: Monad m => (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
   76 flatMapM justAction mVal = maybe (return Nothing) justAction mVal
   77 
   78 groupTuplesBy :: (a -> a -> Bool) -> [(a, b)] -> [(a, [b])]
   79 groupTuplesBy _ [] = []
   80 groupTuplesBy p ((a,b):(span (p a . fst) -> (al, l))) = (a, b : map snd al) : groupTuplesBy p l
   81 
   82 -- |
   83 -- Merge two ordered lists using the given predicate, removing EQ "duplicates"
   84 -- (left-biased)
   85 mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
   86 mergeBy _ [] l = l
   87 mergeBy _ l [] = l
   88 mergeBy p al@(a:ar) bl@(b:br) = case p a b of
   89   LT -> a : mergeBy p ar bl
   90   EQ -> mergeBy p al br
   91   GT -> b : mergeBy p al br