From 744091de01821e65c14f004605a7306e0c8f7ee4 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Sun, 13 Dec 2020 21:56:47 +0000
Subject: [PATCH] Parse expressions

Only '=' for now.
---
 package.yaml              |  1 +
 propa-tools.cabal         |  2 ++
 src/Propa/Prolog/Parse.hs | 21 +++++++++++++++------
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/package.yaml b/package.yaml
index 497600f..ea4d11c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -15,6 +15,7 @@ dependencies:
 - base >= 4.7 && < 5
 - containers
 - megaparsec
+- parser-combinators
 - text
 - transformers
 
diff --git a/propa-tools.cabal b/propa-tools.cabal
index 6e42b52..2ac17e0 100644
--- a/propa-tools.cabal
+++ b/propa-tools.cabal
@@ -36,6 +36,7 @@ library
       base >=4.7 && <5
     , containers
     , megaparsec
+    , parser-combinators
     , text
     , transformers
   default-language: Haskell2010
@@ -51,6 +52,7 @@ executable propa-tools-exe
       base >=4.7 && <5
     , containers
     , megaparsec
+    , parser-combinators
     , propa-tools
     , text
     , transformers
diff --git a/src/Propa/Prolog/Parse.hs b/src/Propa/Prolog/Parse.hs
index 6aba6b4..004b15e 100644
--- a/src/Propa/Prolog/Parse.hs
+++ b/src/Propa/Prolog/Parse.hs
@@ -10,10 +10,11 @@ import           Data.Bifunctor
 import           Data.Char
 import           Data.Void
 
-import qualified Data.Text                  as T
+import           Control.Monad.Combinators.Expr
+import qualified Data.Text                      as T
 import           Text.Megaparsec
-import qualified Text.Megaparsec.Char       as C
-import qualified Text.Megaparsec.Char.Lexer as L
+import qualified Text.Megaparsec.Char           as C
+import qualified Text.Megaparsec.Char.Lexer     as L
 
 import           Propa.Prolog.Types
 
@@ -71,15 +72,23 @@ pTerm
   <|> (uncurry Stat <$> pStat)
   <|> try pCons
   <|> 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 = (pTerm `sepBy1` symbol ",") <* symbol "."
+pTerms = (pExpr `sepBy1` symbol ",") <* symbol "."
 
 pDef :: Parser (Def T.Text)
 pDef = do
   name <- pName
-  args <- parens (pTerm `sepBy1` symbol ",") <|> pure []
-  terms <- (symbol ":-" *> (pTerm `sepBy1` symbol ",")) <|> pure []
+  args <- parens (pExpr `sepBy1` symbol ",") <|> pure []
+  terms <- (symbol ":-" *> (pExpr `sepBy1` symbol ",")) <|> pure []
   void $ symbol "."
   pure $ Def name args terms