Created
March 13, 2017 06:12
-
-
Save Sam-Serpoosh/f955fc5b5c670298160bbdc5b2d937da to your computer and use it in GitHub Desktop.
Making a simple parametric Parser which is both a Functor and Applicative in Haskell!
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE InstanceSigs #-} | |
import Data.Char | |
import Control.Applicative | |
newtype Parser a = Parser { runParser :: String -> Maybe (a, String) } | |
instance Functor Parser where | |
fmap :: (a -> b) -> Parser a -> Parser b | |
fmap f pa = Parser $ \s -> fmap (first f) (runParser pa s) | |
instance Applicative Parser where | |
pure :: a -> Parser a | |
pure x = Parser $ \s -> Just (x, s) | |
(<*>) :: Parser (a -> b) -> Parser a -> Parser b | |
pf <*> pa = Parser $ \s -> let mf = runParser pf s | |
in case mf of | |
Nothing -> Nothing | |
Just (f, rs) -> let ma = runParser pa rs | |
in case ma of | |
Nothing -> Nothing | |
Just (a, rrs) -> Just (f a, rrs) | |
first :: (a -> b) -> (a, c) -> (b, c) | |
first f (x, y) = (f x, y) | |
satisfy :: (Char -> Bool) -> Parser Char | |
satisfy p = Parser f | |
where | |
f [] = Nothing | |
f (x:xs) | |
| p x = Just (x, xs) | |
| otherwise = Nothing | |
posInt :: String -> Maybe (Integer, String) | |
posInt xs = let (ns, rest) = span isDigit xs | |
in if (null ns) then Nothing else Just (read ns, rest) | |
posIntParser :: Parser Integer | |
posIntParser = Parser posInt | |
upperParser = satisfy isUpper | |
chEqParser c = satisfy (== c) | |
type Name = String | |
data Employee = Emp { name :: Name, phone :: String } | |
deriving (Show, Eq) | |
empParserStr :: Maybe (Employee, String) -> String | |
empParserStr Nothing = "" | |
empParserStr (Just (emp, _)) = show emp | |
parseName :: Parser Name | |
parseName = Parser $ \s -> let (name, num) = span (\c -> not $ isDigit c) s | |
in Just (name, num) | |
parsePhone :: Parser String | |
parsePhone = Parser $ \s -> Just (s, "") | |
main :: IO () | |
main = do | |
-- Testing Parsers | |
let p = satisfy isUpper | |
let res0 = runParser p "ABC" | |
let res1 = runParser p "abc" | |
let res2 = runParser (chEqParser 'x') "xyz" | |
let res3 = runParser posIntParser "234hello5" | |
putStrLn $ show res0 -- => Just('A', "BC") | |
putStrLn $ show res1 -- => Nothing | |
putStrLn $ show res2 -- => Just ('x', "yx") | |
putStrLn $ show res3 -- => Just (234, "hello5") | |
-- Testing Parser Being Functor | |
let f = \x -> x + 10 | |
let res = runParser (fmap f posIntParser) "123hello5" | |
putStrLn $ show res -- => Just (133,"hello5") | |
-- Testing Parser Being Applicative | |
let parseEmp = Emp <$> parseName <*> parsePhone | |
let emp = runParser parseEmp "sam123456" | |
putStrLn $ empParserStr emp -- => Emp {name = "sam", phone = "123456"} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment