How to define fmap in a GADT Expression? - haskell

Given a simple "language":
data Expr a where
ConstE :: a -> Expr a
FMapE :: (b -> a) -> Expr b -> Expr a
instance Functor Expr where
fmap = FMapE
interpret :: Expr a -> a
interpret (ConstE a) = a
interpret (FMapE f a) = f (interpret a)
From that I would like to extract a call graph, eg:
foo = fmap show . fmap (*2) $ ConstE 1
Should result in the graph Node 1 -> Node (*2) -> Node show. Ideally I'd like to store this in a Data.Graph.
What I've come up to this point is that it should be possible to use System.Mem.StableNames to identify individual nodes and store them in a HashMap (StableName (Expr a)) (Expr a).
toHashMap :: Expr a -> HashMap (StableName (Expr a)) (Expr a)
toHashMap n#ConstE = do
sn <- makeStableName n
return $ HashMap.singleton sn n
The problem is, that there seems to be no way to get through the FMapE nodes:
toHashMap n#(FMapE _ a) = do
snN <- makeStableName n
snA <- makeStableName a
-- recurse
hmA <- toHashMap a
-- combine
return $ HashMap.singleton snN n `HashMap.union` hmA
GHC will complain along the lines of this:
Couldn't match type ‘t’ with ‘b’
because type variable ‘b’ would escape its scope
This (rigid, skolem) type variable is bound by
a pattern with constructor
FMapE :: forall a b. (b -> a) -> Expr b -> Expr a,
in an equation for ‘toHashMap’
I can see that this won't match ... but I have no clue on how to make this work.
Edit
This probably boils down to writing a children function:
children :: Event a -> [Event a]
children (ConstE) = []
children (FMapE _ a) = [a] -- doesn't match ...
For the same reason I can't uniplate on this ...

You can get a postorder traversal, which is a tolopogical sort for a tree, of a type of kind * -> * from the Uniplate1 class I've described previously.
{-# LANGUAGE RankNTypes #-}
import Control.Applicative
import Control.Monad.Identity
class Uniplate1 f where
uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)
descend1 :: (forall b. f b -> f b) -> f a -> f a
descend1 f x = runIdentity $ descendM1 (pure . f) x
descendM1 :: Applicative m => (forall b. f b -> m (f b)) -> f a -> m (f a)
descendM1 f a = uniplate1 a f
transform1 :: Uniplate1 f => (forall b. f b -> f b) -> f a -> f a
transform1 f = f . descend1 (transform1 f)
transform1 is a generic postorder tranformation. A generic postorder Monadic traversal of a Uniplate1 is
transformM1 :: (Uniplate1 f, Applicative m, Monad m) =>
(forall b. f b -> m (f b)) ->
f a -> m (f a)
transformM1 f = (>>= f) . descendM1 (transformM1 f)
We can write a Uniplate1 instance for Expr:
instance Uniplate1 Expr where
uniplate1 e p = case e of
FMapE f a -> FMapE f <$> p a
e -> pure e
We'll make a simple dump function for demonstration purposes and bypass to restore the data after a monadic effect.
dump :: Expr b -> IO ()
dump (ConstE _) = putStrLn "ConstE"
dump (FMapE _ _) = putStrLn "FMapE"
bypass :: Monad m => (a -> m ()) -> a -> m a
bypass f x = f x >> return x
We can traverse your example in topological order
> transformM1 (bypass dump) (fmap show . fmap (*2) $ ConstE 1)
ConstE
FMapE
FMapE

Related

Is there a van Laarhoven optic based on the Monad typeclass?

