diff --git a/kernmantle/src/Control/Kernmantle/Rope.hs b/kernmantle/src/Control/Kernmantle/Rope.hs index adf1572..04daa1e 100644 --- a/kernmantle/src/Control/Kernmantle/Rope.hs +++ b/kernmantle/src/Control/Kernmantle/Rope.hs @@ -110,7 +110,7 @@ newtype Rope (record::RopeRec) (mantle::[Strand]) (core::BinEff) a b = , ThrowEffect ex, TryEffect ex , SieveTrans f , HasAutoIdent eff - , Bifunctor, Biapplicative + , Functor, Bifunctor, Biapplicative ) runRope :: Rope record mantle core a b -> record (Weaver core) mantle -> core a b @@ -199,7 +199,7 @@ tighten r = mkRope $ runRope r . fromARec -- | Turn a 'TightRope' into a 'LooseRope'. This is very often the first step -- in a chain of 'weave's. -loosen :: (NatToInt (RLength m)) +loosen :: (ToARec m, NatToInt (RLength m)) => TightRope m core :-> LooseRope m core loosen r = mkRope $ runRope r . toARec {-# INLINE loosen #-} diff --git a/kernmantle/src/Control/Kernmantle/Rope/Internal.hs b/kernmantle/src/Control/Kernmantle/Rope/Internal.hs index 72587e1..990b407 100644 --- a/kernmantle/src/Control/Kernmantle/Rope/Internal.hs +++ b/kernmantle/src/Control/Kernmantle/Rope/Internal.hs @@ -19,6 +19,7 @@ import Data.Bifunctor import Data.Biapplicative import Data.Bifunctor.Tannen import Data.Functor.Identity +import Data.Kind (Type) import Data.Profunctor.Cayley import Data.Profunctor.EffFunctor import Data.Profunctor.Monad @@ -36,10 +37,10 @@ import Control.Kernmantle.Error -- | The kind for all binary effects. First param is usually an input -- (contravariant) of the effect and second one an output (covariant). -type BinEff = * -> * -> * +type BinEff = Type -> Type -> Type -- | The kind for unary effects -type UnaryEff = * -> * +type UnaryEff = Type -> Type -- | The kind for a named binary effect. Must remain a tuple because that's what -- vinyl expects. @@ -53,9 +54,9 @@ type family StrandEff t where -- | The kind for records that will contain 'Weaver's. First type param will -- most often be @Weaver someCore@ -type RopeRec = (Strand -> *) -> [Strand] -> * +type RopeRec = (Strand -> Type) -> [Strand] -> Type --- | Runs one @strand@ (* -> * -> * effect) in a @interp@ effect. Is +-- | Runs one @strand@ (Type -> Type -> Type effect) in a @interp@ effect. Is -- parameterized over a Strand (and not just a BinEffect) even if it ignores its -- name internally because that's what is expect by the 'RopeRec' newtype Weaver (interp::BinEff) (strand::Strand) = Weaver @@ -90,6 +91,9 @@ newtype RopeRunner (record::RopeRec) (mantle::[Strand]) (interp::BinEff) (core:: deriving (EffFunctor, EffPointedFunctor) via Tannen ((->) (record (Weaver interp) mantle)) +instance Functor (core a) => Functor (RopeRunner record mantle interp core a) where + fmap f (RopeRunner run) = RopeRunner $ \record -> fmap f (run record) + instance (RMap m) => EffProfunctor (RopeRunner Rec m) where effdimap f g (RopeRunner run) = RopeRunner $ g . run . rmap (mapWeaverInterp f)