parse/unparse test

rlp.cabal

@@ -30,7 +30,6 @@ library
                     , Core.TH
                     , Core.HindleyMilner
                     , Control.Monad.Errorful
-                    , Data.Monoid.Utils
 
     other-modules:    Data.Heap
                     , Data.Pretty
@@ -99,9 +98,12 @@ test-suite rlp-test
                  , text
                  , pretty
                  , microlens-platform
+
     other-modules: Arith
                  , GMSpec
                  , CoreSyntax
                  , Core.HindleyMilnerSpec
+                 , Core.ParseSpec
+
     build-tool-depends: hspec-discover:hspec-discover
 

src/Compiler/JustRun.hs

@@ -11,6 +11,8 @@ module Compiler.JustRun
     ( justLexSrc
     , justParseSrc
     , justTypeCheckSrc
+    , RlpcError
+    , Program'
     )
     where
 ----------------------------------------------------------------------------------

tst/Core/ParseSpec.hs

@@ -0,0 +1,39 @@
+module Core.ParseSpec
+    ( spec
+    )
+    where
+----------------------------------------------------------------------------------
+import CoreSyntax
+import Core.Syntax
+import Compiler.JustRun
+import Compiler.RlpcError
+import Control.Monad                ((<=<))
+import Data.Coerce
+import Data.Text                    qualified as T
+import Data.Functor.Classes         (Eq1(..))
+import Test.Hspec
+import Test.QuickCheck
+----------------------------------------------------------------------------------
+
+spec :: Spec
+spec = do
+    it "should be a right-inverse to the unparser\
+        \up to source code congruency" $
+        property $ \p -> (unparse <=< parse) p ~== Right p
+
+    -- TODO: abitrary ASTs
+    -- it "should be a right-inverse to the unparser\
+    --     \up to source code congruency" $
+    --     property $ \p -> (parse <=< unparse) p == Right p
+
+(~==) :: (Eq1 f) => f ProgramSrc -> f ProgramSrc -> Bool
+(~==) = liftEq congruentSrc
+
+infix 4 ~==
+
+parse :: ProgramSrc -> Either RlpcError Program'
+parse (ProgramSrc s) = justParseSrc (T.unpack s)
+
+unparse :: Program' -> Either RlpcError ProgramSrc
+unparse = Right . unparseCoreProg
+

tst/CoreSyntax.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings, LambdaCase, GeneralisedNewtypeDeriving #-}
 module CoreSyntax
     ( ProgramSrc(..)
-    , (~==)
     , congruentSrc
     , unparseCoreProg
     )
@@ -203,12 +202,8 @@ ws1 = elements [" ", "  "]
 
 -- | Two bodies of source code are considered congruent iff the parser produces
 -- identical ASTs for both.
-(~==) :: ProgramSrc -> ProgramSrc -> Bool
-(~==) = (==) `on` (justParseSrc . T.unpack . coerce)
-
--- | Prefix synonym for @(~==)@
 congruentSrc :: ProgramSrc -> ProgramSrc -> Bool
-congruentSrc = (~==)
+congruentSrc = (==) `on` (justParseSrc . T.unpack . coerce)
 
 ----------------------------------------------------------------------------------