[Haskell-beginners] Monadic composition without throwing genericity
under the bus?
Dave Bayer
bayer at cpw.math.columbia.edu
Tue Feb 2 10:06:52 EST 2010
I've been playing with parsing, for text filtering applications such as an alternate GHC literate preprocessor. Here, it pays to have one's monad handle both the input and output streams out of sight. Using ShowS-valued monads, one can express most grammatical constructs as simple composition. I'm sure many people have had this idea, but the resulting parsers that I write end up much shorter than any demo code I've seen. For example, the "code is indented, comments are flush, periods delimit block comments" literate preprocessor that I depend on daily (leaving out the heredoc code) is just
dot, comment, dotLine, commentLine, codeLine, dotBlock, delit ∷ Parser
dot = char '.'
comment = place "-- "
codeLine = white ∘ till (heredoc ∨ whiteLine) word
commentLine = comment ∘ line
dotLine = comment ∘ dot ∘ whiteLine
dotBlock = dotLine ∘ till (dotLine ∨ eof) (whiteLine ∨ commentLine)
delit = till (skip (many whiteLine) ∘ eof)
(whiteLine ∨ dotBlock ∨ codeLine ∨ commentLine)
However, I've struggled mightily to cleanly implement composition of function-valued monads. In the end I had to throw genericity under the bus to use the above notation. I'm asking for help, in case I'm missing something.
I cannot use Control.Category for a Monad, because of kind arity: Monad instances have one unbound *, while Category instances have two. Here are some toy experiments:
mcompose ∷ Monad m ⇒ m (b → c) → m (a → b) → m (a → c)
mcompose x y = do
f ← x
g ← y
return $ f . g
-- adapted from Control.Category
class Category cat where
unit ∷ cat a a
compose ∷ cat b c → cat a b → cat a c
instance Category (→) where
unit = id
compose = (.)
-- Monad wrapper
newtype Wrap m a b = Wrap { unwrap ∷ m (a → b) }
instance Monad m ⇒ Category (Wrap m) where
unit = Wrap $ return id
compose x y = Wrap $ mcompose (unwrap x) (unwrap y)
-- Other tries that fail
instance Monad m ⇒ Category (m (→)) where
unit = return id
compose = mcompose
-- Error:
-- The first argument of `Category' should have kind `* -> * -> *',
-- but `m (->)' has kind `*'
-- In the instance declaration for `Category (m (->))'
type MonadMap m a b = m (a → b)
instance Monad m ⇒ Category (MonadMap m) where
unit = return id
compose = mcompose
-- Error:
-- Type synonym `MonadMap' should have 3 arguments, but has been given 1
-- In the instance declaration for `Category (MonadMap m)'
I can see why each of these fail, but I also crave a language that allows ambiguity if exactly one interpretation compiles. For example, one could scrape the leaves of the tree (m (→)) to find the two *'s one wants, and one would think that my MonadMap type synonym would be a standard trick for exposing the two *'s without giving up on the other form. (I want to use the same type as both a monad and a category, as the goal here is very concise code with no gunk packing and unpacking crutch types for the compiler.)
So I threw "id" under the bus. Here are later experiments:
mcompose ∷ Monad m ⇒ m (b → c) → m (a → b) → m (a → c)
mcompose x y = do
f ← x
g ← y
return $ f . g
class Composable a b c | a b → c where
compose ∷ a → b → c
instance Composable (b → c) (a → b) (a → c) where
compose f g = f . g
instance Monad m ⇒ Composable (m (b → c)) (m (a → b)) (m (a → c)) where
compose = mcompose
unit ∷ Monad m ⇒ m (a → a)
unit = return id
tab ∷ Maybe ShowS
tab = Just (" " ++)
test1, test2 ∷ Monad m ⇒ m (a → a)
test1 = mcompose unit unit
test2 = compose unit unit
-- test2 error:
-- Could not deduce (Composable
-- (m (a -> a)) (m1 (a1 -> a1)) (m2 (a2 -> a2)))
-- from the context (Monad m2)
-- arising from a use of `compose' at Issue2.lhs:26:10-27
test3, test4 ∷ Maybe ShowS
test3 = mcompose tab tab
test4 = compose tab tab
It appears to me that type inference in type classes is broken. How else to explain why mcompose has no trouble figuring out that the monads are the same, but compose is stumped?
In the end, I threw genericity under the bus, and chose the parser type
type Parser = StateT String Maybe ShowS
so the second approach would work in practice.
I don't need to do this "my way" if there's an idiom (or -XAllowAliens compiler flag) that I need to learn. How does one do this sort of thing cleanly?
Thanks!
More information about the Beginners
mailing list