1
1
mirror of https://github.com/github/semantic.git synced 2025-01-05 14:11:33 +03:00

Move the ToJSONFields/ToJSON instances for Records into Data.Record.

This commit is contained in:
Rob Rix 2017-09-09 17:18:24 +01:00
parent 7a88cad094
commit 62603c803c
2 changed files with 14 additions and 11 deletions

View File

@ -1,6 +1,8 @@
{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Data.Record where
import Data.Aeson
import Data.JSON.Fields
import Data.Kind
import Data.Semigroup
import Data.Text.Prettyprint.Doc
@ -81,3 +83,15 @@ instance ConstrainAll Pretty ts => Pretty (Record ts) where
where collectPretty :: ConstrainAll Pretty ts => Record ts -> [Doc ann]
collectPretty Nil = []
collectPretty (first :. rest) = pretty first : collectPretty rest
instance (ToJSONFields h, ToJSONFields (Record t)) => ToJSONFields (Record (h ': t)) where
toJSONFields (h :. t) = toJSONFields h <> toJSONFields t
instance ToJSONFields (Record '[]) where
toJSONFields _ = []
instance ToJSONFields (Record fs) => ToJSON (Record fs) where
toJSON = object . toJSONFields
toEncoding = pairs . mconcat . toJSONFields

View File

@ -17,7 +17,6 @@ import Data.JSON.Fields
import qualified Data.Map as Map
import Data.Output
import Data.Proxy
import Data.Record
import Data.Semigroup ((<>))
import Data.Text (pack, Text)
import Data.Text.Encoding (decodeUtf8)
@ -57,16 +56,6 @@ instance (ToJSONFields a, ToJSONFields (f (Term f a))) => ToJSON (Term f a) wher
toJSON = object . toJSONFields
toEncoding = pairs . mconcat . toJSONFields
instance (ToJSONFields h, ToJSONFields (Record t)) => ToJSONFields (Record (h ': t)) where
toJSONFields (h :. t) = toJSONFields h <> toJSONFields t
instance ToJSONFields (Record '[]) where
toJSONFields _ = []
instance ToJSONFields (Record fs) => ToJSON (Record fs) where
toJSON = object . toJSONFields
toEncoding = pairs . mconcat . toJSONFields
instance ToJSONFields Range where
toJSONFields Range{..} = ["sourceRange" .= [ start, end ]]