diff --git a/semantic-ast/src/Marshal/JSON.hs b/semantic-ast/src/Marshal/JSON.hs index c16a43a50..94fbb5ea2 100644 --- a/semantic-ast/src/Marshal/JSON.hs +++ b/semantic-ast/src/Marshal/JSON.hs @@ -21,19 +21,18 @@ import GHC.Generics import Data.Text (Text) import qualified Data.Text as Text +-- TODO: range and span will require a new release of semantic-source +-- TODO: use toEncoding -- direct serialization to ByteString + -- Serialize unmarshaled ASTs into JSON representation by auto-deriving Aeson instances generically class MarshalJSON t where - marshal :: (ToJSON a) => t a -> Value -- don't need default signature because they're the same now + marshal :: (ToJSON a) => t a -> Value marshal = object . fields [] fields :: (ToJSON a) => [(Text, Value)] -> t a -> [(Text, Value)] default fields :: ( Generic1 t, GFields (Rep1 t), ToJSON a) => [(Text, Value)] -> t a -> [(Text, Value)] fields acc = gfields acc . from1 - -- Need a way to discriminate between things we want to be represented as nodes in the JSON vs. don't (sums vs. not sums) - -- only call object where we have an "inside" value - - -- TODO: range and span will require a new release of semantic-source - +-- Implement the sum case instance {-# OVERLAPPING #-} (MarshalJSON f, MarshalJSON g) => MarshalJSON (f :+: g) where fields acc (L1 f) = fields acc f fields acc (R1 g) = fields acc g @@ -44,18 +43,10 @@ instance (GFields (Rep1 t), Generic1 t) => MarshalJSON t -- Stores meta-data for datatypes instance (GFields f, Datatype c) => GFields (M1 D c f) where gfields acc x = gfields ((Text.pack "type", String (Text.pack (datatypeName x))): acc) $ unM1 x - -- gmarshal = gmarshal . unM1 -- using unM1 instead of pattern-matching on M1 in order to express with function composition - --- Need to know constructor names in order to distinguish between two AST datatypes which both have an extraChildren field. --- Maybe a type field? - --- 1. Need to get the name of the datatype. --- 2. Pass info along somewhere where we can do something with it. -- Fold over S1 product types and pass the result to Aeson objects instance GFields fields => GFields (C1 c fields) where gfields acc x = gfields acc (unM1 x) --- TODO: we first see gfields appear where we have constructors because ... -- Implement base case for products -- To get a value out of this datum, we define another typeclass: @GValue@ with the method @gvalue@. @@ -67,13 +58,6 @@ instance (GValue p, Selector s) => GFields (S1 s p) where instance (GFields f, GFields g) => GFields (f :*: g) where gfields acc (f :*: g) = gfields (gfields acc g) f --- Implement the sum case --- TODO: not much point in generating objects for the L1/R1 portions of sums; we probably want to just spit out their contents, flattening the sum --- instance (GFields f, GFields g) => GFields (f :+: g) where --- gfields acc (L1 f) = gfields acc f --- gfields acc (R1 g) = gfields acc g --- Not calling into it anyway anymore! - -- GValue for leaves instance ToJSON a => GValue (K1 i a) where gvalue = toJSON . unK1 @@ -82,7 +66,6 @@ instance ToJSON a => GValue (K1 i a) where instance GValue Par1 where gvalue = toJSON . unPar1 --- breadcrumb, no longer relevant: This looks wrong! But GHC can infer that we only have a single instance class constraint above instance (MarshalJSON t) => GValue (Rec1 t) where gvalue (Rec1 f) = marshal f @@ -96,14 +79,10 @@ instance (GValue t) => GValue ([] :.: t) where instance (GValue t) => GValue (NonEmpty :.: t) where gvalue (Comp1 ts) = toJSON $ fmap gvalue ts --- Define a new class to operate on product field types; --- Takes an accumulator, a datatype, and returns a new accumulator value. +-- GFields operates on product field types: it takes an accumulator, a datatype, and returns a new accumulator value. class GFields f where gfields :: ToJSON a => [(Text, Value)] -> f a -> [(Text, Value)] --- gvalue is a wrapper that calls to @toJSON@ (for leaf node types such as Text) or recurses via @marshal@ --- since it's a function on types, we need a typeclass +-- gvalue is a wrapper that calls to @toJSON@ (for leaf nodes such as @Text@) or recurses via @marshal@ class GValue f where - gvalue :: (ToJSON a) => f a -> Value - --- TODO: use toEncoding -- direct serialization to ByteString + gvalue :: (ToJSON a) => f a -> Value \ No newline at end of file