Commits

Aleksey Khudyakov committed f5926cc

Make Fun instance of Monad

Comments (0)

Files changed (1)

Data/Vector/Fixed/Internal/Arity.hs

   , Arity(..)
   , apply
   , applyM
+    -- ** Combinators
   , apFun
   , constFun
   , stepFun
+  , shuffleFun
   ) where
 
 import Control.Applicative (Applicative(..))
 type instance Fn Z     a b = b
 type instance Fn (S n) a b = a -> Fn n a b
 
--- | Newtype wrapper which is used to make 'Fn' injective.
+-- | Newtype wrapper which is used to make 'Fn' injective. It's also a
+--   reader monad.
 newtype Fun n a b = Fun { unFun :: Fn n a b }
 
 
   {-# INLINE pure  #-}
   {-# INLINE (<*>) #-}
 
+instance Arity n => Monad (Fun n a) where
+  return  = pure
+  f >>= g = shuffleFun g <*> f
+  {-# INLINE return #-}
+  {-# INLINE (>>=)  #-}
+
+
 newtype T_fmap a b   n = T_fmap (Fn n a b)
 data    T_pure a     n = T_pure a
 data    T_ap   a b c n = T_ap (Fn n a b) (Fn n a c)
 
 
 
+----------------------------------------------------------------
+-- Combinators
+----------------------------------------------------------------
+
 -- | Apply single parameter to function
 apFun :: Fun (S n) a b -> a -> Fun n a b
 apFun (Fun f) x = Fun (f x)
 stepFun :: (Fun n a b -> Fun m a c) -> Fun (S n) a b -> Fun (S m) a c
 stepFun g f = Fun $ unFun . g . apFun f
 {-# INLINE stepFun #-}
+
+-- | Move function parameter to the result of N-ary function.
+shuffleFun :: forall n a b r. Arity n
+           => (b -> Fun n a r) -> Fun n a (b -> r)
+{-# INLINE shuffleFun #-}
+shuffleFun f0
+  = Fun $ accum (\(T_shuffle f) a -> T_shuffle $ \x -> f x a)
+                (\(T_shuffle f)   -> f)
+                (T_shuffle (fmap unFun f0) :: T_shuffle b a r n)
+
+newtype T_shuffle x a r n = T_shuffle (x -> Fn n a r)