diff --git a/src/Reprinting/Concrete.hs b/src/Reprinting/Concrete.hs index 18a3d7137..40507e01c 100644 --- a/src/Reprinting/Concrete.hs +++ b/src/Reprinting/Concrete.hs @@ -3,7 +3,6 @@ module Reprinting.Concrete ( Concrete (..) , ConcreteException (..) - , Precedence (..) , concretize ) where @@ -27,6 +26,10 @@ import Reprinting.Token -- typeclass describes how a given 'Language' interprets tokens, using -- a stack machine described by the @stack@ parameter. @stack@ must -- have a 'Lower' instance so we know where to start. +-- +-- Some possible issues we should tackle before finalizing this design: +-- * Is a stack machine too inexpressive? +-- * Is this interface too clumsy? Do we just want to use Eff, or another monad? class Lower stack => Concrete (l :: Language) stack | l -> stack, stack -> l where -- | Each 'Element' data token should emit a chunk of source code, @@ -60,6 +63,9 @@ concretize prox = -- Private interfaces +newtype JSONState = JSONState { contexts :: [Context] } + deriving (Eq, Show, Lower) + -- A class for pushing and popping contexts. This may or may not be useful -- when we implement 'Concrete' for languages other than JSON. class ContextStack state where diff --git a/test/Reprinting/Spec.hs b/test/Reprinting/Spec.hs index b38afc1b0..ebf3c3fa3 100644 --- a/test/Reprinting/Spec.hs +++ b/test/Reprinting/Spec.hs @@ -10,31 +10,34 @@ import Reprinting.Pipeline import Semantic.IO import Data.Blob -setup = do - let path = "test/fixtures/javascript/reprinting/map.json" - src <- blobSource <$> readBlobFromPath (File path Language.JSON) - tree <- parseFile jsonParser "test/fixtures/javascript/reprinting/map.json" - pure (src, tree) - spec :: Spec -spec = do - describe "reprinting" $ do +spec = describe "reprinting" $ do + (src, tree) <- runIO $ do + let path = "test/fixtures/javascript/reprinting/map.json" + src <- blobSource <$> readBlobFromPath (File path Language.JSON) + tree <- parseFile jsonParser "test/fixtures/javascript/reprinting/map.json" + pure (src, tree) + + describe "tokenization" $ do + it "should pass over a pristine tree" $ do - (src, tree) <- setup let tagged = mark Pristine tree let toks = reprint src tagged toks `shouldBe` [Chunk src] it "should emit control tokens but only 1 chunk for a wholly-modified tree" $ do - (src, tree) <- fmap (fmap (mark Modified)) setup - let toks = reprint src tree + let toks = reprint src (mark Modified tree) forM_ @[] [List, Associative] $ \t -> do toks `shouldSatisfy` (elem (TControl (Enter t))) toks `shouldSatisfy` (elem (TControl (Exit t))) describe "pipeline" $ do it "should roundtrip exactly over a pristine tree" $ do - (src, tree) <- setup let tagged = mark Pristine tree let printed = runReprinter (Proxy @'Language.JSON) src tagged printed `shouldBe` Right src + + it "should roundtrip exactly over a wholly-modified tree" $ do + let tagged = mark Modified tree + let printed = runReprinter (Proxy @'Language.JSON) src tagged + printed `shouldBe` Right src