<div dir="ltr"><div><div>I think the keyword you're looking for might be 'indexed', although that also seems to be used for something different (two indices for pre and post conditions). Your functor seems to be in 'index-core' [0], and probably other places (it seems there was something in category-extras but it's unclear where it went).<br><br></div>Regards,<br><br></div>Erik<br><div><div><br>[0] <a href="http://hackage.haskell.org/package/index-core-1.0.4/docs/Control-IMonad-Core.html">http://hackage.haskell.org/package/index-core-1.0.4/docs/Control-IMonad-Core.html</a><br></div></div></div><div class="gmail_extra"><br><div class="gmail_quote">On 7 July 2017 at 06:48, Clinton Mead <span dir="ltr"><<a href="mailto:clintonmead@gmail.com" target="_blank">clintonmead@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div>Consider the illustrative code below: </div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><font face="monospace, monospace"><br></font></div><div><div><font face="monospace, monospace">{-# LANGUAGE GADTs #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE DataKinds #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE KindSignatures #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE RankNTypes #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE PolyKinds #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE StandaloneDeriving #-}</font></div></div><div><div><font face="monospace, monospace">{-# LANGUAGE UndecidableInstances #-}</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">data Param = Param1 | Param2</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">data T (p :: Param) where</font></div></div><div><div><font face="monospace, monospace">  TInt :: Int -> T Param1</font></div></div><div><div><font face="monospace, monospace">  TInteger :: Integer -> T Param1</font></div></div><div><div><font face="monospace, monospace">  TBool :: Bool -> T Param2</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">data U (p :: Param) where</font></div></div><div><div><font face="monospace, monospace">  UDouble :: Double -> U Param1</font></div></div><div><div><font face="monospace, monospace">  UString :: String -> U Param2</font></div></div><div><div><font face="monospace, monospace">  </font></div></div><div><div><font face="monospace, monospace">data F (t :: Param -> *) where</font></div></div><div><div><font face="monospace, monospace">  F :: t Param1 -> t Param2 -> F t</font></div></div><div><div><font face="monospace, monospace">  </font></div></div><div><div><font face="monospace, monospace">f :: T a -> U a</font></div></div><div><div><font face="monospace, monospace">f (TInt x) = UDouble (fromIntegral x)</font></div></div><div><div><font face="monospace, monospace">f (TInteger x) = UDouble (fromIntegral x)</font></div></div><div><div><font face="monospace, monospace">f (TBool x) = UString (show x)</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">class MyFunctor f where</font></div></div><div><div><font face="monospace, monospace">  myFmap :: (forall a. t a -> u a) -> f t -> f u</font></div></div><div><div><font face="monospace, monospace">  </font></div></div><div><div><font face="monospace, monospace">instance MyFunctor F where</font></div></div><div><div><font face="monospace, monospace">  myFmap f (F x1 x2) = F (f x1) (f x2)</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">deriving instance Show (U a)</font></div></div><div><div><font face="monospace, monospace">deriving instance (Show (t Param1), Show (t Param2)) => Show (F t)</font></div></div><div><div><font face="monospace, monospace"><br></font></div></div><div><div><font face="monospace, monospace">main = print $ myFmap f (F (TInt 42) (TBool False))</font></div></div></blockquote></div><div><br></div><div>Basically this is a sort of "higher order" functor, but I can't seem to fit it into an ordinary functor. </div><div><br></div><div>But it seems like I'm reinventing the wheel, as my code is suspiciously like `Functor` but only slightly different. </div><div><br></div><div>Has this sort of class already been created and if so what package is it in?</div><div><br></div><div><br></div></div>
<br>______________________________<wbr>_________________<br>
Haskell-Cafe mailing list<br>
To (un)subscribe, modify options or view archives go to:<br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/haskell-<wbr>cafe</a><br>
Only members subscribed via the mailman list are allowed to post.<br></blockquote></div><br></div>