tower backend: correct code generation for enum/newtype/atomic attrs

src/Gidl/Backend/Ivory/Schema.hs

@@ -65,8 +65,8 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
             PrimType VoidType -> text (accessorName n) <+> colon <> colon
                 <+> text "(forall s r b . Ivory ('Effects r b (Scope s)) IBool)"
             _ -> text (accessorName n) <+> colon <> colon
-                  <+> parens (text "forall s r b s' . ConstRef s'" 
-                    <+> parens (text (typeIvoryType t))
+                  <+> parens (text "forall s r b s' . ConstRef s'"
+                    <+> typeIvoryArea t
                     <+> text "-> Ivory ('Effects r b (Scope s)) IBool")
         | (_, (Message n t)) <- schema
         ]
@@ -120,7 +120,7 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
             _ -> text (accessorName n) <+> equals <+> text "\\m -> do" </> indent 4
                   (stack [ text "o <- deref offs"
                          , text "let required_size = fromInteger (packSize (packRep :: PackRep"
-                             <+> parens (text (typeIvoryType t)) <+> text ")"
+                             <+> typeIvoryArea t <+> text ")"
                              <+> text "+ packSize (packRep :: PackRep (Stored Uint32)))"
                          , text "    sufficient_space = (o + required_size) <? arrayLen arr"
                          , text "when sufficient_space $ do"
@@ -140,6 +140,12 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
   accessorName n = userEnumValueName n ++ schemaName
   typeName = interfaceName ++ schemaName
 
+typeIvoryArea :: Type -> Doc
+typeIvoryArea t@(StructType _ _) = parens (text (typeIvoryType t))
+typeIvoryArea   (PrimType VoidType) = error "should not take typeIvoryArea of VoidType"
+typeIvoryArea t@(PrimType (AtomType _)) = parens (text "Stored" <+> text (typeIvoryType t))
+typeIvoryArea t@(PrimType _) = parens (text "Stored" <+> text (typeIvoryType t) <> dot <> text (typeIvoryType t))
+
 parserName :: String -> String
 parserName tn = userEnumValueName tn ++ "Parser"
 senderName :: String -> String

src/Gidl/Backend/Tower/Schema.hs

@@ -9,7 +9,8 @@ import Gidl.Types
 import Gidl.Interface
 import Gidl.Schema
 import Gidl.Backend.Ivory.Types
-import Gidl.Backend.Ivory.Schema (ifModuleName, parserName, senderName)
+import Gidl.Backend.Ivory.Schema ( ifModuleName, parserName, senderName
+                                 , typeIvoryArea)
 import Ivory.Artifact
 import Text.PrettyPrint.Mainland
 
@@ -68,7 +69,7 @@ schemaDoc interfaceName (Schema schemaName schema) = stack
             PrimType VoidType -> accessorName n <+> colon <> colon
                 <+> text "ChanOutput (Stored IBool)"
             _ -> accessorName n <+> colon <> colon
-                <+> text "ChanOutput" <+> parens (text (typeIvoryType t))
+                <+> text "ChanOutput" <+> typeIvoryArea t
         | (_, (Message n t)) <- schema
         ]
     , empty

src/Gidl/Backend/Tower/Server.hs

@@ -3,12 +3,12 @@ module Gidl.Backend.Tower.Server where
 
 
 import Data.Monoid
-import Data.List (intercalate)
+import Data.List (intercalate, nub)
 
 import Gidl.Interface
 import Gidl.Schema
 import Gidl.Backend.Ivory.Types
-import Gidl.Backend.Ivory.Schema (ifModuleName)
+import Gidl.Backend.Ivory.Schema (ifModuleName, typeIvoryArea)
 import Ivory.Artifact
 import Text.PrettyPrint.Mainland
 
@@ -69,6 +69,7 @@ serverModule modulepath i =
   rootpath = reverse . drop 2 . reverse
   modAt path = mconcat (punctuate dot (map text path))
   im mname = modAt (modulepath ++ [ifModuleName i, mname])
+  tm mname = modAt (rootpath modulepath ++ ["Ivory","Types", mname])
 
   imports =
     [ text "import" <+> modAt (rootpath modulepath ++ ["Tower", "Attr"])
@@ -76,7 +77,12 @@ serverModule modulepath i =
     , text "import" <+> im "Consumer"
     , text "import Ivory.Language"
     , text "import Ivory.Tower"
-    ]
+    ] ++ typeimports
+
+  typeimports = map (importDecl tm)
+              $ nub
+              $ map importType
+              $ interfaceTypes i
 
 
 attrsDataType :: Interface -> Doc
@@ -87,7 +93,7 @@ attrsDataType i = text "data" <+> constructor <+> text "(p :: Area * -> *) ="
   constructor = text (ifModuleName i) <> text "Attrs"
   body = encloseStack lbrace rbrace comma
     [ text n <+> colon <> colon <+> text "p"
-                 <+> parens (text (typeIvoryType t))
+                 <+> typeIvoryArea t
     | (aname, AttrMethod _ t)  <- interfaceMethods i
     , let n = userEnumValueName aname
     ]