From ba895fec3f92cd0f0426f525f3ba816d50074004 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Sun, 6 Aug 2017 16:32:17 -0400 Subject: [PATCH] Define ToJSONFields over Union non-inductively. --- src/Renderer/JSON.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index eee91e62d..6c9dbd5e3 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -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 _ = []