github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 01:47:01 +03:00
Code Issues Projects Releases Wiki Activity

default JSON pipeline

Browse Source
This commit is contained in:
Timothy Clem 2018-08-17 16:53:36 -07:00
parent 933782ab78
commit 13e2ba2956
3 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Language/JSON/Translate.hs
View File

@ -15,10 +15,17 @@ data JSONBeautyOpts = JSONBeautyOpts { jsonPrettyPrint :: Bool }
defaultBeautyOpts :: JSONBeautyOpts
defaultBeautyOpts = JSONBeautyOpts True
defaultJSONPipeline :: ProcessT (Eff effs) Splice Splice
defaultJSONPipeline
= translatingJSON
~> beautifyingJSON defaultBeautyOpts
translatingJSON :: ProcessT (Eff effs) Splice Splice
translatingJSON = flattened <~ auto step where
step :: Splice -> Seq Splice
step (Insert el@(Truth True) c _) = splice el c "True"
step (Insert el@(Truth True) c _) = splice el c "true"
step x = pure x
beautifyingJSON :: JSONBeautyOpts -> ProcessT (Eff effs) Splice Splice

6
src/Reprinting/Translate.hs
View File

@ -52,9 +52,9 @@ translating = flattened <~ autoT (Kleisli step) where
translate el c = let emit = pure . splice el c in case (el, c) of
(Fragment f, _) -> emit f
(Truth True, _) -> emit "true"
(Truth False, _) -> emit "false"
(Nullity, _) -> emit "null"
(Truth True, _) -> emit "True"
(Truth False, _) -> emit "False"
(Nullity, _) -> emit "Null"
(Open, Just List) -> emit "["
(Open, Just Associative) -> emit "{"

2
src/Semantic/Util.hs
View File

@ -349,6 +349,6 @@ testJSONFile = do
testPipeline = do
(src, tree) <- testJSONFile
printToTerm $ runReprinter src (translatingJSON ~> beautifyingJSON defaultBeautyOpts) (mark Refactored tree)
printToTerm $ runReprinter src defaultJSONPipeline (mark Refactored tree)
printToTerm res = either (putStrLn . show) (BC.putStr . Source.sourceBytes) res