github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-20 21:31:48 +03:00
Code Issues Projects Releases Wiki Activity

Define ToJSONFields over Union non-inductively.

Browse Source
This commit is contained in:
Rob Rix 2017-08-06 16:32:17 -04:00
parent eed5934a21
commit ba895fec3f
1 changed files with 3 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Renderer/JSON.hs
View File

@ -19,6 +19,7 @@ import Data.Foldable (toList)
import Data.Functor.Both (Both)
import qualified Data.Map as Map
import Data.Output
import Data.Proxy
import Data.Record
import Data.Semigroup ((<>))
import Data.Text (pack, Text)
@ -110,10 +111,8 @@ instance ToJSON a => ToJSONFields [a] where
instance ToJSON recur => ToJSONFields (Syntax recur) where
toJSONFields syntax = [ "children" .= toList syntax ]
instance (Foldable f, ToJSON a, ToJSONFields (Union fs a)) => ToJSONFields (Union (f ': fs) a) where
toJSONFields u = case decompose u of
Left u' -> toJSONFields u'
Right r -> [ "children" .= toList r ]
instance (Apply1 Foldable fs, ToJSON a) => ToJSONFields (Union fs a) where
toJSONFields = apply1 (Proxy :: Proxy Foldable) (\ r -> [ "children" .= toList r ])
instance ToJSONFields (Union '[] a) where
toJSONFields _ = []