<div dir="auto">Does this class have any laws? From what I can tell, this is useful only as an overloading of some identifiers - I don't see what useful functions I could write in terms of this as an abstraction.<div dir="auto"><br></div><div dir="auto">Cheers,</div><div dir="auto">George</div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Sun, 11 Apr 2021, 08:49 Dannyu NDos, <<a href="mailto:ndospark320@gmail.com">ndospark320@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div>I noticed that the list indexing function, (!!), is generalizable. I'm showing some instances:<br></div><div><br></div><div>{-# LANGUAGE MultiParamTypeClasses #-}<br><br>import Data.Complex<br>import Data.Functor.Compose<br>import Data.Functor.Product<br>import Data.Functor.Sum<br>import Data.List.NonEmpty<br>import Data.Maybe<br><br>infix 9 !?<br>infixl 9 !<br><br>class Indexable i a where<br>    (!?) :: i b -> a -> Maybe b<br><br>(!) :: Indexable i a => i b -> a -> b<br>x ! n = fromJust (x !? n)<br><br>instance Indexable [] Int where<br>    [] !? _ = Nothing<br>    (x:_) !? 0 = Just x<br>    (_:xs) !? n<br>        | n < 0 = Nothing<br>        | otherwise = xs !? (n-1)<br><br>instance Indexable ((->) a) (Identity a) where<br>    f !? Identity n = Just (f n)<br><br>instance Indexable ((,) a) () where<br>    (_,x) !? _ = Just x<br><br>instance Indexable Complex Bool where<br>    (x :+ _) !? False = Just x<br>    (_ :+ y) !? True = Just y<br><br>instance (Indexable f a, Indexable g b) => Indexable (Compose f g) (a,b) where<br>    Compose z !? (m,n) = do<br>        y <- z !? m<br>        y !? n<br><br>instance (Indexable f a, Indexable g b) => Indexable (Product f g) (Either a b) where<br>    Pair x _ !? Left m = x !? m<br>    Pair _ y !? Right n = y !? n<br><br>instance (Indexable f a, Indexable g a) => Indexable (Sum f g) (Identity a) where<br>    InL x !? Identity n = x !? n<br>    InR y !? Identity n = y !? n<br><br>instance Indexable NonEmpty Int where<br>    (x :| xs) !? n = (x : xs) !? n</div><div><br></div><div><br></div></div>
_______________________________________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org" target="_blank" rel="noreferrer">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
</blockquote></div>