Parse expressions

Only '=' for now.
This commit is contained in:
Joscha 2020-12-13 21:56:47 +00:00
parent 1547561fa5
commit 744091de01
3 changed files with 18 additions and 6 deletions

View file

@ -15,6 +15,7 @@ dependencies:
- base >= 4.7 && < 5 - base >= 4.7 && < 5
- containers - containers
- megaparsec - megaparsec
- parser-combinators
- text - text
- transformers - transformers

View file

@ -36,6 +36,7 @@ library
base >=4.7 && <5 base >=4.7 && <5
, containers , containers
, megaparsec , megaparsec
, parser-combinators
, text , text
, transformers , transformers
default-language: Haskell2010 default-language: Haskell2010
@ -51,6 +52,7 @@ executable propa-tools-exe
base >=4.7 && <5 base >=4.7 && <5
, containers , containers
, megaparsec , megaparsec
, parser-combinators
, propa-tools , propa-tools
, text , text
, transformers , transformers

View file

@ -10,6 +10,7 @@ import Data.Bifunctor
import Data.Char import Data.Char
import Data.Void import Data.Void
import Control.Monad.Combinators.Expr
import qualified Data.Text as T import qualified Data.Text as T
import Text.Megaparsec import Text.Megaparsec
import qualified Text.Megaparsec.Char as C import qualified Text.Megaparsec.Char as C
@ -71,15 +72,23 @@ pTerm
<|> (uncurry Stat <$> pStat) <|> (uncurry Stat <$> pStat)
<|> try pCons <|> try pCons
<|> pList <|> pList
<|> parens pExpr
pExpr :: Parser (Term T.Text)
pExpr = makeExprParser pTerm
[ [ binary "=" ]
]
where
binary name = InfixL $ (\a b -> Stat name [a, b]) <$ symbol name
pTerms :: Parser [Term T.Text] pTerms :: Parser [Term T.Text]
pTerms = (pTerm `sepBy1` symbol ",") <* symbol "." pTerms = (pExpr `sepBy1` symbol ",") <* symbol "."
pDef :: Parser (Def T.Text) pDef :: Parser (Def T.Text)
pDef = do pDef = do
name <- pName name <- pName
args <- parens (pTerm `sepBy1` symbol ",") <|> pure [] args <- parens (pExpr `sepBy1` symbol ",") <|> pure []
terms <- (symbol ":-" *> (pTerm `sepBy1` symbol ",")) <|> pure [] terms <- (symbol ":-" *> (pExpr `sepBy1` symbol ",")) <|> pure []
void $ symbol "." void $ symbol "."
pure $ Def name args terms pure $ Def name args terms