As I understand it, each van Laarhoven optic type can be defined by a constraint on a type constructor:
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
-- etc.
If we choose Monad as the constraint, does it form some kind of "optic" in a meaningful way?
type Something s t a b = forall f. Monad f => (a -> f b) -> s -> f t
My intuition is that the Monad constraint might be too restrictive to get any value out of a structure like this: since the Const functor is not a Monad, we can't do the trick of specializing f to Const in order to derive a view-like function. Still, we can do some things with this Something type; it's just not clear to me if we can do anything particularly useful with it.
The reason I'm curious is because the type of a van Laarhoven optic is suspiciously similar to the type of a function that modifies a "mutable reference" type like IORef. For example, we can easily implement
modifyIORefM :: MonadIO m => IORef a -> (a -> m a) -> () -> m ()
which, when partially-applied to an IORef, has the shape
type SomethingIO s t a b = forall f. MonadIO f => (a -> f b) -> s -> f t
where a = b and s = t = (). I'm not sure whether this is a meaningful or meaningless coincidence.
Practically speaking, such an optic is a slightly inconvenient Traversal.
That's because, practically speaking, we use a Traversal:
type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)
for two things. Getting a list of as from an s, which we can do with the Const functor:
toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))
and replacing the as with bs to turn the s into a t. One method is to use the State functor, and ignoring issues with matching the counts of as and bs, we have:
setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
If we instead have an optic using a Monad constraint:
type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)
we can still perform these two operations. Since State is a monad, the setListOf operation can use the same implementation:
setListOfM :: Traversal s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
For toListOf, there's no Monad instance for Const [a], but we can use a Writer monad to extract the a values, as long as we have a dummy b value to make the type checker happy:
toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)
or, since Haskell has bottom:
toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)
Self-contained code:
import Data.Functor.Const
import Control.Monad.State
import Control.Monad.Writer
type Traversal s t a b = forall f. (Applicative f) => (a -> f b) -> (s -> f t)
toListOf :: Traversal s t a b -> s -> [a]
toListOf t = getConst . t (Const . (:[]))
setListOf :: Traversal s t a b -> [b] -> s -> t
setListOf t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
type TraversalM s t a b = forall f. (Monad f) => (a -> f b) -> (s -> f t)
toListOfM :: TraversalM s t a b -> b -> s -> [a]
toListOfM t dummy_b s = execWriter (t (\a -> tell [a] >> pure dummy_b) s)
toListOfM' :: TraversalM s t a b -> s -> [a]
toListOfM' t s = execWriter (t (\a -> tell [a] >> pure undefined) s)
setListOfM :: TraversalM s t a b -> [b] -> s -> t
setListOfM t bs s = evalState (t (\a -> state (\(b:bs) -> (b, bs))) s) bs
listItems :: Traversal [a] [b] a b
listItems = traverse
listItemsM :: TraversalM [a] [b] a b
listItemsM = mapM
main = do
-- as a getter
print $ toListOf listItems [1,2,3]
print $ toListOfM listItemsM 99 [1,2,3] -- dummy value
print $ toListOfM' listItemsM [1,2,3] -- use undefined
-- as a setter
print $ setListOf listItems [4,5,6] [1,2,3]
print $ setListOfM listItemsM [4,5,6] [1,2,3]

Using ScopedTypeVariables to constrain fmap function argument

