diff --git a/test/unit/TestLanguagePipeline.hs b/test/unit/TestLanguagePipeline.hs index 188f7d89a..229987072 100644 --- a/test/unit/TestLanguagePipeline.hs +++ b/test/unit/TestLanguagePipeline.hs @@ -11,15 +11,16 @@ import Control.Arrow ((&&&)) import Control.Lens (toListOf) import Control.Lens.Plated (universe) import Data.Aeson (eitherDecode, encode) -import Data.Either import Data.Maybe import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Swarm.Language.Module (Module (..)) +import Swarm.Language.Parse (readTerm) import Swarm.Language.Parse.QQ (tyQ) import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm) import Swarm.Language.Pipeline.QQ (tmQ) +import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax import Swarm.Language.Typecheck (isSimpleUType) import Swarm.Language.Types @@ -161,8 +162,8 @@ testLanguagePipeline = ] , testGroup "json encoding" - [ testCase "simple expr" (roundTrip "42 + 43") - , testCase "module def" (roundTrip "def x = 41 end;\ndef y = 42 end") + [ testCase "simple expr" (roundTripTerm "42 + 43") + , testCase "module def" (roundTripTerm "def x = 41 end;\ndef y = 42 end") ] , testGroup "atomic - #479" @@ -397,13 +398,6 @@ testLanguagePipeline = where valid = flip process "" - roundTrip txt = assertEqual "roundtrip" term (decodeThrow $ encode term) - where - decodeThrow v = case eitherDecode v of - Left e -> error $ "Decoding of " <> from (T.decodeUtf8 (from v)) <> " failed with: " <> from e - Right x -> x - term = fromMaybe (error "") $ fromRight (error "") $ processTerm txt - process :: Text -> Text -> Assertion process code expect = case processTerm code of Left e @@ -417,3 +411,14 @@ testLanguagePipeline = getSyntax :: ProcessedTerm -> Syntax' Polytype getSyntax (ProcessedTerm (Module s _) _ _) = s + +-- | Check round tripping of term from and to text, then test ToJSON/FromJSON. +roundTripTerm :: Text -> Assertion +roundTripTerm txt = do + assertEqual "roundtrip (readTerm -> prettyText)" txt (prettyText term) + assertEqual "roundtrip (ToJSON -> FromJSON)" term (decodeThrow $ encode term) + where + decodeThrow v = case eitherDecode v of + Left e -> error $ "Decoding of " <> from (T.decodeUtf8 (from v)) <> " failed with: " <> from e + Right x -> x + term = fromMaybe (error "empty document") $ either (error . T.unpack) id $ readTerm txt