Skip to content

Instantly share code, notes, and snippets.

@Sam-Serpoosh
Created March 13, 2017 06:12
Show Gist options
  • Save Sam-Serpoosh/f955fc5b5c670298160bbdc5b2d937da to your computer and use it in GitHub Desktop.
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!
{-# 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