test.hs

{-# 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