Skip to content

Instantly share code, notes, and snippets.

@oisdk oisdk/star.hs
Last active Apr 28, 2019

Embed
What would you like to do?
{-# LANGUAGE DeriveFunctor, LambdaCase #-}
import Control.Applicative hiding (many)
import Control.Monad
newtype Parser a = Parser { runParser :: String -> [(a, String)] } deriving Functor
instance Applicative Parser where
pure x = Parser (\s -> [(x,s)])
fs <*> xs = fs >>= (\f -> xs >>= (\x -> pure (f x)))
instance Monad Parser where
xs >>= f = Parser (\s -> [ (y,s'') | (x,s') <- runParser xs s, (y,s'') <- runParser (f x) s' ])
instance Alternative Parser where
empty = Parser (\_ -> [])
xs <|> ys = Parser (\s -> runParser xs s ++ runParser ys s)
instance MonadPlus Parser where
starM :: MonadPlus f => (a -> f a) -> a -> f a
starM f x = pure x <|> plusM f x
plusM :: MonadPlus f => (a -> f a) -> a -> f a
plusM f x = f x >>= starM f
starA :: Alternative f => f (a -> a) -> a -> f a
starA fs x = pure x <|> plusA fs x
plusA :: Alternative f => f (a -> a) -> a -> f a
plusA fs x = fs <*> starA fs x
manyM :: Parser a -> Parser [a]
manyM p = starM ((<$> p) . flip (:)) []
manyA :: Parser a -> Parser [a]
manyA p = starA ((:) <$> p) []
char :: Char -> Parser Char
char c = Parser (\case
(x:xs) | x == c -> [(x, xs)]
_ -> [])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.