{-# LANGUAGE TypeOperators #-}
module Data.HMemDb.Utils
    (
     bindO,
     brackets,
     enumElem,
     fixArray,
     liftMaybe,
     liftPure,
     oBind,
     pureO,
     replicateO
    ) where
import Control.Applicative (Applicative(pure), (<$>), (<*>))
import Control.Compose (oFmap, oPure, unO, (:.)(O))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Cont (Cont, ContT(ContT), cont)
import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
import Data.Foldable (Foldable, for_)
import Data.Maybe (catMaybes)
import Data.Traversable (sequenceA)
liftMaybe :: Monad m => Maybe a -> MaybeT m a
liftMaybe = MaybeT . return
liftPure :: (Applicative f, Applicative g) => f a -> Cont ((g :. f) b) ()
liftPure fa = cont $ \f -> const id <$> oPure fa <*> f ()
enumElem :: (Applicative f, Foldable t) => t a -> Cont (f ()) a
enumElem as = cont $ for_ as
pureO :: (Applicative f, Functor g) => g a -> (g :. f) a
pureO ga = O $ pure <$> ga
oBind :: (Functor g, Monad f) => (g :. f) a -> (a -> f b) -> (g :. f) b
oBind gfa afb = O $ (>>= afb) <$> unO gfa
bindO :: Monad m => m a -> (a -> (m :. f) b) -> (m :. f) b
bindO ma amfb = O $ ma >>= unO . amfb
fixArray :: Monad m => [a] -> (a -> m (Maybe b)) -> Cont ((m :. f) c) [b]
fixArray xs f = cont $ \h -> mapM f xs `bindO` (h . catMaybes)
replicateO :: (Applicative f, Applicative g) => (g :. MaybeT f) a -> Int -> (g :. f) [a]
replicateO gmfa len = catMaybes <$> sequenceA (replicate len $ oFmap runMaybeT gmfa)
brackets :: Monad m => m a -> (a -> m r) -> ContT r m ()
brackets before after =
    do a <- lift before
       ContT $ \f -> f () >> after a