Skip to content

Instantly share code, notes, and snippets.

@LispyAriaro
Forked from abhin4v/transformers.hs
Created October 22, 2017 18:56
Show Gist options
  • Save LispyAriaro/d2a08d43e77af9bfcf0e33664790f94f to your computer and use it in GitHub Desktop.
Save LispyAriaro/d2a08d43e77af9bfcf0e33664790f94f to your computer and use it in GitHub Desktop.
An exploration of Monad Transformers in Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Transformers where
import Control.Applicative
import Control.Monad
import qualified Data.Char as Char
first :: (a -> c) -> (a, b) -> (c, b)
first f (a, b) = (f a, b)
-- Identity
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f = Identity . f . runIdentity
instance Applicative Identity where
pure = Identity
Identity f <*> Identity a = Identity (f a)
instance Monad Identity where
a >>= f = f . runIdentity $ a
-- StateT
newtype StateT s m a = StateT { runStateT :: s -> m (a, s) }
instance (Functor m) => Functor (StateT s m) where
fmap f a = StateT $ fmap (first f) . runStateT a
instance (Monad m) => Applicative (StateT s m) where
pure a = StateT $ \s -> pure (a, s)
f <*> a = StateT $ \s -> do
(f', s') <- runStateT f s
(a', s'') <- runStateT a s'
return (f' a', s'')
instance (Monad m) => Monad (StateT s m) where
a >>= f = StateT $ \s -> do
(a', s') <- runStateT a s
runStateT (f a') s'
instance (Alternative m, Monad m) => Alternative (StateT s m) where
empty = StateT . const $ empty
a <|> b = StateT $ \s -> runStateT a s <|> runStateT b s
-- MonadState
class (Monad m) => MonadState s m where
get :: m s
put :: s -> m ()
instance (Monad m) => MonadState s (StateT s m) where
get = StateT $ \s -> pure (s, s)
put s = StateT . const . pure $ ((), s)
-- MaybeT
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
instance (Functor m) => Functor (MaybeT m) where
fmap f = MaybeT . fmap (fmap f) . runMaybeT
instance (Applicative m) => Applicative (MaybeT m) where
pure = MaybeT . pure . Just
f <*> a = MaybeT $ (<*>) <$> runMaybeT f <*> runMaybeT a
instance (Monad m) => Monad (MaybeT m) where
a >>= f = MaybeT $ do
a' <- runMaybeT a
case a' of
Nothing -> return Nothing
Just a'' -> runMaybeT $ f a''
instance (Monad m) => Alternative (MaybeT m) where
empty = MaybeT . pure $ Nothing
a <|> b = MaybeT $ (<|>) <$> runMaybeT a <*> runMaybeT b
-- ParserT
newtype ParserT i m o = ParserT { runParserT :: StateT i (MaybeT m) o }
deriving ( Functor
, Applicative
, Monad
, Alternative
, MonadState i
)
runParser :: ParserT i m o -> i -> m (Maybe (o, i))
runParser p i = runMaybeT . flip runStateT i . runParserT $ p
-- parsers
predParser :: Monad m => (a -> Bool) -> ParserT [a] m a
predParser p = do
input <- get
case input of
(x : xs) | p x -> put xs >> return x
_ -> empty
charParser :: Monad m => Char -> ParserT String m Char
charParser c = predParser (== c)
spacesParser :: Monad m => ParserT String m String
spacesParser = many $ predParser Char.isSpace
notSpacesParser :: Monad m => ParserT String m String
notSpacesParser = some $ predParser (not . Char.isSpace)
wordsParser :: Monad m => ParserT String m [String]
wordsParser = many $ spacesParser *> notSpacesParser <* spacesParser
main :: IO ()
main = do
input <- getLine
parsed <- runParser wordsParser input
case parsed of
Nothing -> putStrLn "NO PARSE"
Just (ws, _) -> forM_ ws putStrLn
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment