add spec file

semantic.cabal

@@ -312,6 +312,7 @@ test-suite test
                      , Analysis.TypeScript.Spec
                      , Assigning.Assignment.Spec
                      , Control.Abstract.Evaluator.Spec
+                     , Control.Rewriting.Spec
                      , Data.Abstract.Path.Spec
                      , Data.Diff.Spec
                      , Data.Functor.Classes.Generic.Spec

test/Control/Rewriting/Spec.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE TypeFamilies, TypeOperators #-}
+
+module Control.Rewriting.Spec (spec) where
+
+import SpecHelpers
+
+import           Control.Abstract.Matching as Matching
+import           Control.Rewriting as Rewriting
+import qualified Data.ByteString as B
+import           Data.Either
+import qualified Data.Source as Source
+import           Data.Sum
+import qualified Data.Syntax.Literal as Literal
+import           Language.JSON.PrettyPrint
+import Data.History as History
+
+import Data.Text (Text)
+
+-- import           Reprinting.Pipeline
+
+onTrees :: ( Literal.TextElement :< syn
+           , Literal.KeyValue :< syn
+           , Apply Functor syn
+           , term ~ Term (Sum syn) (Record (History : fields))
+           ) => Rewrite (env, term) m (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))
+
+isHi :: ( Literal.TextElement :< fs
+        , ann ~ Record (History : fields)
+        ) => Matcher (Term (Sum fs) ann) Text
+isHi = match Literal.textElementContent (Matching.target <* ensure (== "'hi'"))
+
+spec :: Spec
+spec = describe "rewriting" $ do
+  it "should add keys to JSON values" $ do
+    let path = "test/fixtures/json/rewriting/add_keys.json"
+
+    bytes <- Source.fromUTF8 <$> B.readFile path
+    json <- parseFile jsonParser path
+
+    refactored <-
+      case applyPure (somewhere' onTrees markRefactored) () (History.mark Unmodified json) of
+        Left  l -> fail (show l)
+        Right r -> pure r
+
+    length (runMatcher @[] isHi refactored) `shouldBe` 1
+
+    -- 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,6 +7,7 @@ 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.Path.Spec
 import qualified Data.Functor.Classes.Generic.Spec
@@ -45,6 +46,7 @@ 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.Abstract.Path" Data.Abstract.Path.Spec.spec
       describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec

test/fixtures/json/rewriting/add_keys.json

@@ -0,0 +1,6 @@
+{
+  "fore": "aft",
+  "dang": {"dude": "yeah"},
+  "100": "one hundred",
+  "test": {}
+}

test/fixtures/json/rewriting/add_keys_expected.json

@@ -0,0 +1,8 @@
+{
+  "fore": "aft",
+  "dang": {"dude": "yeah"},
+  "100": "one hundred",
+  "test": {
+    'hi': 'bye'
+  }
+}