1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Define inductive ToJSONFields instances for Unions.

This commit is contained in:
Rob Rix 2017-05-29 12:34:16 -04:00
parent 289e400a53
commit 7081b3f8b8

View File

@ -8,6 +8,7 @@ module Renderer.JSON
import Data.Aeson (ToJSON, toJSON, encode, object, (.=))
import Data.Aeson as A hiding (json)
import Data.Bifunctor.Join
import Data.Functor.Union
import Data.Record
import Info
import Patch
@ -98,5 +99,12 @@ instance ToJSON a => ToJSONFields [a] where
instance ToJSON recur => ToJSONFields (Syntax leaf recur) where
toJSONFields syntax = [ "children" .= toList syntax ]
instance (Foldable f, ToJSON a, ToJSONFields (Union fs a)) => ToJSONFields (Union (f ': fs) a) where
toJSONFields (Here f) = [ "children" .= toList f ]
toJSONFields (There fs) = toJSONFields fs
instance ToJSONFields (Union '[] a) where
toJSONFields _ = []
instance StringConv [Value] ByteString where
strConv _ = toS . (<> "\n") . encode