some simple specs for the pipeline

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

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