[Haskell-beginners] parse block comments

[mike h]

Hi,

Below is code I’m building up  for simple monadic and applicative parsers  from first principles.

I’ve just added code for single line Haskell style comments.

-- comment being '--'
comment :: Parser ()
comment = do
      string "--" 
      many (sat ( /='\n') )
      return ()

— or as applicative 
comment' = string "--" *> many (sat (/='\n') )


I’d really appreciate help on writing a function for multi line comments! “{-“  and end with “-}”
I know I need some sort of look ahead but can’t quite get the feel of how!

Thanks 
Mike

======================================


import Control.Applicative
import Data.Char

newtype Parser a = P (String -> [(a,String)])

parse :: Parser a -> String -> [(a,String)]
parse (P p)  = p

item :: Parser Char
item = P (\s -> case s of
                    []     -> []
                    (x:xs) -> [(x, xs)])

instance Functor Parser where
    -- fmap :: (a -> b) -> f a -> f b
    fmap g p  = P (\inp -> case parse p inp of
                             [] -> []
                             [(x, xs)] -> [(g x, xs)])


instance Applicative Parser where
  -- pure :: a -> Parser a
  -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  pure x = P (\inp -> [(x, inp)])
  pab <*> pa = P (\inp -> case parse pab inp of
                    [] -> []
                    [(aTob, out)] -> parse (fmap aTob pa) out)


three :: Parser (Char, Char)
three = pure g <*> item <*> item <*> item 
         where g x y z = (x, z)

instance Monad Parser where
   -- return :: a -> Parser a
   return x = P (\inp -> [(x, inp)])
   -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
   pa >>= f = P (\inp -> case parse pa inp of
                  [] -> []
                  [(a, out)] -> parse (f a) out)

instance Alternative Parser where
    -- empty :: Parser a
    empty = P (\inp -> [])
    -- (<|>) :: Parser a-> Parser a -> Parser a   
    -- if p1 works the that one otherwise p2 
    p1 <|> p2 = P (\inp -> case parse p1 inp of
                        []  -> parse p2 inp
                        out -> out)

sat :: (Char -> Bool) -> Parser Char
sat p = do
    x <- item
    if p x then return x else empty

digit :: Parser Char
digit = sat isDigit

lower :: Parser Char
lower = sat isLower

upper :: Parser Char
upper = sat isUpper

letter :: Parser Char
letter = sat isAlpha

alphanum :: Parser Char
alphanum = sat isAlphaNum

char :: Char -> Parser Char
char x = sat (==x)

string :: String -> Parser String
string [] = return []
string s@(x:xs) = do
    char x *> string xs *> return s

ident :: Parser String
ident = do
    x  <- lower
    xs <- many alphanum
    return (x:xs) 

ident' :: Parser String
ident' = pure (:) <*> lower <*> many alphanum
    
nat :: Parser Int 
nat = do
  xs <- some digit
  return (read xs)   

nat' :: Parser Int 
nat' = pure read <*> some digit

space :: Parser ()
space = do
    many (sat isSpace )
    return ()

space' :: Parser ()
space' = many (sat isSpace ) *> return ()

int :: Parser Int
int = do
    char '-'
    n <- nat
    return (-n)
    <|> nat

int' :: Parser Int
int' = char '-' *> pure ((-1)*) <*> nat <|> nat

token :: Parser a -> Parser a
token p = do 
    space 
    v <- p
    space
    return v

token' :: Parser a -> Parser a
token' p = space *> p <* space

identifier :: Parser String
identifier = token ident

natural :: Parser Int
natural = token nat

integer :: Parser Int
integer = token int

symbol :: String -> Parser String
symbol xs = token (string xs)


nats :: Parser [Int]
nats = do
    symbol "["
    n  <- natural
    ns <- many ( do symbol "," 
                    natural )
    symbol "]"
    return (n:ns)



-- comment being '--'
comment :: Parser ()
comment = do
      string "--" 
      many (sat ( /='\n') )
      return ()

comment' = string "--" *> many (sat (/='\n') )


nats' :: Parser [Int]
-- sequence and ignore "[" and the rest
-- the rest is fmap list cons into result of natural and the apply that to many others and
-- finally ignore the closing "]"  
nats' = symbol "[" >> (:) <$> natural <*> many (symbol "," >> natural) <* symbol "]"