Parsing
Algorithms
Logic
Strings
Monads
Data Structures
Functional Programming
{-# LANGUAGE DeriveFunctor, TupleSections, LambdaCase #-} module MonadicParsing where import Control.Applicative import Control.Monad newtype Parser a = Parser { runParser :: String -> [(a, String)] } deriving Functor instance Applicative Parser where pure a = Parser $ pure . (a,) (<*>) = ap instance Monad Parser where return = pure Parser p >>= f = Parser $ \s -> concatMap (uncurry (runParser.f)) $ p s instance Alternative Parser where empty = Parser $ pure [] Parser p <|> Parser q = Parser $ liftA2 (++) p q pred1 :: (Char -> Bool) -> Parser Char pred1 p = Parser $ \case c:cs | p c -> [(c, cs)]; _ -> [] char :: Char -> Parser Char char = pred1 . (==) str :: String -> Parser String str = mapM char{-# LANGUAGE DeriveFunctor, TupleSections #-}- {-# LANGUAGE DeriveFunctor, TupleSections, LambdaCase #-}
- module MonadicParsing where
- import Control.Applicative
- import Control.Monad
- newtype Parser a = Parser { runParser :: String -> [(a, String)] }
- deriving Functor
- instance Applicative Parser where
- pure a = Parser $ pure . (a,)
- (<*>) = ap
- instance Monad Parser where
return a = Parser $ return . (a,)- return = pure
- Parser p >>= f = Parser $ \s -> concatMap (uncurry (runParser.f)) $ p s
- instance Alternative Parser where
- empty = Parser $ pure []
- Parser p <|> Parser q = Parser $ liftA2 (++) p q
- pred1 :: (Char -> Bool) -> Parser Char
- pred1 p = Parser $ \case c:cs | p c -> [(c, cs)]; _ -> []
- char :: Char -> Parser Char
- char = pred1 . (==)
- str :: String -> Parser String
- str = mapM char
import Data.Char import Data.List import Control.Applicative import Test.Hspec import MonadicParsing main :: IO () main = hspec spec takeParser :: Int -> Parser String takeParser l = Parser $ \s -> [(take l s, drop l s)] digitParser :: Parser Int digitParser = digitToInt <$> pred1 isDigit repeatParser :: Show a => a -> Parser a repeatParser a = a <$ str (show a) spec :: Spec spec = do describe "monad instance" $ do it "left identity" $ runParser (return 3 >>= takeParser) "hello" `shouldBe` runParser (takeParser 3) "hello" it "right identity" $ runParser (takeParser 9 >>= return) "world" `shouldBe` runParser (takeParser 9) "world" it "associativity" $ runParser ((digitParser >>= repeatParser) >>= takeParser) "99 luftballons" `shouldBe` runParser (digitParser >>= (\x -> repeatParser x >>= takeParser)) "99 luftballons"- import Data.Char
- import Data.List
- import Control.Applicative
- import Test.Hspec
import MonadicParsing (Parser (..))- import MonadicParsing
- main :: IO ()
- main = hspec spec
- takeParser :: Int -> Parser String
- takeParser l = Parser $ \s -> [(take l s, drop l s)]
- digitParser :: Parser Int
digitParser = Parser $ \s -> [ (digitToInt a, drop 1 s) | a <- take 1 s, isDigit a ]- digitParser = digitToInt <$> pred1 isDigit
- repeatParser :: Show a => a -> Parser a
repeatParser a = Parser $ \s -> [(a, drop l s) | t `isPrefixOf` s]wheret = show al = length t- repeatParser a = a <$ str (show a)
- spec :: Spec
- spec = do
- describe "monad instance" $ do
- it "left identity" $ runParser (return 3 >>= takeParser) "hello"
- `shouldBe` runParser (takeParser 3) "hello"
- it "right identity" $ runParser (takeParser 9 >>= return) "world"
- `shouldBe` runParser (takeParser 9) "world"
- it "associativity" $ runParser ((digitParser >>= repeatParser) >>= takeParser) "99 luftballons"