Created
November 16, 2019 08:42
-
-
Save goolord/346a122748b697d65c7d78a280bcbb57 to your computer and use it in GitHub Desktop.
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 TemplateHaskell, LambdaCase, FlexibleContexts #-} | |
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-} | |
module Main where | |
import Polysemy | |
import Polysemy.State | |
import Polysemy.Reader | |
import Polysemy.Error | |
import Polysemy.NonDet | |
import Polysemy.Internal | |
import Control.Applicative | |
import Data.Foldable (foldMap) | |
import Data.Monoid (Alt(..)) | |
import Data.Function ((&)) | |
{- I was able to get both parsers working at a basic level however I would like to leverage | |
polysemy's ability to write a data type to represent your EDSL. Thus I rewrote my four | |
simple functions into a datatype but I am having trouble making it all fit together. | |
This file only contains the polysemy version of the code. | |
-} | |
type Dictionary = [String] | |
-- Take one character off the state return empty if there are none left | |
item :: (Members [State String, NonDet] r) => Sem r Char | |
item = do | |
cs <- get | |
case cs of | |
[] -> empty | |
(c:cs') -> do | |
put cs' | |
pure c | |
-- Take a character off the front of the state if it satisfies the predicate otherwise empty | |
sat :: (Members [State String, NonDet] r) => (Char -> Bool) -> Sem r Char | |
sat p = do | |
c <- item | |
if p c | |
then pure c | |
else empty | |
-- Check if the given string is on the front of the state otherwise empty | |
string :: (Members [State String, NonDet] r) => String -> Sem r String | |
string [] = pure "" | |
string (x:xs) = do | |
c <- sat (== x) | |
cs <- string xs | |
pure (c:cs) | |
-- This function only excepts strings that are available in the dictionary | |
word :: (Members [State String, Reader Dictionary, NonDet] r) => Sem r String | |
word = do | |
dict <- ask | |
getAlt $ foldMap (Alt . string) dict | |
-- Interpret the effects | |
runParser :: Dictionary | |
-> String | |
-> Sem [State String, Reader Dictionary, NonDet] a | |
-> Maybe a | |
runParser dict str p = | |
p | |
& evalState str | |
& runReader dict | |
& runNonDetMaybe | |
& run | |
-- Everything up to this point worked great! | |
-- But now I ran into a bit of trouble | |
-- Define this EDSL in terms of a datatype | |
data Parser m a where | |
ItemE :: Parser m Char | |
SatE :: (Char -> Bool) -> Parser m Char | |
StringE :: String -> Parser m String | |
WordE :: Parser m String | |
-- Make it a Sem | |
makeSem ''Parser | |
{- Transform my EDSL into the built in effects | |
This does not compile and returns the following error: | |
Could not deduce: (Member Parser (State String : NonDet : Reader Dictionary : r)) | |
Fix: add (Member Parser State String : NonDet : Reader Dictionary : r) to the context of | |
If I comment out the wordE case match then everything compiles. Thus my questions is why can | |
it not deduce the effects that Parser needs when wordE is present? Is it because of my use of | |
foldMap? Do I need a type annotation somewhere? This will compile with the following type signature: | |
runParserE :: (Member Parser (State String : NonDet : Reader Dictionary: r)) => Sem (Parser : r) a -> Sem (State String : NonDet : Reader Dictionary : r) a | |
But this seems excessively verbose which leads me to believe I am doing something wrong. | |
-} | |
runParserE :: | |
Members [State String, NonDet, Reader Dictionary] r | |
=> Sem (Parser : r) a | |
-> Sem r a | |
runParserE = interpret $ \case | |
ItemE -> do | |
cs <- get | |
case cs of | |
[] -> empty | |
(c:cs') -> do | |
put cs' | |
pure c | |
SatE p -> do | |
c <- item | |
if p c | |
then pure c | |
else empty | |
StringE [] -> pure "" | |
StringE (x:xs) -> do | |
c <- sat (== x) | |
cs <- string xs | |
pure (c:cs) | |
WordE -> do | |
dict <- ask | |
runParserE $ getAlt $ foldMap (Alt . stringE) dict | |
main :: IO () | |
main = pure () | |
testing :: Dictionary -> String -> Sem '[Parser, State String, Reader Dictionary, NonDet] a -> Maybe a | |
testing dict str sm = runParser dict str $ runParserE sm |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment