tl;dr: is it possible to use any of the lens family of abstractions to wrap/unwrap any arbitrary newtype (that provides an instance for such abstractions)?
I'll motivate my question by a simple example, based on a true story. Suppose I define the following newtype:
newtype FreeMonoid a = FreeMonoid { asMap :: Map a Int }
which is used to represent terms of the form:
a0 <> a1 <> ... <> an-1
We can represent free-monoids as lists:
instance Ord a => IsList (FreeMonoid a) where
type Item (FreeMonoid a) = a
fromList xs = FreeMonoid $ Map.fromListWith (+) $ zip xs (repeat 1)
toList (FreeMonoid p) = do
(x, n) <- Map.toList p
genericReplicate n x
Two examples of free-monoids are sequences of sum and sequences of products:
type FreeSum a = FreeMonoid (Sum a)
type FreeProduct a = FreeMonoid (Product a)
Where Sum and Product are defined in Data.Monoid. Now we could define fromList and toList operations for FreeSum and
FreeProduct as follows:
fromListSum :: Ord a => [a] -> FreeSum a
fromListSum = fromList . (Sum <$>)
fromListProduct :: Ord a => [a] -> FreeProduct a
fromListProduct = fromList . (Product <$>)
But this has quite a lot of boilerplate. It'd be nicer if we could simply say:
fromListW :: (Ord a, Wrapper f) => [a] -> FreeMonoid (f a)
fromListW = fromList . (wrap <$>)
where wrap is some operation of the (hypotetical) Wrapper class were:
wrap :: a -> f a
unwrap :: f a -> a
Similarly, I'd like to be able to write a function:
toListW :: (Ord a, Wrapper f) => FreeMonoid (f a) -> [a]
toListW = (unwrap <$>) . toList
Lenses seem to provide such an abstraction in Control.Lens.Wrapped (for which Sum and Product in this example are instances of the typeclasses there!). However my attempts to understand and use the abstractions in this module have failed. For instance:
fromListW :: (Ord a, Wrapped (f a)) => [a] -> FreeMonoid (f a)
fromListW = fromList . (Wrapped <$>)
won't work since the argument is not a list of Unwrapped (f a).
So my question is:
Do lenses provide an abstraction similar to this Wrapper class?
If not, can this "scrap-your-boilerplate" problem be solved by using lenses?
The "problem" is that you're using Wrapped, which is really meant to be a convenience pattern synonym and not a wrapping "constructor". Because it's designed to support polymorphic wrapping, you need to assert that your type can be rewrapped:
fromListW :: (Rewrapped a a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . (Wrapped <$>)
This then works as expected:
> let x = [1,2,3]
> fromListW x :: FreeMonoid (Sum Int)
FreeMonoid {asMap = fromList [(Sum {getSum = 1},...
> fromListW x :: FreeMonoid (Product Int)
FreeMonoid {asMap = fromList [(Product {getProduct = 1},...
>
I think a more idiomatic lens implementation would be:
fromListW :: (Rewrapped a a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . view (mapping _Unwrapped)
This still requires the Rewrapped a a constraint, but you can use the non-polymorphic _Unwrapped' instead:
fromListW :: (Wrapped a, Ord a) => [Unwrapped a] -> FreeMonoid a
fromListW = fromList . view (mapping _Unwrapped')
which looks a little more natural.
The toListW implementation would have similar structure:
toListW :: (Wrapped a, Ord a) => FreeMonoid a -> [Unwrapped a]
toListW = view (mapping _Wrapped') . toList
Related
I have the following data type defined:
data SynthesisTreeResult comp a = CompNode (comp a) [SynthesisTreeResult comp a]
| InputLeaf Location
I want to be able to turn it into a list of type [comp a] using toList, which requires an instance of Foldable.
I tried to write an instance by implementing foldMap:
class Foldable f where
foldMap :: Monoid m => (a -> m) -> f a -> m
However, since comp :: * -> *, I have to write instance Foldable (SynthesisTreeResult comp) where ..., which causes foldMap to have following type
foldMap :: Monoid m => (a -> m) -> SynthesisTreeResult comp a -> m
But I need
foldMap :: Monoid m => (comp a -> m) -> SynthesisTreeResult comp a -> m
to be able to fold it.
Is it possible? Maybe I need to impose Functor on comp?
Thanks to #Willem Van Onsem hint, I figured out the proper instance:
instance Foldable comp => Foldable (SynthesisTreeResult comp) where
foldMap f (CompNode comp children) = mappend (foldMap f comp) $ mconcat $ map (foldMap f) children
Given your comment that you want a comp a instead of an a, you need to make a minor change to your type:
data SynthesisTreeResult t = CompNode t [SynthesisTreeResult t]
| InputLeaf Location
That's necessary because the type that comes out of foldMap is always the last type parameter of the type that went in. Fixing the usages of your type is easy; just change SynthesisTreeResult Foo Bar to SynthesisTreeResult (Foo Bar) everywhere. With that change, here's your Foldable instance:
instance Foldable SynthesisTreeResult where
foldMap f (CompNode x xs) = f x <> foldMap (foldMap f) xs
foldMap _ (InputLeaf _) = mempty
If that change to your type isn't acceptable, then you can't use Foldable to get what you want, and you need to write your own toList method, which you could do like this:
myToList :: SynthesisTreeResult comp a -> [comp a]
myToList (CompNode x xs) = x:concatMap myToList xs
myToList (InputLeaf _) = []
Is there a safe equivalent of maximum in Haskell's Standard Library?
*Main Control.Monad.State Data.List> maximum []
*** Exception: Prelude.maximum: empty list
I tried to find one, (Ord a, Foldable t) => t a -> Maybe a with hoogle, but found none.
For the sake of completeness: loosening your "Standard Library" requirement to "some very commonly used library", the safe package provides the Safe.Foldable module, which includes a maximumMay function:
maximumMay :: (Foldable t, Ord a) => t a -> Maybe a
You can code one up yourself for any Foldable, by applying foldMap to a suitable choice of Monoid.
The Option monoid takes an existing Semigroup and lifts it into a Monoid by adjoining an empty element (Option Nothing), which'll be returned by foldMap if the input Foldable is empty. The Max newtype lifts any instance of Ord into a Semigroup by making <> pick the larger of its arguments.
So by foldMapping the input Foldable through the composition of Option and Max, we get your desired behaviour.
safeMaximum :: (Foldable t, Ord a) => t a -> Maybe a
safeMaximum = fmap getMax . getOption . foldMap (Option . Just . Max)
ghci> safeMaximum "wowzers"
Just 'z'
ghci> safeMaximum ""
Nothing
You could create your own:
maximumMaybe :: (Ord a, Foldable f) => f a -> Maybe a
maximumMaybe xs
| null xs = Nothing
| otherwise = Just $ maximum xs
Previous Answer (not foldable):
maximumMaybe :: Ord a => [a] -> Maybe a
maximumMaybe xs = listToMaybe xs *> Just (maximum xs)
Or if you like point-free style:
maximumMaybe :: Ord a => [a] -> Maybe a
maximumMaybe = (<*) . Just . maximum <*> listToMaybe
Another, simpler, solution is:
maximumMaybe :: Ord a => [a] -> Maybe a
maximumMaybe [] = Nothing
maximumMaybe xs = Just $ maximum xs
I am trying to write my own foldMap function as an excersice to learn Haskell
Currently it looks like this
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold (<>) mempty (fmap g a)
However when compiling it it gives the following error
Could not deduce (Monoid ((f m -> m) -> fm -> m)) arising from use of 'fold'
from the context (Foldable f) bound by the class declaration for 'Foldable' at (file location)
or from (Monoid m) bound by the type signature for foldMap :: Monoid m => (a -> m) -> f a -> m at (file location
In the expression fold (<>) mempty (fmap g a)
In an equation for 'foldMap':
foldMap g a = fold (<>) mempty (fmap g a)
I can't figure out what the compiler is trying to tell me with this error, can anyone tell me what goes wrong with my foldMap?
Maybe we should do an answer with the actual solution:
I hope it's now clear, that this is a possible definition:
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
follow the types
Andrew and Lee already gave you a high level explanation but maybe I can give you another view on it:
Let's just follow the types to oget to this answer:
We want a function f a -> m where m is a monoid and f is a functor. In addition we have a function g :: a -> m we can use to get from some a into the monoid - nice.
Now we get some additional functions:
fold :: f m -> m from our own class
fmap :: (a -> b) -> f a -> f b from the Functor f
Ok we need f a -> m now if only the a would be an m then we could use fold ... dang.
But wait: we can make a a into a m using g- but the a is packed into f ... dang.
Oh wait: we can make a f a into a f m using fmap .... ding-ding-ding
So let's do it:
make f a into f m: fmap g a
use fold on it: fold (fmap g a)
or using $:
foldMap g a = fold $ fmap g a
example
Let's get something so we can try:
module Foldable where
import Data.Monoid
class Functor f => Foldable f where
fold :: Monoid m => f m -> m
foldMap :: Monoid m => (a -> m) -> f a -> m
foldMap g a = fold $ fmap g a
instance Foldable [] where
fold [] = mempty
fold (x:xs) = mappend x (fold xs)
here is a simple example using this with Sum and [1..4]:
λ> foldMap Sum [1..4]
Sum {getSum = 10}
which seems fine to me.
A Monoid has two functions, mappend and mempty, and you can use (<>) in place of mappend.
Typeclasses work because the compiler inserts the appropriate definition for the function depending on the types of the data, so (happily) there's no need to pass around the function in question.
The mistake you've made is to unnecessarily pass the Monoid functions you're using in.
For example, if I defined a function to test if something was in a list like this:
isin :: Eq a => a -> [a] -> Bool
isin equalityFunction a list = any (equalityFunction a) list
I'd have unnecessarily tried to pass the equalityFunction as an argument, and the type signature doesn't match it.
Instead I should define
isin :: Eq a => a -> [a] -> Bool
isin a list = any (== a) list
using the standard name for the equality function as defined in the Eq typeclass.
Similarly, you neither need nor should pass the (<>) or empty arguments.
I wondered if there is a defined typeclass in Haskell, which declares concatenation.
For lists there is ++ and concat. But of course there are other types which are concatable.
Example:
type Valuater = A -> [Int]
concatValuater :: [Valuater] -> Valuater
concatValuater vs = \a -> concat [v a | v <- vs]
Isn't there a typeclass for concat?
Most likely you'd like to take a look at Monoid
class Monoid a where
mempty :: a
mappend :: a -> a -> a
mconcat :: [a] -> a
As #JAbrahamson has said, Monoid is precisely the type class you're looking for. For your case, you'd be able to implement it like this:
newtype Valuater = Valuater {
evalValuater :: A -> [Int]
}
instance Monoid Valuater where
mempty = Valuater (const [])
mappend (Valuater f) (Valuater g) = Valuater (\a -> f a ++ g a)
mconcat vs = Valuater (\a -> concatMap (`evalValuater` a) vs)
Then you can use all the Monoid related functions on Valuaters.
In fact, you can make this a bit more general:
newtype Valuater' m = Valuater {
evalValuater :: A -> m
}
instance Monoid m => Monoid (Valuater' m) where
mempty = Valuater (const mempty)
mappend (Valuater f) (Valuater g) = Valuater (\a -> f a <> g a)
mconcat vs = Valuater (\a -> mconcat $ map (`evalValuater` a) vs)
type Valuater = Valuater' [Int]
And now you can have a Valuater' work across different monoids very easily, but I don't know if this is particularly useful for approaching your specific problem.
Given two monads, Monad m and Monad n, I would like to transform m (n a) into n (m a). But there seems to be no generic way because both (>>=) and return deals with only one monad type, and although (>>=) allows extracting content from a monad, you must pack them back to the same monad type so it can be a result value.
However, if we set m to a fixed type, the job becomes easy. Take Maybe as an example:
reorder :: (Monad n) => Maybe (n a) -> n (Maybe a)
reorder Nothing = return Nothing
reorder (Just x) = do
x' <- x
return $ Just x'
Or a list:
reorder :: (Monad n) => [n a] -> n [a]
reorder [] = return []
reorder (x:xs) = do
x' <- x
xs' <- reorder xs
return (x':xs')
Not hard to see, we've got a pattern here. To be more obvious, write it in a Applicative way, and it's no more than applying the data constructor to each element:
reorder (Just x) = Just <$> x
reorder (x:xs) = (:) <$> x <*> (reorder xs)
My question is: does a haskell typeclass already exist to describe such operations, or do I have to invent the wheel myself?
I had a brief search in the GHC documentation, and found nothing useful for this topic.
Data.Traversable provides what you are looking for:
sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
GHC even provides support for automatically deriving instances:
{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
import Data.Foldable
import Data.Traversable
data List a = Nil | Cons a (List a)
deriving(Functor, Foldable, Traversable)
A quick search on hoogle for (Monad m, Monad n) => m (n a) -> n (m a) showed me that there are several functions that (roughly) comply with the signature you're looking for:
Data.Traversable.sequence :: (Traversable t, Monad m) => t (m a) -> m (t a);
Data.Traversable.sequenceA :: Applicative f => t (f a) -> f (t a);
Contro.Monad.sequence :: Monad m => [m a] -> m [a] (also exported by Prelude).
Both [a] and Maybe a are instances of traversable, so your reorder functions are just applications of Data.Traversable.sequence. One could write, in example:
ghci> (Data.Traversable.sequence $ Just (return 1)) :: IO (Maybe Int)
Just 1
it :: Maybe Int
ghci> (Data.Traversable.sequence $ Just ([1])) :: [Maybe Int]
[Just 1]
it :: [Maybe Int]
ghci> (Data.Traversable.sequence $ [Just 1]) :: Maybe [Int]
Just [1]
it :: Maybe [Int]
Please note however that the specific class declaration is class (Functor t, Foldable t) => Traversable t, and if you look also at the types of the other two functions, it does not seems like what you're looking for could possibly be done in a generic way for all monads m and n without restrictions/preconditions.
It can't be done in general: a good example of a monad that can't do this is the reader (or function) monad. That would require the following function to be definable:
impossible :: (r -> IO a) -> IO (r -> a)
It's not straightforward to prove that a function cannot be implemented. But intuitively, the problem is that whatever IO has to be done in the value returned has to be done before we know what the r parameter is. So impossible readFile would have to yield a pure function FilePath -> String before it knew which files to open. Clearly, at least, impossible can't do what you'd want it to.
Not all Monads can commute in that way. Edward Kmett's distributive package provides a typeclass Distributive for type constructors that is similar to what you desire (simplified):
class Functor g => Distributive g where
distribute :: Functor f => f (g a) -> g (f a)
collect :: Functor f => (a -> g b) -> f a -> g (f b)
Default definitions are provided for distribute and collect, written in terms of each other. I found this package by searching hayoo for the desired type signature.