I've got the following use-case: I'm building a custom AST. As an optimization for certain operations I'm doing on the AST, I've defined a list of children for an AST node thus:
data NodeChHolder a = NNode [a] -- For "normal" operators
| ACNode (MultiSet a) -- For operators that can be re-ordered and parenthesized arbitrarily
| NCNode -- Empty, no children
Now, I want to make this type a Functor. However, there's a problem because MultiSet requires its type parameter to be Ord. So, this didn't work:
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap f (ACNode s) = ACNode $ MultiSet.map f s
fmap _ NCNode = NCNode
I got an error saying that there's "no instance for Ord b arising from a use of MultiSet.map", which is fair.
To resolve this problem, I tried the following approach using the ScopedTypeVariables ghc extension. I thought that this would work similarly to how it works with types, but it appears typeclasses are different:
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap (f :: (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
This also failed with the same error message.
Next, I tried to change it a little, because to my understanding of forall from ScopedTypeVariables, it should have made sure that the a and b type variables that I'm using are the same as for fmap.
instance Functor NodeChHolder where
fmap f (NNode l) = NNode $ map f l
fmap (f :: forall a b. (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
The above didn't work, saying it "couldn't match b with b1", because they are both "rigid type variables". I thought this was because I needed to actually declare type parameters a and b for fmap itself, so I used the InstanceSigs extension as well and ended up with
instance Functor NodeChHolder where
fmap :: (a -> b) -> NodeChHolder a -> NodeChHolder b
fmap f (NNode l) = NNode $ map f l
fmap (f :: forall a b. (Ord a, Ord b) => a -> b) (ACNode s) = ACNode $ MultiSet.map f s
fmap f (ACNode s) = NNode $ map f (MultiSet.toList s)
fmap _ NCNode = NCNode
But I still got the same error about the rigid type variables.
At this point I don't even know if what I'm trying to do is even possible! Should I give up on trying to make this a functor altogether? With InstanceSigs, I could probably do fmap :: Ord b => (a -> b) -> NodeChHolder a -> NodeChHolder b, which would fit my usecase, but that would no longer be a true functor...
You can not do this using the regular Functor class. Such class has a method
fmap :: Functor f => (a -> b) -> f a -> f b
which does not put any constraints on a and b. This requires any instance to work with any choice for a and b. Indeed, if instances were allowed to put additional requirements, then fmap could not have the type above.
You could however used another type class to represent a constrained functor.
There is one in the package constrained-monads, which allows the following code.
import qualified Control.Monad.Constrained as C
data MultiSet a = Whatever -- stub
multiSet_map :: Ord b => (a -> b) -> MultiSet a -> MultiSet b
multiSet_map = undefined -- stub
data NodeChHolder a = NNode [a]
| ACNode (MultiSet a)
| NCNode
instance C.Functor NodeChHolder where
type Suitable NodeChHolder b = Ord b
fmap f (NNode l) = NNode $ map f l
fmap f (ACNode s) = ACNode $ multiSet_map f s
fmap _ NCNode = NCNode

Haskell: What does type f a actually mean?

I have stumbled on this piece of code fold ((,) <$> sum <*> product) with type signature :: (Foldable t, Num a) => t a -> (a, a) and I got completely lost.
I know what it does, but I don't know how. So I tried to break it into little pieces in ghci:
λ: :t (<$>)
(<$>) :: Functor f => (a -> b) -> f a -> f b
λ: :t (,)
(,) :: a -> b -> (a, b)
λ: :t sum
sum :: (Foldable t, Num a) => t a -> a
Everything is okay, just basic stuff.
λ: :t (,) <$> sum
(,) <$> sum :: (Foldable t, Num a) => t a -> b -> (a, b)
And I am lost again...
I see that there is some magic happening that turns t a -> a into f a but how it is done is mystery to me. (sum is not even instance of Functor!)
I have always thought that f a is some kind of box f that contains a but it looks like the meaning is much deeper.
The functor f in your example is the so-called "reader functor", which is defined like this:
newtype Reader r = Reader (r -> a)
Of course, in Haskell, this is implemented natively for functions, so there is no wrapping or unwrapping at runtime.
The corresponding Functor and Applicative instances look like this:
instance Functor f where
fmap :: (a -> b) -> (r -> a)_-> (r -> b)
fmap f g = \x -> f (g x) -- or: fmap = (.)
instance Applicative f where
pure :: a -> (r -> a) -- or: a -> r -> a
pure x = \y -> x -- or: pure = const
(<*>) :: (r -> a -> b) -> (r -> a) -> (r -> b)
frab <*> fra = \r -> frab r (fra r)
In a way, the reader functor is a "box" too, like all the other functors, having a context r which produces a type a.
So let's look at (,) <$> sum:
:t (,) :: a -> b -> (a, b)
:t fmap :: (d -> e) -> (c -> d) -> (c -> e)
:t sum :: Foldable t, Num f => t f -> f
We can now specialize the d type to a ~ f, e to b -> (a, b) and c to t f. Now we get:
:t (<$>) -- spcialized for your case
:: Foldable t, Num f => (a -> (b -> (a, b))) -> (t f -> f) -> (t f -> (b -> (a, b)))
:: Foldable t, Num f => (f -> b -> (f, b)) -> (t f -> f) -> (t f -> b -> (f, b))
Applying the functions:
:t (,) <$> sum
:: Foldable t, Num f => (t f -> b -> (f, b))
Which is exactly what ghc says.
The short answer is that f ~ (->) (t a). To see why, just rearrange the type signature for sum slightly, using -> as a prefix operator instead of an infix operator.
sum :: (Foldable t, Num a) => (->) (t a) a
~~~~~~~~~~
f
In general, (->) r is a functor for any argument type r.
instance Functor ((->) r) where
fmap = (.)
It's easy to show that (.) is the only possible implementation for fmap here by plugging ((->) r) into the type of fmap for f:
fmap :: (a -> b) -> f a -> f b
:: (a -> b) -> ((->) r) a -> ((->) r) b
:: (a -> b) -> (r -> a) -> (r -> b)
This is the type signature for composition, and composition is the unique function that has this type signature.
Since Data.Functor defines <$> as an infix version of fmap, we have
(,) <$> sum == fmap (,) sum
== (.) (,) sum
From here, it is a relatively simple, though tedious, job of confirming that the resulting type is, indeed, (Foldable t, Num a) => t a -> b -> (a, b). We have
(b' -> c') -> (a' -> b') -> (a' -> c') -- composition
b' -> c' ~ a -> b -> (a,b) -- first argument (,)
a' -> b' ~ t n -> n -- second argument sum
----------------------------------------------------------------
a' ~ t n
b' ~ a ~ n
c' ~ a -> b -> (a,b)
----------------------------------------------------------------
a' -> c' ~ t a -> b -> (a,b)

Composing Monadic Functions with `<=<`

I'm trying to understand the <=< function:
ghci> :t (<=<)
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
As I understand it, I give it 2 functions and an a, and then I'll get an m c.
So, why doesn't this example compile?
import Control.Monad
f :: a -> Maybe a
f = \x -> Just x
g :: a -> [a]
g = \x -> [x]
foo :: Monad m => a -> m c
foo x = f <=< g x
For foo 3, I would expect Just 3 as a result.
But I get this error:
File.hs:10:15:
Couldn't match expected type `a0 -> Maybe c0'
with actual type `[a]'
In the return type of a call of `g'
Probable cause: `g' is applied to too many arguments
In the second argument of `(<=<)', namely `g x'
In the expression: f <=< g x Failed, modules loaded: none.
There are two errors here.
First, (<=<) only composes monadic functions if they share the same monad. In other words, you can use it to compose two Maybe functions:
(<=<) :: (b -> Maybe c) -> (a -> Maybe b) -> (a -> Maybe c)
... or two list functions:
(<=<) :: (b -> [c]) -> (a -> [b]) -> (a -> [c])
... but you cannot compose a list function and maybe function this way. The reason for this is that when you have a type signature like this:
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
... the compiler will ensure that all the ms must match.
The second error is that you forgot to parenthesize your composition. What you probably intended was this:
(f <=< g) x
... if you omit the parentheses the compiler interprets it like this:
f <=< (g x)
An easy way to fix your function is just to define a helper function that converts Maybes to lists:
maybeToList :: Maybe a -> [a]
maybeToList Nothing = []
maybeToList (Just a) = [a]
This function actually has the following two nice properties:
maybeToList . return = return
maybeToList . (f <=< g) = (maybeToList . f) <=< (maybeToList . g)
... which are functor laws if you treat (maybeToList .) as analogous to fmap and treat (<=<) as analogous to (.) and return as analogous to id.
Then the solution becomes:
(maybeToList . f <=< g) x
Note that, in
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
m is static -- You're trying to substitute both [] and Maybe for m in the definition -- that won't type check.
You can use <=< to compose functions of the form a -> m b where m is a single monad. Note that you can use different type arguments though, you don't need to be constrained to the polymorphic a.
Here's an example of using this pattern constrained to the list monad:
f :: Int -> [Int]
f x = [x, x^2]
g :: Int -> [String]
g 0 = []
g x = [show x]
λ> :t g <=< f
g <=< f :: Int -> [String]
λ> g <=< f $ 10
["10","100"]
You can't mix monads together. When you see the signature
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
The Monad m is only a single Monad, not two different ones. If it were, the signature would be something like
(<=<) :: (Monad m1, Monad m2) => (b -> m2 c) -> (a -> m1 b) -> a -> m2 c
But this is not the case, and in fact would not really be possible in general. You can do something like
f :: Int -> Maybe Int
f 0 = Just 0
f _ = Nothing
g :: Int -> Maybe Int
g x = if even x then Just x else Nothing
h :: Int -> Maybe Int
h = f <=< g

Implementing Applicative's (<*>) for Monad

Applicative's has the (<*>) function:
(<*>) :: (Applicative f) => f (a -> b) -> f a -> f b
Learn You a Haskell shows the following function.
Given:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap f m = do
g <- f -- '<-' extracts f's (a -> b) from m (a -> b)
m2 <- m -- '<-' extracts a from m a
return (g m2) -- g m2 has type `b` and return makes it a Monad
How could ap be written with bind alone, i.e. >>=?
I'm not sure how to extract the (a -> b) from m (a -> b). Perhaps once I understand how <- works in do notation, I'll understand the answer to my above question.
How could ap be written with bind alone, i.e. >>= ?
This is one sample implementation I can come up with:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap xs a = xs >>= (\f -> liftM f a)
Of if you don't want to even use liftM then:
ap :: (Monad m) => m (a -> b) -> m a -> m b
ap mf ma = mf >>= (\f -> ma >>= (\a' -> return $ f a'))
Intially these are the types:
mf :: m (a -> b)
ma :: m a
Now, when you apply bind (>>=) operator to mf: mf >>= (\f-> ..., then f has the type of:
f :: (a -> b)
In the next step, ma is also applied with >>=: ma >>= (\a'-> ..., here a' has the type of:
a' :: a
So, now when you apply f a', you get the type b from that because:
f :: (a -> b)
a' :: a
f a' :: b
And you apply return over f a' which will wrap it with the monadic layer and hence the final type you get will be:
return (f a') :: m b
And hence everything typechecks.

Resources