unify the last spec

semantic.cabal

@@ -328,7 +328,6 @@ test-suite test
                      , Analysis.TypeScript.Spec
                      , Assigning.Assignment.Spec
                      , Control.Abstract.Evaluator.Spec
-                     , Control.Rewriting.Spec
                      , Data.Abstract.Path.Spec
                      , Data.Abstract.Name.Spec
                      , Data.Diff.Spec
@@ -350,6 +349,7 @@ test-suite test
                      , Proto3.Roundtrip
                      , Reprinting.Spec
                      , Rewriting.Go.Spec
+                     , Rewriting.JSON.Spec
                      , Rewriting.Python.Spec                     
                      , Rendering.TOC.Spec
                      , Semantic.Spec

src/Control/Rewriting.hs

@@ -21,6 +21,7 @@ module Control.Rewriting
   , narrow
   , narrowF
   , enter
+  , create
   -- | Useful rewrites
   , mhead
   , mjust
@@ -41,6 +42,7 @@ import           Control.Arrow
 import           Control.Category
 import qualified Data.Functor.Foldable as Foldable
 
+import Data.History
 import Data.Sum
 import Data.Term
 
@@ -164,6 +166,9 @@ narrowF = do
     Just fs -> pure (In ann fs)
     Nothing -> empty
 
+create :: (f :< fs, Apply Functor fs, term ~ Term (Sum fs) History) => f term -> Rule term
+create f = remark Refactored <$> (injectTerm <$> fmap annotation id <*> pure f)
+
 -- | Matches on the head of the input list. Fails if the list is empty.
 --
 -- @mhead = only listToMaybe@

test/Control/Rewriting/Spec.hs

