-
-
Save deniok/bca73d29cca59f73ec92748a780bd42b to your computer and use it in GitHub Desktop.
FP_HSE2020Fall_09
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 #-} | |
module Fp09 where | |
import Control.Applicative (Alternative(..),optional,ZipList(..)) | |
import Data.Char (isLower,isUpper,digitToInt,isDigit) | |
import Data.Monoid (Alt(..),Ap(..),Sum(..)) | |
import Data.Functor.Identity (Identity(..)) | |
newtype Parser tok a = | |
Parser { runParser :: [tok] -> Maybe ([tok],a) } | |
charA :: Parser Char Char | |
charA = Parser f where | |
f (c:cs) | c == 'A' = Just (cs,c) | |
f _ = Nothing | |
{- | |
> runParser charA "ABC" | |
Just ('A',"BC") | |
> runParser charA "BCD" | |
Nothing | |
-} | |
satisfy :: (tok -> Bool) -> Parser tok tok | |
satisfy pr = Parser f where | |
f (c:cs) | pr c = Just (cs,c) | |
f _ = Nothing | |
{- | |
> runParser (satisfy isUpper) "ABC" | |
Just ('A',"BC") | |
> runParser (satisfy isLower) "ABC" | |
Nothing | |
-} | |
lower :: Parser Char Char | |
lower = satisfy isLower | |
char :: Char -> Parser Char Char | |
char c = satisfy (== c) | |
digit :: Parser Char Int | |
digit = digitToInt <$> satisfy isDigit | |
-- для этого | |
instance Functor (Parser tok) where | |
fmap :: (a -> b) -> Parser tok a -> Parser tok b | |
fmap g (Parser p) = Parser f where | |
f xs = case p xs of | |
Nothing -> Nothing | |
Just (cs, c) -> Just (cs, g c) | |
-- fmap g (Parser p) = Parser $ (fmap . fmap . fmap) g p | |
{- | |
> runParser digit "12AB" | |
Just ("2AB",1) | |
> runParser digit "AB12" | |
Nothing | |
-} | |
{- | |
СЕМАНТИКА | |
pure: парсер, всегда возвращающий заданное значение; | |
(<*>): нужно получить результаты первого парсера, затем | |
второго, а после этого применить первые ко вторым. | |
-} | |
instance Applicative (Parser tok) where | |
pure :: a -> Parser tok a | |
pure x = Parser $ \s -> Just (s, x) | |
(<*>) :: Parser tok (a -> b) -> Parser tok a -> Parser tok b | |
Parser u <*> Parser v = Parser f where | |
f xs = case u xs of | |
Nothing -> Nothing | |
Just (xs', g) -> case v xs' of | |
Nothing -> Nothing | |
Just (xs'', x) -> Just (xs'', g x) | |
{- | |
А вот так не подойдет | |
pure = Parser . pure . pure . pure | |
Parser u <*> Parser v = Parser $ (liftA2 . liftA2) (<*>) u v | |
Хотя это и настоящий композитный аппликативный функтор, но семантика не та. | |
-} | |
{- | |
> runParser (pure (,) <*> digit <*> digit) "12AB" | |
Just ("AB",(1,2)) | |
> runParser (pure (,) <*> digit <*> digit) "1AB2" | |
Nothing | |
-} | |
multiplication :: Parser Char Int | |
multiplication = (*) <$> digit <* char '*' <*> digit | |
{- | |
GHCi> runParser multiplication "6*7" | |
Just ("",42) | |
-} | |
-- Альтернативы | |
{- | |
СЕМАНТИКА | |
empty - парсер, всегда возвращающий неудачу; | |
<|> - пробуем первый, при неудаче пробуем второй на исходной строке. | |
-} | |
instance Alternative (Parser tok) where | |
empty :: Parser tok a | |
empty = Parser $ \_ -> Nothing | |
(<|>) :: Parser tok a -> Parser tok a -> Parser tok a | |
Parser u <|> Parser v = Parser f where | |
f xs = case u xs of | |
Nothing -> v xs | |
z -> z | |
{- | |
> runParser (char 'A' <|> char 'B') "ABC" | |
Just ("BC",'A') | |
> runParser (char 'A' <|> char 'B') "BCD" | |
Just ("CD",'B') | |
> runParser (char 'A' <|> char 'B') "CDE" | |
Nothing | |
GHCi> runParser (many digit) "42abdef" | |
Just ("abdef",[4,2]) | |
GHCi> runParser (some digit) "42abdef" | |
Just ("abdef",[4,2]) | |
GHCi> runParser (many digit) "abdef" | |
Just ("abdef",[]) | |
GHCi> runParser (some digit) "abdef" | |
Nothing | |
GHCi> runParser (optional digit) "42abdef" | |
Just ("2abdef",Just 4) | |
GHCi> runParser (optional digit) "abdef" | |
Just ("abdef",Nothing) | |
-} | |
-- пример рекурсивного разбора | |
lowers :: Parser Char String | |
lowers = (:) <$> lower <*> lowers <|> pure "" | |
--lowers = many lower | |
{- | |
GHCi> runParser lowers "abCd" | |
Just ("Cd","ab") | |
GHCi> runParser lowers "abcd" | |
Just ("","abcd") | |
GHCi> runParser lowers "Abcd" | |
Just ("Abcd","") | |
-} | |
-- Обертки Alt и Ap | |
{- | |
GHCi> Alt "Abc" <> Alt "De" | |
Alt {getAlt = "AbcDe"} | |
GHCi> Alt Nothing <> Alt (Just 1) <> Alt (Just 2) | |
Alt {getAlt = Just 1} | |
GHCi> apLstS1 = Ap $ Sum <$> [1,2,3] | |
GHCi> apLstS2 = Ap $ Sum <$> [10,20] | |
GHCi> getAp $ getSum <$> (apLstS1 <> apLstS2) | |
[11,21,12,22,13,23] | |
GHCi> Ap [10,20] - Ap [1,2,3] | |
Ap {getAp = [9,8,7,19,18,17]} | |
GHCi> Ap [10,20] + pure 2 * Ap [1,2,3] | |
Ap {getAp = [12,14,16,22,24,26]} | |
-} | |
-- Класс типов Traversable | |
dist :: Applicative f => [f a] -> f [a] | |
dist [] = pure [] | |
dist (ax:axs) = pure (:) <*> ax <*> dist axs | |
{- | |
GHCi> dist [Just 3,Just 5] | |
Just [3,5] | |
GHCi> dist [Just 3,Nothing] | |
Nothing | |
GHCi> getZipList $ dist $ map ZipList [[1,2],[3,4],[5,6]] | |
[[1,3,5],[2,4,6]] | |
GHCi> dist [[1,2],[3,4],[5,6]] | |
[[1,3,5],[1,3,6],[1,4,5],[1,4,6],[2,3,5],[2,3,6],[2,4,5],[2,4,6]] | |
-} | |
{- | |
GHCi> traverse Identity [1,2,3] | |
Identity [1,2,3] | |
GHCi> traverse Just [1,2,3] | |
Just [1,2,3] | |
GHCi> traverse (const Nothing) [1,2,3] | |
Nothing | |
-} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment