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

JSON has to handle all this now

Browse Source
This commit is contained in:
Timothy Clem 2018-08-20 18:10:28 -07:00
parent 8e9136fd57
commit 11252f9ba7
1 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -20,21 +20,23 @@ defaultJSONPipeline
translatingJSON :: Monad m => ProcessT m Splice Splice
translatingJSON = flattened <~ auto step where
step :: Splice -> Seq Splice
step (Insert el cs txt) = splice el cs $ case (el, listToMaybe cs) of
(Truth True, _) -> "true"
(Truth False, _) -> "false"
(Nullity, _) -> "null"
step s@(Unhandled el cs ) =
let emit = splice el cs
in case (el, listToMaybe cs) of
(Truth True, _) -> emit "true"
(Truth False, _) -> emit "false"
(Nullity, _) -> emit "null"
(Open, Just List) -> "["
(Close, Just List) -> "]"
(Open, Just Associative) -> "{"
(Close, Just Associative) -> "}"
(Open, Just List) -> emit "["
(Close, Just List) -> emit "]"
(Open, Just Associative) -> emit "{"
(Close, Just Associative) -> emit "}"
(Separator, Just List) -> ","
(Separator, Just Pair) -> ":"
(Separator, Just Associative) -> ","
(Separator, Just List) -> emit ","
(Separator, Just Pair) -> emit ":"
(Separator, Just Associative) -> emit ","
_ -> txt
_ -> pure s
step x = pure x