@@ -1,64 +0,0 @@
-{-# LANGUAGE TypeFamilies, TypeOperators #-}
-
-module Control.Rewriting.Spec (spec) where
-
-import SpecHelpers
-
-spec :: Spec
-spec = pure ()
-
--- import           Prelude hiding (id, (.))
-
--- import SpecHelpers
-
--- import qualified Data.ByteString as B
--- import           Data.Either
--- import           Data.Text (Text)
-
--- import           Control.Category
--- import           Control.Rewriting as Rewriting
--- import           Data.History as History
--- import qualified Data.Source as Source
--- import           Data.Sum
--- import qualified Data.Syntax.Literal as Literal
--- import           Language.JSON.PrettyPrint
--- import           Reprinting.Pipeline
-
--- -- Adds a "hi": "bye" key-value pair to any empty Hash.
--- onTrees :: ( Literal.TextElement :< syn
---            , Literal.KeyValue :< syn
---            , Apply Functor syn
---            , term ~ Term (Sum syn) History
---            ) => Rewrite (env, term) (Literal.Hash term)
--- onTrees = do
---   Literal.Hash els <- Rewriting.target
---   guard (null els)
---   k <- modified $ Literal.TextElement "\"hi\""
---   v <- modified $ Literal.TextElement "\"bye\""
---   pair <- modified $ (Literal.KeyValue k v)
---   pure (Literal.Hash (pair : els))
-
--- -- Matches only "hi" string literals.
--- isHi :: ( Literal.TextElement :< fs
---         ) => Rewrite (Term (Sum fs) History) Text
--- isHi = enter Literal.textElementContent
---        >>> ensure (== "\"hi\"")
-
--- spec :: Spec
--- spec = describe "rewriting" $ do
---   let path = "test/fixtures/json/rewriting/add_keys.json"
-
---   bytes <- runIO $ Source.fromUTF8 <$> B.readFile path
-
---   refactored <- runIO $ do
---     json <- parseFile jsonParser path
---     let result = rewrite (somewhere onTrees markRefactored) () (History.mark Unmodified json)
---     either (fail . show) pure result
-
---   it "should add keys to JSON values" $ do
---     length (matchRecursively @[] isHi refactored) `shouldBe` 1
-
---   it "should round-trip correctly" $ do
---     let res = runReprinter bytes defaultJSONPipeline refactored
---     expected <- Source.fromUTF8 <$> B.readFile "test/fixtures/json/rewriting/add_keys_expected.json"
---     res `shouldBe` Right expected

test/Rewriting/JSON/Spec.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE TypeOperators, TypeFamilies #-}
+
+module Rewriting.JSON.Spec (spec) where
+
+import           Prelude hiding (id, (.))
+
+import SpecHelpers
+
+import qualified Data.ByteString as B
+import           Data.Either
+import           Data.Text (Text)
+
+import           Control.Category
+import           Control.Rewriting as Rewriting
+import           Data.History as History
+import qualified Data.Source as Source
+import           Data.Sum
+import qualified Data.Syntax.Literal as Literal
+import           Language.JSON.PrettyPrint
+import           Reprinting.Pipeline
+
+-- Adds a "hi": "bye" key-value pair to any empty Hash.
+onTrees :: ( Literal.TextElement :< syn
+          , Literal.Hash :< syn
+          , Literal.KeyValue :< syn
+          , Apply Functor syn
+          , term ~ Term (Sum syn) History
+          ) => Rule term
+onTrees = do
+  Literal.Hash els <- Rewriting.target >>= guardTerm
+  guard (null els)
+  k <- create $ Literal.TextElement "\"hi\""
+  v <- create $ Literal.TextElement "\"bye\""
+  pair <- create $ (Literal.KeyValue k v)
+  create (Literal.Hash (pair : els))
+
+-- Matches only "hi" string literals.
+isHi :: ( Literal.TextElement :< fs
+        ) => Rewrite (Term (Sum fs) History) Text
+isHi = enter Literal.textElementContent
+       >>> ensure (== "\"hi\"")
+
+spec :: Spec
+spec = describe "rewriting" $ do
+  let path = "test/fixtures/json/rewriting/add_keys.json"
+
+  bytes <- runIO $ Source.fromUTF8 <$> B.readFile path
+
+  refactored <- runIO $ do
+    json <- parseFile jsonParser path
+    let result = rewrite @Maybe (History.mark Unmodified json) (topDownAny onTrees) 
+    maybe (fail "rewrite failed") pure result
+
+  it "should add keys to JSON values" $ do
+    length (recursively @[] isHi refactored) `shouldBe` 1
+
+  it "should round-trip correctly" $ do
+    let res = runReprinter bytes defaultJSONPipeline refactored
+    expected <- Source.fromUTF8 <$> B.readFile "test/fixtures/json/rewriting/add_keys_expected.json"
+    res `shouldBe` Right expected

test/Spec.hs

@@ -7,7 +7,6 @@ import qualified Analysis.Ruby.Spec
 import qualified Analysis.TypeScript.Spec
 import qualified Assigning.Assignment.Spec
 import qualified Control.Abstract.Evaluator.Spec
-import qualified Control.Rewriting.Spec
 import qualified Data.Diff.Spec
 import qualified Data.Abstract.Name.Spec
 import qualified Data.Abstract.Path.Spec
@@ -27,6 +26,7 @@ import qualified Numeric.Spec
 import qualified Rendering.TOC.Spec
 import qualified Reprinting.Spec
 import qualified Rewriting.Go.Spec
+import qualified Rewriting.JSON.Spec
 import qualified Rewriting.Python.Spec
 import qualified Tags.Spec
 import qualified Semantic.Spec
@@ -52,7 +52,6 @@ main = do
       describe "Analysis.TypeScript" (Analysis.TypeScript.Spec.spec args)
       describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
       describe "Control.Abstract.Evaluator" Control.Abstract.Evaluator.Spec.spec
-      describe "Control.Rewriting.Spec" Control.Rewriting.Spec.spec
       describe "Data.Diff" Data.Diff.Spec.spec
       describe "Data.Graph" Data.Graph.Spec.spec
       describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
@@ -71,6 +70,7 @@ main = do
       describe "Rendering.TOC" Rendering.TOC.Spec.spec
       describe "Reprinting.Spec" Reprinting.Spec.spec
       describe "Rewriting.Go" Rewriting.Go.Spec.spec
+      describe "Rewriting.JSON" Rewriting.JSON.Spec.spec
       describe "Rewriting.Python" Rewriting.Python.Spec.spec      
       describe "Tags.Spec" Tags.Spec.spec
       describe "Semantic" Semantic.Spec.spec