[Haskell-cafe] Avoiding code-duplication for what is roughly fmap
Mario Blažević
mblazevic at stilo.com
Tue Oct 15 14:48:20 UTC 2019
On 2019-10-04 4:06 p.m., Sebastiaan Joosten wrote:
> Using generics and default worked brilliantly, thanks! I didn't use
> higgledy, so let me know if I missed an opportunity for something. I
> just wanted to post my solution here. My only questions would be: isn't
> there a library on hackage that already does this?
There's rank2classes (http://hackage.haskell.org/package/rank2classes)
but it leans on Template Haskell rather than generics.
> However, anyone reading who just want to learn how to use generics, I
> recommend reading
> http://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#generic-programming,
> as that's basically all I needed to learn how to do this. (Nathan's link
> pointed me there, again: thanks!)
>
> For getting everything to work, I added {-#
> LANGUAGE TypeOperators, DefaultSignatures #-} (GHC is great at telling
> me what to enable).
>
> I was able to write a generic version for removing whitespace, which
> essentially is an fmap. To derive an instance, I can indeed just write:
> instance WhiteSpaced ClassItem where
>
> The most straightforward thing to do, is to write a generic GWhiteSpaced
> class and then the WhiteSpaced class. Here is what I wrote:
> class GWhiteSpaced f where
> gremoveWS :: f a -> f a -- generic version of removeWS
>
> instance GWhiteSpaced U1 where
> gremoveWS U1 = U1
> instance (GWhiteSpaced a, GWhiteSpaced b) => GWhiteSpaced (a :*: b) where
> gremoveWS (x :*: y) = gremoveWS x :*: gremoveWS y
> instance (GWhiteSpaced a, GWhiteSpaced b) => GWhiteSpaced (a :+: b) where
> gremoveWS (L1 x) = L1 $ gremoveWS x
> gremoveWS (R1 x) = R1 $ gremoveWS x
> instance (GWhiteSpaced a) => GWhiteSpaced (M1 i c a) where
> gremoveWS (M1 x) = M1 $ gremoveWS x
> instance (WhiteSpaced a) => GWhiteSpaced (K1 i a) where
> gremoveWS (K1 x) = K1 $ removeWS x
>
> class WhiteSpaced a where
> removeWS :: a -> a
> -- remove as much whitespace as possible without changing semantics
> default removeWS :: (GWhiteSpaced (Rep a), Generic a) => a -> a
> removeWS = GHC.Generics.to . gremoveWS . from
>
>
> This really helps generalize things in those cases where the
> data-structure changes, but the WhiteSpaced class is not the only class
> that follows this pattern. Naturally, I would like to:
> - avoid repeating the generic class for each fmap-like class (renaming
> method-names, simplifying expressions, etc, are all very similar functions).
> - and ideally remove the circular dependency, so I can put the generic
> classes into separate modules without getting orphaned instances for the
> specific ones.
>
> I managed to do both with a single solution. First of all, I will use a
> phantom type to keep track of which instance to use. If you haven't seen
> a phantom type: it's just a convenient way of binding type variables and
> passing those around. I'd love to use the default one in the Prelude /
> RIO, but I can never find it and getting an extra dependency is not
> worth it, so I always end up defining one:
> data Phantom k = Phantom
> I'll use this phantom type later when I create an empty datatype (as
> empty as they get) whose only purpose is to denote that I'm using the
> whitespace function. Using Phantom types, I can unambiguously define:
> class FmapLike k f where
> gmap :: Phantom k -> f a -> f a
> class FmapInstance k a where
> gmapinstance :: Phantom k -> a -> a
> Note that the *only* purpose of the type variable k here, is to enable
> reuse: by filling in different values for k, I can instantiate
> whitespaces and other fmap-like functions in the same way. Otherwise,
> FmapLike and FmapInstance just mimick GWhiteSpaced and WhiteSpaced
> respectively.
>
> My generic FmapLike function is nearly the same as my generic whitespace
> function, the only thing I add is passing the type variable around:
> instance FmapLike x U1 where
> gmap _ U1 = U1
> instance (FmapLike x a, FmapLike x b) => FmapLike x (a :*: b) where
> gmap f (x :*: y) = gmap f x :*: gmap f y
> instance (FmapLike x a, FmapLike x b) => FmapLike x (a :+: b) where
> gmap f (L1 x) = L1 $ gmap f x
> gmap f (R1 x) = R1 $ gmap f x
> instance (FmapLike x a) => FmapLike x (M1 i c a) where
> gmap f (M1 x) = M1 $ gmap f x
> instance FmapInstance x a => FmapLike x (K1 i a) where
> gmap f (K1 x) = K1 $ gmapinstance f x
>
> Now to define the WhiteSpace class as before, I just need six lines.
> Furthermore, these six lines can be in a separate file without creating
> orphaned instances:
> data WS
> class WhiteSpaced a where
> removeWS :: a -> a
> -- remove as much whitespace as possible without changing semantics
> default removeWS :: (FmapLike WS (Rep a), Generic a) => a -> a
> removeWS = GHC.Generics.to . gmap (Phantom::Phantom WS) . from
> instance WhiteSpaced a => FmapInstance WS a where
> gmapinstance _ = removeWS
> (The instance is not an orphan because WS is defined here)
>
> Note that instead of WS, I could use any other datatype token, it
> doesn't have to be an empty datatype. I'm just defining it as an empty
> datatype to make it absolutely clear that it's not storing any data. It
> also provides a good place to document what WS is actually intended for.
> As a final touch, I'm defining:
> gmapGeneric = (\x -> GHC.Generics.to . gmap x . from)
> (this shortens removeWS a little)
>
> So final question: is there any library that implements gmapGeneric or gmap?
>
> Also a big thanks to everyone who helped put Generics in Haskell. I've
> seen helpful error messages and good documentation all the way through!
>
> Best,
>
> Sebastiaan
>
>
> On Thu, Oct 3, 2019 at 6:41 PM Yuji Yamamoto
> <whosekiteneverfly at gmail.com <mailto:whosekiteneverfly at gmail.com>> wrote:
>
> Use DeriveGenerics, and higgledy
> <https://github.com/i-am-tom/higgledy> (or some packages supporting
> higher kinded data) would help you.
>
> 2019年10月4日(金) 5:56 Sebastiaan Joosten
> <sjcjoosten+haskelcafe at gmail.com
> <mailto:sjcjoosten%2Bhaskelcafe at gmail.com>>:
>
> Hi all,
>
> I'm writing a lot of code that looks like this:
> instance WhiteSpaced ClassItem where
> removeWS (Method a b c)
> = Method (removeWS a) (removeWS b) (removeWS c)
> removeWS (Declaration b) = Declaration (removeWS b)
>
> Typically, all the way at the end there's an instance that
> deviates (sometimes the deviating instances are somewhere in the
> middle). I need to do this for a lot of functions, and a lot of
> data types, and all I'm doing here is rewriting the data-type
> declaration in a different syntax (except that you do not know
> the types of a, b and c from the above). For the sake of
> maintainability, I want to avoid this code-duplication and focus
> only on the deviating instances.
>
> How to do better? I don't see how to use generics (in the hope
> of only writing 'instance WhiteSpaced ClassItem where' instead
> of the three lines above) for this: the types for a, b and c are
> all different here. Would this be easier with Template Haskell?
> (in the hope of only writing $(''something ClassItem) instead of
> the three lines above)
>
> My main concern is maintainability, an ideal solution is either
> a clear one-liner or a library import (in the same way that
> aeson allows me to use generics or Template Haskell without
> needing to know much about them). Other solutions are welcome too.
>
> Best,
>
> Sebastiaan
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
>
>
> --
> 山本悠滋
> twitter: https://twitter.com/igrep
> GitHub: https://github.com/igrep
> GitLab: https://gitlab.com/igrep
> Facebook: http://www.facebook.com/igrep
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
More information about the Haskell-Cafe
mailing list