-
Notifications
You must be signed in to change notification settings - Fork 454
/
Spec.hs
57 lines (47 loc) · 1.89 KB
/
Spec.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
{-# LANGUAGE TypeFamilies, TypeOperators #-}
module Rewriting.JSON.Spec (spec) where
import Prelude hiding (id, (.))
import SpecHelpers
import Control.Category
import Control.Rewriting as Rewriting
import qualified Data.ByteString as B
import Data.History as History
import qualified Data.Source as Source
import Data.Sum
import qualified Data.Syntax.Literal as Literal
import Data.Text (Text)
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