I'm trying to update a parsec parser that uses buildExpressionParser
from Text.Parsec.Expr. I'm trying (and possibly this is ill-advised, but it looks like it's supposed to be practical) to build part of the DSL verification into the parser. But I'm having trouble getting this to work with the Operator
type, who's body needs to be a parser that yields a function.
data Location = Location { owners :: PartySet, source :: SourcePos } deriving (Eq, Ord, Show)
type Located = (,) Location
type Parser = Parsec String (Map Variable PartySet)
-- Pair a parsed thing with it's position in the source file
positioned :: Parser a -> Parser (SourcePos, a)
positioned p = do source <- getPosition
(source,) <$> p
chooseOf :: (TokenParser st -> t -> Parsec.Parser a) -> [t] -> Parser (SourcePos, a)
chooseOf cls subcls = choice $ [positioned $ cls tokenizer sc | sc <- subcls]
-- Define parser for Algebra
algebraParser :: Parser (Located (Algebra Located))
algebraParser = buildExpressionParser ops terms
terms = parens tokenizer algebraParser <|> litParser <|> varParser
-- Parse a Literal Bit (0 or 1)
litParser = do (source, b) <- (const (Bit True) <$$> chooseOf reserved trueNames)
<|> (const (Bit False) <$$> chooseOf reserved falseNames)
let loc = Location{source, owners=top}
return (loc, Literal (loc, b))
-- Parse a variable as they appear in algebra terms
varParser = do (loc, var) <- boundVariable
return (loc, Var (loc, var))
-- Step 1 for building the Operator objects
biOpParser :: (Located (Algebra Located) -> Located (Algebra Located) -> Algebra Located)
-> SourcePos
-> (Located (Algebra Located), Located (Algebra Located))
-> Parser (Located (Algebra Located))
biOpParser constructor source (alg1@(Location{owners=o1}, _), alg2@(Location{owners=o2}, _)) =
do let mowners = o1 `intersect` o2
maybe (parserFail "Can't compute binary operator. Nobody owns both arguments")
(\owners -> return (Location{source, owners}, constructor alg1 alg2))
mowners
-- Step 2, broken out for the XOR case.
xorParser :: Parser (Located (Algebra Located) -> Located (Algebra Located) -> Located (Algebra Located))
xorParser = do (source, _) <- chooseOf reservedOp xorNames
curry <$> sequence (biOpParser Xor source)
ops :: OperatorTable String (Map Variable PartySet) Identity (Located (Algebra Located))
ops = [ [Prefix $ do (source, _) <- chooseOf reservedOp notNames
return \alg@(loc, _) -> (loc{source}, Not alg)]
,[Infix xorParser AssocLeft]
-- Step 3; the AND case has step 2 inlined.
,[Infix (do (source, _) <- chooseOf reservedOp andNames
curry <$> sequence (biOpParser And source)) AssocLeft] ]
I can add more of the code if that's helpful; or I could try to reduce this to a more pure situation.
The problem is inside algebraParser
; I want to use buildExpressionParser
, which requires a table of Operator
s.
The heart of the problem is parserFail "Can't XOR. Nobody owns both arguments"
inside biOpParser
.
An op-term (like XOR
) may or may not be valid depending on the "type" (ownership) of its arguments. I'm trying to use the "user state" of the Parser monad to store ownerships, and (correspondingly) I'd like violations to show up as parser errors. That means the test needs to be written inside the Parser monad so I can use parserFail
, but that conflicts with the need for the "op function" to be yielded by the parser.
The actual error shown for the code above is for sequence (biOpParser Xor source)
inside xorParser
:
No instance for (
Traversable (
(->) (Located (Algebra Located), Located (Algebra Located))
)
) arising from a use of ‘sequence’
I understand that it's not possible/sensible to invert arbitrary pairs of nested monads; as far as I can tell Distributive wouldn't help either, right?
Is there an easy fix? Is there a reasonable change to my approach that's likely to work? Is there some other fundamental thing I've misused or misunderstood?