gidl: more unrepr fixups

src/Gidl/Interface.hs

@@ -15,22 +15,23 @@ import Gidl.Types
 lookupInterface :: InterfaceName -> InterfaceEnv -> Maybe Interface
 lookupInterface iname (InterfaceEnv ie) = lookup iname ie
 
-insertInterface :: InterfaceName -> Interface -> InterfaceEnv -> InterfaceEnv
-insertInterface iname i e@(InterfaceEnv ie) = case lookupInterface iname e of
+insertInterface :: Interface -> InterfaceEnv -> InterfaceEnv
+insertInterface i e@(InterfaceEnv ie) = case lookupInterface iname e of
   Nothing -> InterfaceEnv ((iname,i):ie)
   Just _ -> error ("insertInterface invariant broken: interface " ++ iname ++ "already exists")
+  where (Interface iname _ _) = i
 
 interfaceParents :: Interface -> [Interface]
-interfaceParents (Interface parents _) = parents
+interfaceParents (Interface _ parents _) = parents
 
 interfaceTypes :: Interface -> [Type]
-interfaceTypes ir = nub (map (methodT . snd) ms)
+interfaceTypes i = nub (map (methodT . snd) ms)
   where
-  ms = interfaceMethods ir
+  ms = interfaceMethods i
   methodT :: Method -> Type
   methodT (AttrMethod _ ty) = ty
   methodT (StreamMethod _ ty) = ty
 
 interfaceMethods :: Interface -> [(MethodName, Method)]
-interfaceMethods (Interface ps ms) = ms ++ concatMap interfaceMethods ps
+interfaceMethods (Interface _ ps ms) = ms ++ concatMap interfaceMethods ps
 

src/Gidl/Interface/AST.hs

@@ -14,7 +14,7 @@ type InterfaceName = String
 type MethodName = String
 
 data Interface
-  = Interface [Interface] [(MethodName, Method)]
+  = Interface String [Interface] [(MethodName, Method)]
   deriving (Eq, Show)
 
 data Method

src/Gidl/Parse.hs

@@ -129,13 +129,13 @@ defineType (tn, t) = do
     Just _ -> fail ("type named '" ++ tn ++ "' already exists")
     Nothing -> setTypeEnv (insertType tn t te)
 
-defineInterface :: (InterfaceName, Interface) -> Parser ParseEnv ()
-defineInterface (ina, i) = do
+defineInterface :: Interface -> Parser ParseEnv ()
+defineInterface i = do
   ie <- getInterfaceEnv
   case lookupInterface ina ie of
     Just _ -> fail ("interface named '" ++ ina ++ "' already exists")
-    Nothing -> setInterfaceEnv (insertInterface ina i ie)
-
+    Nothing -> setInterfaceEnv (insertInterface i ie)
+  where (Interface ina _ _) = i
 tNewtypeDecl :: Parser ParseEnv (TypeName, Type)
 tNewtypeDecl = tList $ do
   tIdentifier "def-newtype"
@@ -211,7 +211,7 @@ tKnownInterface  = do
     Just i -> return i
     Nothing -> fail ("expected a known interface name, got " ++ n)
 
-tInterfaceDecl :: Parser ParseEnv (InterfaceName, Interface)
+tInterfaceDecl :: Parser ParseEnv Interface
 tInterfaceDecl = tList $ do
   tIdentifier "def-interface"
   tWhiteSpace
@@ -224,8 +224,8 @@ tInterfaceDecl = tList $ do
   ps <- optionMaybe (tList (many1 tKnownInterface))
   -- XXX require the ms not shadow names in inherited interfaces
   case ps of
-    Just p -> return (n, Interface  p ms)
-    Nothing -> return (n, Interface [] ms)
+    Just p -> return (Interface  n p ms)
+    Nothing -> return (Interface n [] ms)
 
 tDecls :: Parser ParseEnv ParseEnv
 tDecls = do