How do I write the Traversable instance for ((->) a)?
I think I could do it, if I could generically unwrap an Applicative Functor:
instance Traversable ((->) k) where
-- traverse :: (a -> f b) -> (k -> a) -> f (k -> b)
-- traverse h t = ?
-- h :: Applicative f => a -> f b
-- t :: k -> a
-- h . t :: k -> f b
-- unwrap . h . t :: k -> b
-- pure $ unwrap . h . t :: f (k -> b)
traverse h t = pure $ unwrap . h . t
unwrap :: (Functor f, Applicative f) => f a -> a
unwrap y#(pure x) = x
But, alas, GHC won't let me get away with that:
Parse error in pattern: pure
Generally there is no such thing as unwrap, consider f being the list functor [] what should unwrap return for [_, _, _] or better yet for the empty list []? Similar thing with Maybe, suppose h is const Nothing, you would expect to get Nothing. But your line of thought would fail upon trying to unwrap the Nothing into a value a. You can notice that trying to apply pure (to re-pack the result in the functor) means that you expect the result to be always Just for Maybe functor, non-empty for [] etc.
There is little hope for Traversable instance for a reader functor ((->) k). While it is not proof, a good evidence in that direction is that such an instance is missing from the Prelude. Also to traverse a function and produce a final container ([] or Maybe) you would need to apply your function h to any thinkable output of the function, that is a lot of potential values, in general infinitely many.
Prelude> traverse (\n -> if n == 42 then Nothing else Just n) [1, 2, 3]
Just [1,2,3]
Prelude> traverse (\n -> if n == 42 then Nothing else Just n) [1..]
Nothing
suppose that k is Int, so the functor is Int ->, suppose you have a value g :: Int -> Int, let it be \n -> if n == 42 then 0 else n, suppose you wanted to traverse that value with the above function, that traversal would be Nothing if g outputs 42 for any input, but it doesn't. The traversal cannot know that though (it has no access to the code of the function), so it would have to try all outputs.
If k were finite, then you could traverse a function by tabulating it. After traversing the table you could possibly produce a result. This may not be what you are after but:
import Data.Char
import Data.Maybe
import Data.Word
instance ( Enum k, Bounded k ) => Foldable ((->) k) where
foldMap h f = foldMap (h . f) domain
instance ( Enum k, Bounded k, Eq k ) => Traversable ((->) k) where
traverse h f = fmap (\vs k -> fromJust $ k `lookup` zip domain vs) (traverse (h . f) domain)
domain :: ( Enum k, Bounded k ) => [k]
domain = enumFromTo minBound maxBound
tabulate :: ( Enum k, Bounded k ) => (k -> a) -> [(k, a)]
tabulate f = zip domain (map f domain)
f1 :: Bool -> Int
f1 b = if b then 42 else 666
f2 :: Ordering -> Char
f2 LT = 'l'
f2 EQ = 'e'
f2 GT = 'g'
f3 :: Word8 -> Bool
f3 n = fromIntegral n < 256
f4 :: Word16 -> Bool
f4 n = fromIntegral n < 256
main = do
print (tabulate f1)
print (tabulate <$> traverse (\n -> [n, 2*n]) f1)
putStrLn ""
print (tabulate f2)
print (tabulate <$> traverse (\c -> [c, toUpper c]) f2)
putStrLn ""
print (tabulate f3)
print (tabulate <$> traverse (\b -> if b then Just b else Nothing) f3)
putStrLn ""
print (tabulate <$> traverse (\b -> if b then Just b else Nothing) f4)
But, alas, GHC won't let me get away with that:
It seems your error is that you tried to use a function (pure) as a pattern. Haskell only allows constructors to appear in patterns. So
unwrap (Just x) = x
is valid, while
unwrap (pure x) = x
is not.
Related
I wound up with this skeleton:
f :: (Monad m) => b -> m ()
f x = traverse_ (f . g x) =<< h x -- how avoid explicit recursion?
g :: b -> a -> b
-- h :: (Foldable t) => b -> m (t a) -- why "Could not deduce (Foldable t0) arising from a use of ‘traverse_’"
h :: b -> m [a]
How can I avoid the explicit recursion in f?
Bonus: When I try to generalize h from [] to Foldable, f does not type check (Could not deduce (Foldable t0) arising from a use of ‘traverse_’) -- what am I doing wrong?
UPDATE:
Here's the real code. The Right side is for recursing down directories of security camera footage whose names are integers. Left is the base case to process leaves whose names are not integers.
a <|||> b = left a . right b
doDir (Right d) = traverse_ (doDir . doInt) =<< listDirectory d
where doInt s = ((<|||>) <$> (,) <*> const) (d </> s) $ (TR.readEither :: String -> Either String Int) s
f = doDir and g ~ doInt but got refactored a little. h = listDirectory. to answer the bonus, i was just being silly and wasn't seeing that i had to combine all the definitions to bind the types together:
f :: (Monad m, Foldable t) => (b -> a -> b) -> (b -> m (t a)) -> b -> m ()
f g h x = traverse_ (f g h . g x) =<< h x
If you don't mind leaking a bit of memory building a Tree and then throwing it away, you can use unfoldTreeM:
f = unfoldTreeM (\b -> (\as -> ((), g b <$> as)) <$> h b)
I do not believe there is a corresponding unfoldTreeM_, but you could write one (using explicit recursion). To generalize beyond the Tree/[] connection, you might also like refoldM; you can find several similar functions if you search for "hylomorphism" on Hackage.
I have come across several situations where I would like to use applicative style f <$> x1 <*> x2 <*> x3 but scanning the applicative arguments right to left instead of the usual left to right.
Naturally, if I bring this into a monadic context, I can do this without problem:
liftM3' :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3' f x1 x2 x3 = do { x3' <- x3; x2' <- x2; x1' <- x1; return f x1' x2' x3' }
So, for my question: is there some general method to accomplish this in the context of only Applicative (perhaps a newtype wrapper) and if not, why can there not be one. That said, any insight about elegant solutions or workarounds to this problem are welcome.
Aside: My solution had been to define new right associative operators, but the solution was by no means elegant.
Edit: Here is my solution (I'd be interested in knowing if there is something equivalent in the standard libraries), if I require Monad:
newtype Reverse m a = Reverse (m a)
instance Monad m => Functor (Reverse m) where
f `fmap` x = pure f <*> x
instance Monad m => Applicative (Reverse m) where
pure x = Reverse $ return x
(Reverse f) <*> (Reverse x) = Reverse $ do { x' <- x; f' <- f; return $ f' x' }
The Backwards type is like your Reverse, and in a semi-standard package.
Naturally, if I bring this into a monadic context, I can do this without problem:
Don't forget that f is just a function. As such, you can simply define another function that takes the arguments in another order and then fall back to the usual applicative combinators:
-- | Lifts the given function into an applicative context.
-- The applicative effects are handled from right-to-left
-- e.g.
-- >>> liftA3 (\_ _ _ -> ()) (putStr "a") (putStr "b") (putStr "c")
-- will put "cba" on your console.
liftA3Rev :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3Rev f x y z = f' <$> z <*> y <*> x
where
f' = \c b a -> f a b c
It's probably either impossible, or quite hard to write this with operators only, though. This is due to the nature of partial application. Remember that for f :: Int -> Char -> Bool and Applicative f => f Int, the expression f <$> x
has type Applicative f => f (Char -> Bool). We always "lose" types on the left end, not on the right end. If you change the order of arguments, it's easy again:
(>*>) :: Applicative f => f a -> f (a -> b) -> f b
(>*>) = flip (<*>)
infixr 4 >*> -- right associative
liftA3Rev' :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3Rev' f x y z = z >*> y >*> x >*> pure f
The Traversable Paper gives an example on page 18-19 of fusing monoidal and monadic traversals which sounds really interesting but I'm confused by their LaTex.
cciBody :: Char -> Count a
wciBody :: Char -> (|M| (State Bool) DotInASquare Count) a
With the amazing result that:
(traverse cciBody) xInACircle (traverse wciBody)
Is the same as:
traverse (cciBody xInACircle wciBody)
I think the type of that result is:
Count XInASquare (|M| (State Bool) DotInASquare Count) [a]
But not 100% sure. Could someone who speaks Emoji tell me how it should look in Haskell?
Update
I think xInACircle might be an infix sequenceA. The types kind of match up. Or maybe it's just (,) which is an instance of Traversable. It's definitely not <*> even though the result looks a bit like t (x <*> y) = t x <*> t y but they don't use a Wingding for <*> in the paper.
Update 2
The type of xInACircle is (Functor m, Functor n) ⇒ (a → m b) → (a → n b) → (a → (m XInASquare n) b). Remind you of anything? Not me.
You're getting confused about operators used in type signatures. Basically, the same rules from Haskell syntax hold for these: first priority is parentheses, second priority is "application", last priority is "operators". So just as you might write:
f 3 + g 4
[which in mathematical terms we'd write as f(3) + g(4)], in Haskell there is a flag to enable infix type operators (-XTypeOperators) beginning with colons, so that you can write an expression like f :: a :* b -> b :* [a] in place of f :: Star a b -> Star b [a]. It's just an alternative syntax for a parametric type constructor with at least two parameters. (I guess since -> is already an infix type constructor this is hardly news.) We can also write these as Comp a b and Prod a b.
The up-arrows and down-arrows are functions defined within the paper as part of a type class, but I don't like all of the pragmas that we need in order for Haskell to actually accept those functions, so I'm going to explicate them in this code. Here are all of the relevant definitions as a valid Haskell file using Comp and Prod instead of their operators:
import Control.Applicative (Applicative, (<$>), (<*>), pure, WrappedMonad(..), Const(..))
import Data.Traversable (traverse)
import Control.Monad.State.Lazy (State, state, runState)
import Data.Char (isSpace)
import Data.Monoid (Monoid(..))
instance Monoid Integer where
mempty = 0
mappend = (+)
-- chained functors
newtype Comp m n a = Comp {runComp :: m (n a)}
instance (Functor m, Functor n) => Functor (Comp m n) where
fmap f = Comp . fmap (fmap f) . runComp
instance (Applicative m, Applicative n) => Applicative (Comp m n) where
pure = Comp . pure . pure
Comp mnf <*> Comp mnx = Comp ((<*>) <$> mnf <*> mnx)
-- outer product of functors
data Prod m n a = Prod {pfst :: m a, psnd :: n a}
instance (Functor m, Functor n) => Functor (Prod m n) where
fmap f (Prod ma na) = Prod (fmap f ma) (fmap f na)
instance (Applicative m, Applicative n) => Applicative (Prod m n) where
pure x = Prod (pure x) (pure x)
Prod mf nf <*> Prod mx nx = Prod (mf <*> mx) (nf <*> nx)
-- page 19,20
type Count = Const Integer
count :: a -> Count b
count _ = Const 1
cciBody :: Char -> Count a
cciBody = count
cci :: String -> Count [a]
cci = traverse cciBody
test :: Bool -> Integer
test b = if b then 1 else 0
lciBody :: Char -> Count a
lciBody c = Const (test (c == '\n'))
lci :: String -> Count [a]
lci = traverse lciBody
wciBody :: Char -> Comp (WrappedMonad (State Bool)) Count a
wciBody c = Comp (fmap Const (WrapMonad $ state $ updateState c)) where
updateState :: Char -> Bool -> (Integer, Bool)
updateState c w = let s = not (isSpace c) in (test (not w && s), s)
wci :: String -> Comp (WrappedMonad (State Bool)) Count [a]
wci = traverse wciBody
runWci :: String -> Integer
runWci s = fst $ runState (fmap getConst $ unwrapMonad $ runComp $ wci s) False
If you're not clear where any functions come from I've restricted the imports up-top, so look up there (or use Hoogle) to find their definitions.
The operator you're calling xInACircle is an operator which takes an a -> m b and an a -> n b and produces a function a -> Prod m n b. This product type contains both results of both applicatives m and n. Once you understand the x-in-a-square type you'll understand the x-in-a-circle operator. Basically unlike the (Monoid m) => Applicative ((,) m) instance, which only fmaps and <*>s over its second argument, the Prod of two abstract-functors is a pair-functor which fmaps and <*>s over both its arguments. It is the pair (m a, n a) where both m and n are applicative.
András Kovács proposed this question in response to an answer to a previous question.
In a lens-style uniplate library for types of kind * -> * based on the class
class Uniplate1 f where
uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)
analogous to the class for types of kind *
class Uniplate on where
uniplate :: Applicative m => on -> (on -> m on) -> m on
is it possible to implement analogs to contexts and holes, which both have the type Uniplate on => on -> [(on, on -> on)] without requiring Typeable1?
It's clear that this could be implemented in the old-style of the uniplate library which used Str to represent the structure of the data by returning a structure with a type-level list of the types of the children.
A hole could be represented by the following data type, which would replace (on, on -> on) in the signatures for contexts and holes
data Hole f a where
Hole :: f b -> (f b -> f a) -> Hole f a
holes :: Uniplate1 f => f a -> [Hole f a]
...
However, it is unclear if there is an implementation for holes which doesn't require Typeable1.
The suggested type Hole is needlessly restrictive in the return type of the function. The following type can represent everything the former Hole represents, and more, without loss of any type information.
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
data Hole f a where
Hole :: f b -> (f b -> a) -> Hole f a
If we need to have a return type of f a, we can use Hole f (f a) to represent it. Since we will be using Holes a lot, it'd be nice to have a few utility functions. Because the return type of the function in Hole is no longer constrained to be in f, we can make a Functor instance for it
instance Functor (Hole f) where
fmap f (Hole b g) = Hole b (f . g)
contexts1 can be written for either version of Hole by replacing the constructors for tuples in the uniplate library's contexts with Hole:
contexts1 :: Uniplate1 f => f a -> [Hole f (f a)]
contexts1 x = Hole x id : f (holes1 x)
where
f xs = [ Hole y (ctx . context)
| Hole child ctx <- xs
, Hole y context <- contexts1 child]
holes1 is trickier, but can still be made by modifying holes from the uniplate library. It requires a new Replace1 Applicative Functor that uses Hole instead of a tuple. Everyhwere the second field of the tuple was modified by second (f .) we replace with fmap f for the Hole.
data Replace1 f a = Replace1 {replaced1 :: [Hole f a], replacedValue1 :: a}
instance Functor (Replace1 f) where
fmap f (Replace1 xs v) = Replace1 (map (fmap f) xs) (f v)
instance Applicative (Replace1 f) where
pure v = Replace1 [] v
Replace1 xs1 f <*> Replace1 xs2 v = Replace1 (ys1 ++ ys2) (f v)
where ys1 = map (fmap ($ v)) xs1
ys2 = map (fmap (f)) xs2
holes1 :: Uniplate1 f => f a -> [Hole f (f a)]
holes1 x = replaced1 $ descendM1 (\v -> Replace1 [Hole v id] v) x
decendM1 is defined in the preceding answer. Replace and Replace1 can be unified; how to do so is described after the examples.
Let's try some examples in terms of the code in the previous question. The following utility functions on Holes will be useful.
onHole :: (forall b. f b -> c) -> Hole f a -> c
onHole f (Hole x _) = f x
inHole :: (forall b. f b -> f b) -> Hole f a -> a
inHole g (Hole x f) = f . g $ x
Examples
We'll use the following example data and function, based on the code from the preceding questions:
example = If (B True) (I 2 `Mul` I 3) (I 1)
zero :: Expression b -> Expression b
zero x = case x of
I _ -> I 0
B _ -> B False
Add _ _ -> I 0
Mul _ _ -> I 0
Eq _ _ -> B False
And _ _ -> B False
Or _ _ -> B False
If _ a _ -> zero a
Holes
sequence_ . map (onHole print) . holes1 $ example
B True
Mul (I 2) (I 3)
I 1
Contexts
sequence_ . map (onHole print) . contexts1 $ example
If (B True) (Mul (I 2) (I 3)) (I 1)
B True
Mul (I 2) (I 3)
I 2
I 3
I 1
Replacement of each context
sequence_ . map print . map (inHole zero) . contexts1 $ example
I 0
If (B False) (Mul (I 2) (I 3)) (I 1)
If (B True) (I 0) (I 1)
If (B True) (Mul (I 0) (I 3)) (I 1)
If (B True) (Mul (I 2) (I 0)) (I 1)
If (B True) (Mul (I 2) (I 3)) (I 0)
Unifying Replace
The Replace Applicative Functor can be refactored so that it doesn't know about the type of holes for either Uniplate or Uniplate1, and instead only knows that the hole is a Functor. Holes for Uniplate were using the type (on, on -> a) and essentially using fmap f = second (f .); this is the composition of the (on, ) and on-> functors.
Instead of grabbing Compose from the transformers library, we'll make a new type for a Hole for Uniplate, which will make the example code here be more consistent and self-contained.
data Hole on a = Hole on (on -> a)
instance Functor (Hole on) where
fmap f (Hole on g) = Hole on (f . g)
We'll rename our Hole from before to Hole1.
data Hole1 f a where
Hole1 :: f b -> (f b -> a) -> Hole1 f a
instance Functor (Hole1 f) where
fmap f (Hole1 b g) = Hole1 b (f . g)
Replace can drop all knowledge of either type of hole.
data Replace f a = Replace {replaced :: [f a], replacedValue :: a}
instance Functor f => Functor (Replace f) where
fmap f (Replace xs v) = Replace (map (fmap f) xs) (f v)
instance Functor f => Applicative (Replace f) where
pure v = Replace [] v
Replace xs1 f <*> Replace xs2 v = Replace (ys1 ++ ys2) (f v)
where ys1 = map (fmap ($ v)) xs1
ys2 = map (fmap (f)) xs2
Both holes and holes1 can be implemented in terms of the new Replace.
holes :: Uniplate on => on -> [Hole on on]
holes x = replaced $ descendM (\v -> Replace [Hole v id] v) x
holes1 :: Uniplate1 f => f a -> [Hole1 f (f a)]
holes1 x = replaced $ descendM1 (\v -> Replace [Hole1 v id] v) x
I would like to union two Map instances with a monadic function. This becomes a problem because of the unionWith type signature:
unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
I'm looking for a smart way to do this. Here is my naive implementation:
monadicUnionWith :: (Monad m, Ord k) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
monadicUnionWith f mapA mapB = do
let overlapping = toList $ intersectionWith (\a b -> (a,b)) mapA mapB
mergedOverlapping <- liftM fromList $ mapM helper overlapping
return $ union (union mergedOverlapping mapA) mapB
where
helper (k, (a,b)) = do
c <- f a b
return (k, c)
Note that union is left biased
Not sure if it is more efficient, but it is somewhat cooler (as it involves storing monadic values in the map):
monadicUnionWith :: (Monad m, Ord k) => (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
monadicUnionWith f mapA mapB =
Data.Traversable.sequence $ unionWith (\a b -> do {x <- a; y <- b; f x y}) (map return mapA) (map return mapB)
And if you want you can use
(\a b -> join (liftM2 f a b))
as the parameter to unionWith, or even
((join.).(liftM2 f))