{-# LANGUAGE TypeOperators #-} module Data.HMemDb.Utils ( bindO, enumElem, fixArray, liftPure, oBind, pureO, replicateO ) where import Control.Applicative (Applicative(pure), (<$>), (<*>)) import Control.Compose (oFmap, oPure, unO, (:.)(O)) import Control.Monad.Trans.Cont (Cont, cont) import Control.Monad.Trans.Maybe (MaybeT(runMaybeT)) import Data.Foldable (Foldable, for_) import Data.Maybe (catMaybes) import Data.Traversable (sequenceA) 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)