I have turned the code into a library and put it up on github here: http://github.com/kevinjardine/polyToMonoid
The library includes two versions of the function: ptm does not require a termination function but does not allow partial evaluation either. ctm is more composable (returning a function that consumes the next parameter) and requires a termination function trm to return the result. The source includes thorough Haddock friendly comments with examples. My plan is to upload it to Hackage later this week but I wondered if anyone had any comments before I do. Kevin On Oct 11, 11:08 am, Kevin Jardine <[email protected]> wrote: > It also appears that we need type families to reconstruct the original > Haskell list system using polyToMonoid. > > instance (a ~ a') => Monoidable a [a'] where > toMonoid a = [a] > > testList = putStrLn $ show $ polyToMonoid (mempty :: [a]) "a" "b" "c" > > Given this instance of Monoidable, you can put any number of values > after > polyToMonoid (mempty :: [a]) as long as they are exactly the same > type. > > In other words, this acts exactly like the usual Haskell list, going > back to my original point that polyToMonoid is a sort of generalised > list or "a function that takes a bunch of values that can be stuck > together in some way". > > I am a bit surprised that the (a ~ a') is needed, but Haskell will > not compile this code with the more usual > > instance Monoidable a [a] where > toMonoid a = [a] > > Kevin > > On Oct 11, 9:54 am, Kevin Jardine <[email protected]> wrote: > > > Hi Oleg, > > > I've found that if I also add two other slightly scary sounding > > extensions: OverlappingInstances and IncoherentInstances, then I can > > eliminate the unwrap function *and* use your type families trick to > > avoid the outer type annotation. > > > My latest code is here: > > > {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, > > MultiParamTypeClasses, TypeFamilies #-} > > {-# LANGUAGE OverlappingInstances, IncoherentInstances #-} > > module PolyTest where > > > import Data.Monoid > > > class Monoid m => Monoidable a m where > > toMonoid :: a -> m > > > squish :: Monoidable a m => m -> a -> m > > squish m a = (m `mappend` (toMonoid a)) > > > class Monoid m => PolyVariadic m r where > > polyToMonoid :: m -> r > > > instance (Monoid m', m' ~ m) => PolyVariadic m m' where > > polyToMonoid acc = acc > > > instance (Monoidable a m, PolyVariadic m r) => PolyVariadic m (a->r) > > where > > polyToMonoid acc = \a -> polyToMonoid (squish acc a) > > > Here are three examples. The resulting notation is short enough now > > that I am no longer tempted to use CPP. > > > All you need to do is to specify the type for mempty. And even this > > can be skipped if you want to put in the specific mempty value > > (although I think that the type annotation is often better if slightly > > longer as it documents clearly what monoid the result is being mapped > > into). > > > -- [String] example > > instance Show a => Monoidable a [String] where > > toMonoid a = [show a] > > > testStringList = putStrLn $ show $ polyToMonoid (mempty :: [String]) > > True () (Just (5::Int)) > > > -- String example > > instance Show a => Monoidable a String where > > toMonoid a = show a > > > testString = putStrLn $ polyToMonoid (mempty :: String) True () (Just > > (5::Int)) > > > -- product example > > > instance Monoid Double where > > mappend = (*) > > mempty = (1.0) :: Double > > > instance Monoidable Int Double where > > toMonoid = fromIntegral > > > instance Monoidable Double Double where > > toMonoid = id > > > testProduct = putStrLn $ show $ polyToMonoid (mempty :: Double) (5 :: > > Int) (2.3 :: Double) (3 :: Int) (8 :: Int) > > > main = do > > testStringList > > testString > > testProduct > > > $ runhaskell PolyTest.hs > > ["True","()","Just 5"] > > True()Just 5 > > 276.0 > > > Kevin > > > On Oct 11, 2:39 am, [email protected] wrote: > > > > Sorry, I'm still catching up. I'm replying to first few messages. > > > > > instance Show a => Monoidable a [String] where > > > > toMonoid a = [show a] > > > > > main = putStrLn $ unwrap $ polyToMonoid [] True () (Just (5::Int)) > > > > fails to compile. > > > > The error message points to the first problem: > > > > > No instances for (Monoidable Bool [a], > > > > Monoidable () [a], > > > > ... > > > > The presence of the type variable 'a' means that the type checker > > > doesn't know list of what elements you want (in other words, the > > > context is not specific enough to instantiate the type variable > > > a). Thus, we need to explicitly tell that we wish a list of strings: > > > > > test3 = putStrLn $ unwrap $polyToMonoid ([]::[String]) True () (Just > > > > (5::Int)) > > > > Now we get a different error, which points to the real problem this > > > time: the expression `unwrap ....' appears as an argument to > > > putStrLn. That means that we are required to produce a String as a > > > monoid. Yet we specified ([]::[String]) as mempty, which is unsuitable > > > as mempty for the String monoid. If we desire the [String] monoid as > > > the result, we need to change the context. For example, > > > > > test3 = mapM_ putStrLn $ unwrap $ > > > > polyToMonoid ([]::[String]) True () (Just (5::Int)) > > > > Another example that also fails to compile (but I cannot see why): > > > > main = putStrLn $ show $ unwrap $ polyToMonoid (0::Int) (1::Int) > > > > (2::Int) (3::Int) > > > > No instance for (PolyVariadic Int (WMonoid m)) > > > > arising from a use of `polyToMonoid' > > > > The error message is informative, mentioning the type variable, > > > m. Whenever that happens, we know that we put a bounded polymorphic > > > expression in the context that is not specific enough. We need some > > > type annotations. In our case, the function 'show' can show values of > > > many types. The type checker does not know that we wish an Int monoid > > > specifically. So, we have to specialize the show function: > > > > > test4 = putStrLn $ (show :: Int -> String) $ > > > > unwrap $ polyToMonoid (0::Int) (1::Int) (2::Int) (3::Int) > > > > At this point one may wonder if this is all worth it. There are too > > > many annotations. Fortunately, if you are not afraid of one more > > > extension, the annotations can be avoided. Your example would be > > > accepted as it was written, see test3 and test4 below. > > > > > {-# LANGUAGE TypeSynonymInstances #-} > > > > {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} > > > > > module M where > > > > > import Data.Monoid > > > > > newtype WMonoid m = WMonoid{unwrap :: m} > > > > > class Monoid m => Monoidable a m where > > > > toMonoid :: a -> m > > > > > class Monoid m => PolyVariadic m p where > > > > polyToMonoid :: m -> p > > > > > instance (Monoid m', m' ~ m) => PolyVariadic m (WMonoid m') where > > > > polyToMonoid acc = WMonoid acc > > > > > instance (Monoidable a m, PolyVariadic m r) => PolyVariadic m (a->r) > > > > where > > > > polyToMonoid acc = \a -> polyToMonoid (acc `mappend` toMonoid a) > > > > > instance Show a => Monoidable a String where > > > > toMonoid = show > > > > > instance Show a => Monoidable a [String] where > > > > toMonoid a = [show a] > > > > > test2 = putStrLn $ unwrap $ polyToMonoid "" True () (Just (5::Int)) > > > > > test3 = mapM_ putStrLn $ unwrap $ polyToMonoid [] True () (Just > > > > (5::Int)) > > > > > instance Monoid Int where > > > > mappend = (+) > > > > mempty = 0 > > > > > instance Monoidable Int Int where > > > > toMonoid = id > > > > > test4 = putStrLn $ show $ > > > > unwrap $ polyToMonoid (0::Int) (1::Int) (2::Int) (3::Int) > > > > P.S. Indeed, "polyToMonoid' = unwrap . polyToMonoid" does not do what > > > one wishes to. One should regard `unwrap' as a sort of terminator of > > > the argument list. > > > > _______________________________________________ > > > Haskell-Cafe mailing list > > > [email protected]http://www.haskell.org/mailman/listinfo/haskell-cafe > > > _______________________________________________ > > Haskell-Cafe mailing list > > [email protected]http://www.haskell.org/mailman/listinfo/haskell-cafe > > _______________________________________________ > Haskell-Cafe mailing list > [email protected]http://www.haskell.org/mailman/listinfo/haskell-cafe _______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
