{-# LANGUAGE ScopedTypeVariables, Rank2Types #-}
-- .$Header: c:/Source/Haskell/Wrapper/Data/Flex/RCS/Utils.hs,v 1.1 2010/11/26 23:54:58 dosuser Exp dosuser $
module Data.Flex.Utils (inCompose, inCompose2, bindWrapper) where

circumpose :: (c -> d) -> (a -> b) -> (b -> c) -> (a -> d)
circumpose left right = (left .) . (. right)

inCompose :: (a -> b) -> (c -> d) -> (b -> c) -> (a -> d)
inCompose = flip circumpose

inCompose2 :: (forall a. f a -> a) -> (d -> e) ->
    (b -> c -> d) -> (f b -> f c -> e)
inCompose2 unwrap wrap = inCompose unwrap $ inCompose unwrap wrap

result :: (b -> c) -> (a -> b) -> (a -> c)
result = (.)

-- Utility function to construct (>>=) for a target monad <t> from the (>>=)
-- for an implementation monad <i>
-- Parameters:
--   wrap:   function from target monad to implementation monad (t a -> i a)
--   unwrap: vice versa (i a -> t a)
bindWrapper :: (forall q. f q -> g q) -> (d -> e) -> (g a -> (c -> g b) -> d) ->
    f a -> (c -> f b) -> e
bindWrapper wrap unwrap = inCompose wrap $ inCompose (result wrap) unwrap

-- vim: expandtab:tabstop=4:shiftwidth=4