[Haskell-beginners] Monadic composition without throwing genericity under the bus?

[Stephen Tetley]

Hi Dave

You might need more that a type system extension for this one.

I've called your composition operator (*>>*), if you stack the type
signatures together I can't see a way of getting from (*>>*) to (.).

Compare it to the Kleisli composition of monads - where the step to
(.) is more apparent (swap '-> m' for cat):

-- (.) :: cat b c -> cat a b -> cat a c
-- (.) :: b `cat` c -> a `cat` b -> a `cat` c       -- infix

-- (*>>*) :: Monad m => m (b -> c) -> m (a -> b) -> m (a -> c)

-- Kleisli composition does satisfy Category
-- _Kleisli_ :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)


I think I've derived what you are doing below with Graham Hutton's
parser monad, the 'easy work around' is to use (*>>*) rather than try
to use (.):

module Fun where



-- Starting with a Graham Hutton's parser as it is (probably) the
-- simplest monadic parser

newtype Parser a = Parser { parse :: (String -> [(a,String)]) }

instance Monad Parser where
  return a = Parser (\cs -> [(a,cs)])
  p >>= f  = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])


item :: Parser Char
item =  Parser (\cs -> case cs of
                        ""     -> []
                        (c:cs) -> [(c,cs)])

zero :: Parser a
zero = Parser (\cs -> [])

sat :: (Char -> Bool) -> Parser Char
sat p = do {c <- item; if p c then return c else zero}


char0 :: Char -> Parser Char
char0 c = sat (c==)

char :: Char -> Parser ShowS
char c = do {ch <- sat (c==) ; return (showChar c) }

-- consume but don't produce ?
place0 :: String -> Parser String
place0 str = do { str' <- mapM char0 str; return "" }

place :: String -> Parser ShowS
place str = place0 str >> return (\s -> s)       -- no string aka id

string0 :: String -> Parser String
string0 str = mapM char0 str

string :: String -> Parser ShowS
string str = do { str' <- string0 str; return (showString str) }

--------------------------------------------------------------------------------

dot :: Parser ShowS
dot = char '.'

comment :: Parser ShowS
comment = place "-- "

runParser :: Parser ShowS -> String -> String
runParser p inp = post $ ((parse p) inp)
  where
    post [(ans,_)] = ans $ ""
    post xs        = error (unlines $ map (\(f,cs) -> show (f "",cs)) xs)

demo1 :: String
demo1 = runParser (comment >> dot) "-- ."


startPragma :: Parser ShowS
startPragma = string "{-#"


demo2 :: String
demo2 = runParser (startPragma) "{-#"

space :: Parser ShowS
space = char ' '


languageU :: Parser ShowS
languageU = string "LANGUAGE"

-- first attempt - 'endo' style keeps the same type
(*>*) :: Monad m => m (a -> a) -> m (a -> a) -> m (a -> a)
mf *>* mg = do { f <- mf; g <- mg; return (f.g) }


demo3 :: String
demo3 = runParser (startPragma *>* space *>* languageU) "{-# LANGUAGE"


-- second attempt - 'bluebird' style - proper composition
-- (more general)
(*>>*) :: Monad m => m (b -> c) -> m (a -> b) -> m (a -> c)
mf *>>* mg = do { f <- mf; g <- mg; return (f.g) }


demo4 :: String
demo4 = runParser (startPragma *>>* space *>>* languageU) "{-# LANGUAGE"

-- (.) :: cat b c -> cat a b -> cat a c
-- (*>>*) :: Monad m => m (b -> c) -> m (a -> b) -> m (a -> c)

-- ???

-- Kleisli composition does satisfy Category
-- _Kleisli_ :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)

-- TYPE ERROR
-- demo5x :: String
-- demo5x = runParser (startPragma . space . languageU) "{-# LANGUAGE"