GF.Grammar.Canonical: some Functor/Foldable/Traversable instances

2 files changed, 14 insertions, 9 deletions

diff --git a/src/compiler/GF/Grammar/Canonical.hs b/src/compiler/GF/Grammar/Canonical.hs
index 8be659e1b..ed4f3fc9e 100644
--- a/src/compiler/GF/Grammar/Canonical.hs
+++ b/src/compiler/GF/Grammar/Canonical.hs
@@ -7,6 +7,7 @@
 -- by partial evaluation. This is intended as a common intermediate
 -- representation to simplify export to other formats.
 
+{-# LANGUAGE DeriveTraversable #-}
 module GF.Grammar.Canonical where
 import Prelude hiding ((<>))
 import GF.Text.Pretty
@@ -87,13 +88,17 @@ type ParamValue = Param LinValue
 type ParamPattern = Param LinPattern
 type ParamValueDef = Param ParamId
 
-data Param arg = Param ParamId [arg] deriving (Eq,Ord,Show)
+data Param arg = Param ParamId [arg]
+                 deriving (Eq,Ord,Show,Functor,Foldable,Traversable)
 
-type RecordRowType = RecordRow LinType
+type RecordRowType  = RecordRow LinType
 type RecordRowValue = RecordRow LinValue
+type TableRowValue  = TableRow LinValue
 
-data RecordRow rhs  = RecordRow LabelId rhs  deriving (Eq,Ord,Show)
-data TableRowValue  = TableRowValue LinPattern LinValue  deriving (Eq,Ord,Show)
+data RecordRow rhs = RecordRow LabelId    rhs
+                     deriving (Eq,Ord,Show,Functor,Foldable,Traversable)
+data TableRow  rhs = TableRow  LinPattern rhs
+                     deriving (Eq,Ord,Show,Functor,Foldable,Traversable)
 
 -- *** Identifiers in Concrete Syntax
 
@@ -265,8 +270,8 @@ instance RhsSeparator LinPattern where rhsSep _ = pp "="
 instance RhsSeparator rhs => Pretty (RecordRow rhs) where
   pp (RecordRow l v) = hang (l<+>rhsSep v) 2 v
 
-instance Pretty TableRowValue where
-  pp (TableRowValue l v) = hang (l<+>"=>") 2 v
+instance Pretty rhs => Pretty (TableRow rhs) where
+  pp (TableRow l v) = hang (l<+>"=>") 2 v
 
 --------------------------------------------------------------------------------
 instance Pretty ModId where pp (ModId s) = pp s
diff --git a/src/compiler/GF/Grammar/CanonicalJSON.hs b/src/compiler/GF/Grammar/CanonicalJSON.hs
index 8024fe99a..8b3464674 100644
--- a/src/compiler/GF/Grammar/CanonicalJSON.hs
+++ b/src/compiler/GF/Grammar/CanonicalJSON.hs
@@ -210,10 +210,10 @@ instance JSON a => JSON (RecordRow a) where
     where fromRow (lbl, jsvalue) = do value <- readJSON jsvalue
                                       return (RecordRow (LabelId lbl) value)
 
-instance JSON TableRowValue where
-  showJSON (TableRowValue l v) = makeObj [(".pattern", showJSON l), (".value", showJSON v)]
+instance JSON rhs => JSON (TableRow rhs) where
+  showJSON (TableRow l v) = makeObj [(".pattern", showJSON l), (".value", showJSON v)]
 
-  readJSON o = TableRowValue <$> o!".pattern" <*> o!".value"
+  readJSON o = TableRow <$> o!".pattern" <*> o!".value"
 
 
 -- *** Identifiers in Concrete Syntax