Lecture 11 (#21)

.vitepress/config.mts

@@ -38,6 +38,7 @@ export default defineConfig({
           { text: '08: Haskell Types', link: '/lectures/lecture08'},
           { text: '09: Type Classes', link: '/lectures/lecture09'},
           { text: '10: IO & Monads', link: '/lectures/lecture10'},
+          { text: '11: Monadic Parsing', link: '/lectures/lecture11'},
         ]
       },
 

lectures/Parser.hs

@@ -0,0 +1,58 @@
+module Parser where
+
+import Control.Applicative
+import Data.Char
+
+newtype Parser a = P { parse :: String -> Maybe (a, String) }
+
+instance Functor Parser where
+    -- fmap :: (a -> b) -> Parser a -> Parser b
+    fmap f p = P (\inp -> case parse p inp of
+                            Nothing -> Nothing
+                            Just (v,out) -> Just (f v, out))
+
+instance Applicative Parser where
+    -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
+    pg <*> px = P (\inp -> case parse pg inp of
+                             Nothing -> Nothing
+                             Just (g,out) -> parse (fmap g px) out)
+    pure v = P (\inp -> Just (v,inp))
+
+instance Monad Parser where
+    -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
+    p >>= f = P (\inp -> case parse p inp of
+                           Nothing -> Nothing
+                           Just (v,out) -> parse (f v) out)
+
+instance Alternative Parser where
+    -- empty :: Parser a
+    empty = P (\_ -> Nothing)
+    -- (<|>) :: Parser a -> Parser a -> Parser a
+    p <|> q = P (\inp -> case parse p inp of
+                           Nothing -> parse q inp
+                           Just (v,out) -> Just (v,out))
+    -- many p = some p <|> pure []
+    -- some p = (:) <$> p <*> many p
+
+-- Parsers
+item :: Parser Char
+item = P (\inp -> case inp of
+                    "" -> Nothing
+                    (x:xs) -> Just (x,xs))
+
+sat :: (Char -> Bool) -> Parser Char
+sat pr = item >>= \x -> if pr x then return x
+                        else empty
+
+alphaNum :: Parser Char
+alphaNum = sat isAlphaNum
+
+char :: Char -> Parser Char
+char c = sat (== c)
+
+string :: String -> Parser String
+string "" = pure ""
+string s@(x:xs) = char x *> string xs *> pure s 
+
+sep :: Parser ()
+sep = some (sat isSpace) *> pure ()

lectures/index.md

@@ -82,6 +82,11 @@ We discuss some more examples of type classes, most importantly `Functor`s.
 [Slides](https://github.com/aicenter/FUP/blob/main/lectures/lecture10.pdf).
 [Log](https://github.com/aicenter/FUP/blob/main/lectures/lecture10.hs).
 
+## [Lecture 11](lecture11): Monadic Parsing
+
+[Slides](https://github.com/aicenter/FUP/blob/main/lectures/lecture11.pdf).
+[Log](https://github.com/aicenter/FUP/blob/main/lectures/lecture11.hs).
+
 
 ## Old recorded lectures
 

lectures/lecture06.md

@@ -2,7 +2,7 @@
 outline: deep
 ---
 
-## Introduction
+# Lambda Calculus
 
 Lambda calculus is a model of computation. It was introduced in the 1930s by Alonzo Church. He was
 trying to develop formal foundations for mathematics. His attempts were unsuccessful, as several of

lectures/lecture08.md

@@ -1,6 +1,8 @@
-# Lecture 8 - Haskell Types
+---
+outline: deep
+---
 
-## Haskell's type system
+# Haskell's type system
 
 - _**Strong**_: Haskell *guarantees* that your program does not have any type-level errors. Strong
     also means that it will not do automatic type coercion (i.e. casting/type conversion).

lectures/lecture09.md

@@ -1,4 +1,4 @@
-# Lecture 9 - Typeclasses
+# Typeclasses
 
 
 During the last lecture we introduced [ad-hoc polymorphism](lecture08#polymorphism) via *typeclasses*.

lectures/lecture11.hs

@@ -0,0 +1,142 @@
+-- Lecture 11
+import Control.Applicative
+import Data.Char
+import Data.List
+import Parser
+
+-- Example Maybe as applicative functor
+
+validateLength :: Int -> String -> Maybe String
+validateLength maxLen s = if (length s) > maxLen
+                          then Nothing
+                          else Just s
+
+newtype Name = Name String deriving (Eq, Show)
+newtype Address = Address String deriving (Eq, Show)
+
+mkName :: String -> Maybe Name
+mkName s = Name <$> validateLength 12 s
+
+mkAddress :: String -> Maybe Address
+mkAddress a = Address <$> validateLength 25 a
+
+data Person = Person Name Address deriving (Eq, Show)
+
+mkPerson :: String -> String -> Maybe Person
+mkPerson n a = Person <$> mkName n <*> mkAddress a
+-- It can be done also via monadic instance of Maybe. 
+{-
+mkPerson n a = do name <- mkName n
+                  addr <- mkAddress a
+                  return $ Person name addr
+-}
+
+-- definability of <*> in terms of >>=
+(<<*>>) :: Monad m => m (a -> b) -> m a -> m b
+x <<*>> y = x >>= \f -> fmap f y
+infixl 4 <<*>>
+
+(<<*) :: Applicative f => f a -> f b -> f a
+x <<* y = (\u -> (\_ -> u)) <$> x <*> y 
+infixl 4 <<*
+
+(*>>) :: Applicative f => f a -> f b -> f b
+x *>> y =  (\_ -> id) <$> x <*> y 
+infixl 4 *>>
+
+-- Monadic parsing
+
+data Expr a = Val a
+            | Var String
+            | Add [Expr a]
+            | Mul [Expr a] deriving Eq
+
+instance Show a => Show (Expr a) where
+    show (Val c) = show c
+    show (Var s) = s
+    show (Add es) = "(" ++ intercalate " + " (map show es) ++ ")"
+    show (Mul es) = "(" ++ intercalate " * " (map show es) ++ ")"
+
+{-
+<expr> -> <space>* <expr'> <space>*
+<expr'> -> <var>
+         | <val>
+         | <add>
+         | <mul>
+
+<var> -> <lower> <alphanum>*
+<val> -> <int> "." <digit>+ | <int>
+<int> -> "-" <digit>+ | <digit>+ 
+
+<add> -> "(" <expr> ("+" <expr>)+ ")"
+<mul> -> "(" <expr> ("*" <expr>)+ ")"
+-}
+
+var :: Parser (Expr a)
+-- var = fmap Var $ (:) <$> sat isLower <*> many alphaNum
+var = do x <- sat isLower
+         xs <- many alphaNum
+         return $ Var (x:xs)
+
+digit :: Parser Char
+digit = sat isDigit
+
+nat :: Parser String
+nat = some digit
+
+int :: Parser String
+-- int = (:) <$> char '-' <*> nat <|> nat
+int = do char '-'
+         xs <- nat
+         return ('-':xs)
+      <|> nat
+
+float :: Parser Float
+-- float = fmap read $
+--     join <$> int
+--          <*> (char '.' *> nat)
+--     <|> int
+--     where join s1 s2 = s1 ++ "." ++ s2
+float = do xs <- int
+           char '.'
+           ys <- nat
+           return $ read (xs ++ "." ++ ys)
+        <|> read <$> int
+
+space :: Parser ()
+space = many (sat isSpace) *> pure ()
+
+token :: Parser a -> Parser a
+-- token p = space *> p <* space
+token p = do space
+             x <- p
+             space
+             return x
+
+val :: Parser (Expr Float)
+val = Val <$> float
+
+expr :: Parser (Expr Float)
+expr = token (var <|> val <|> op '+' <|> op '*')
+
+opCons :: Char -> [Expr a] -> Expr a
+opCons '+' = Add
+opCons '*' = Mul
+opCons c = error $ show c ++ " is unknown op"
+
+op :: Char -> Parser (Expr Float)
+-- op c = fmap (opCons c) $
+--     (:) <$> (char '(' *> expr)
+--         <*> some (char c *> expr)
+--         <*  char ')'
+op c = do char '('
+          e <- expr
+          es <- some (char c >> expr)
+          char ')'
+          return $ opCons c (e:es)
+
+readExpr :: String -> Maybe (Expr Float)
+readExpr s = case parse expr s of
+    Just (e,"") -> Just e
+    Just (e,_) -> Nothing
+    _ -> Nothing