ivory backend: fix depends on generated ivory modules

src/Gidl/Backend/Cabal.hs

@@ -15,6 +15,7 @@ data CabalFile =
     , hs_source_dirs :: [String]
     , default_language :: String
     , ghc_options :: String
+    , executables :: [CabalExe]
     , tests :: [CabalTest]
     } deriving (Eq, Show)
 
@@ -27,6 +28,14 @@ data CabalTest =
     , test_build_depends :: [String]
     } deriving (Eq, Show)
 
+data CabalExe =
+  CabalExe
+    { exe_name :: String
+    , exe_hs_source_dirs :: [String]
+    , exe_main_is :: String
+    , exe_build_depends :: [String]
+    } deriving (Eq, Show)
+
 defaultCabalFile :: String -> [String] -> [String] -> CabalFile
 defaultCabalFile name_ exposed_modules_ build_depends_ = CabalFile
   { name = name_
@@ -37,9 +46,18 @@ defaultCabalFile name_ exposed_modules_ build_depends_ = CabalFile
   , hs_source_dirs = ["src"]
   , default_language = "Haskell2010"
   , ghc_options = "-Wall"
+  , executables = []
   , tests = []
   }
 
+defaultCabalExe :: String -> String -> [String] -> CabalExe
+defaultCabalExe name_ main_ build_depends_ = CabalExe
+  { exe_name = name_
+  , exe_hs_source_dirs = ["tests"]
+  , exe_main_is = main_
+  , exe_build_depends = "base >= 4.7" : build_depends_
+  }
+
 defaultCabalTest :: String -> String -> [String] -> CabalTest
 defaultCabalTest name_ main_ build_depends_ = CabalTest
   { test_name = name_
@@ -68,9 +86,20 @@ cabalFileArtifact CabalFile{..} = artifactText (name ++ ".cabal") $
       , text "default-language:" <+> text default_language
       , text "ghc-options:" <+> text ghc_options
       ]
-    , stack [ cabalTestDoc t | t <- tests ]
+    , stack [ empty </> cabalExeDoc e | e <- executables ]
+    , stack [ empty </> cabalTestDoc t | t <- tests ]
     ]
 
+cabalExeDoc :: CabalExe -> Doc
+cabalExeDoc CabalExe{..} =
+  text "executable" <+> text exe_name </> indent 2 (stack
+    [ text "main-is:" <+> text exe_main_is
+    , text "hs-source-dirs:" <+> sep (punctuate comma (map text exe_hs_source_dirs))
+    , text "build-depends:" <+> align (stack (punctuate comma (map text exe_build_depends)))
+    , text "default-language: Haskell2010"
+    , text "ghc-options: -Wall"
+    ])
+
 cabalTestDoc :: CabalTest -> Doc
 cabalTestDoc CabalTest{..} =
   text "Test-Suite" <+> text test_name </> indent 2 (stack

src/Gidl/Backend/Ivory.hs

@@ -15,6 +15,7 @@ import Text.PrettyPrint.Mainland
 ivoryBackend :: TypeEnv -> InterfaceEnv -> String -> String -> [Artifact]
 ivoryBackend (TypeEnv te) (InterfaceEnv ie) pkgname namespace_raw =
   [ cabalFileArtifact cf
+  , artifactPath "tests" $ codegenTest namespace
   , makefile
   ] ++
   [ artifactPath "src" m | m <- sourceMods
@@ -31,7 +32,9 @@ ivoryBackend (TypeEnv te) (InterfaceEnv ie) pkgname namespace_raw =
             ++ [ typeUmbrella namespace userDefinedTypes
                , unpackModule namespace
                ]
-  cf = (defaultCabalFile pkgname cabalmods deps)
+  cf = (defaultCabalFile pkgname cabalmods deps) { executables = [ cg_exe ] }
+  cg_exe = defaultCabalExe (pkgname ++ "-gen") "CodeGen.hs"
+              (deps ++ (words "ivory-backend-c") ++ [pkgname])
   cabalmods = [ filePathToPackage (artifactFileName m) | m <- sourceMods ]
   deps = words "ivory ivory-stdlib ivory-serialize"
 
@@ -58,10 +61,24 @@ makefile = artifactText "Makefile" $
     , text "\tcabal sandbox add-source $(IVORY_REPO)/ivory-artifact"
     , text "\tcabal sandbox add-source $(IVORY_REPO)/ivory-serialize"
     , text "\tcabal sandbox add-source $(IVORY_REPO)/ivory-stdlib"
+    , text "\tcabal sandbox add-source $(IVORY_REPO)/ivory-opts"
+    , text "\tcabal sandbox add-source $(IVORY_REPO)/ivory-backend-c"
     , text "\tcabal install --enable-tests --dependencies-only"
     , empty
     , text "test:"
-    , text "\tcabal test"
+    , text "\tcabal run -- --src-dir=codegen-out"
     , empty
     ]
 
+codegenTest :: [String] -> Artifact
+codegenTest modulepath = artifactText "CodeGen.hs" $
+  prettyLazyText 80 $ stack
+    [ text "module Main where"
+    , text "import Ivory.Compile.C.CmdlineFrontend"
+    , text "import Ivory.Serialize"
+    , text "import" <+> cat (punctuate dot (map text modulepath)) <> text ".Types"
+    , text "main :: IO ()"
+    , text "main = compile (serializeModule:typeModules) serializeArtifacts"
+    ]
+
+

src/Gidl/Backend/Ivory/Types.hs

@@ -124,14 +124,23 @@ userTypeStructName = first_lower . drop_t_suffix
   drop_t_suffix ('_':'t':[]) = []
   drop_t_suffix (a:as) = a : drop_t_suffix as
 
+ivoryPackageName :: Type -> String
+ivoryPackageName (StructType tname _) = userEnumValueName tname ++ "TypesModule"
+ivoryPackageName (PrimType (Newtype tname _)) = userEnumValueName tname ++ "TypesModule"
+ivoryPackageName (PrimType (EnumType tname _ _)) = userEnumValueName tname ++ "TypesModule"
+ivoryPackageName _ = error "can't take ivoryPackageName of builtin type"
+qualifiedIvoryPackageName :: Type -> String
+qualifiedIvoryPackageName t = typeModuleName t ++ "." ++ ivoryPackageName t
+
+
 typeDecl :: Type -> Doc
-typeDecl (StructType tname ss) = stack
+typeDecl t@(StructType tname ss) = stack
   [ text "[ivory|"
   , text "struct" <+> structname
   , indent 2 $ encloseStack lbrace rbrace semi
       [ text i <+> colon <> colon
-       <+> text "Stored" <+> text (typeImportedIvoryType (PrimType t))
-      | (i,t) <- ss ]
+       <+> text "Stored" <+> text (typeImportedIvoryType (PrimType st))
+      | (i,st) <- ss ]
   , text "|]"
   , empty
   , packRep <+> colon <> colon <+> text "WrappedPackRep" <+> storedType
@@ -143,14 +152,18 @@ typeDecl (StructType tname ss) = stack
   , text "instance Packable" <+> storedType <+> text "where"
   , indent 2 $ text "packRep" <+> equals <+> text "wrappedPackRep" <+> packRep
   , empty
-  , text (userEnumValueName tname) <> text "TypesModule :: Module"
-  , text (userEnumValueName tname) <> text "TypesModule" <+> equals
+  , text (ivoryPackageName t) <+> text ":: Module"
+  , text (ivoryPackageName t) <+> equals
     <+> text "package" <+> dquotes (structname <> text "_types") <+> text "$ do"
-  , indent 2 $ stack
+  , indent 2 $ stack $
       [ text "defStruct"
         <+> parens (text "Proxy :: Proxy" <+> dquotes structname)
       , text "depend serializeModule"
       , text "wrappedPackMod" <+> packRep
+      ] ++
+      [ text "depend" <+> text (qualifiedIvoryPackageName dt)
+      | dt <- fmap PrimType (typeLeaves t)
+      , isUserDefined dt
       ]
 
   ]
@@ -159,7 +172,7 @@ typeDecl (StructType tname ss) = stack
   structname = text (userTypeStructName tname)
   packRep = text "pack" <> text (userTypeModuleName tname)
 
-typeDecl (PrimType (Newtype tname n)) = stack
+typeDecl t@(PrimType (Newtype tname n)) = stack
   [ text "newtype" <+> text typename <+> equals
   , indent 2 $ text typename <+> align
       (lbrace <+> text ("un" ++ typename ) <+> text "::"
@@ -168,20 +181,24 @@ typeDecl (PrimType (Newtype tname n)) = stack
                        "IvoryEq IvoryStore IvoryInit IvoryZeroVal Num")))
   , empty
   , packRep <+> colon <> colon <+> text "WrappedPackRep" <+> storedType
-  , packRep <+> equals <+> text "wrapPackRep" <+> dquotes (text typename) <+> text "$"
+  , packRep <+> equals <+> text "wrapPackRep" <+> dquotes (text tname) <+> text "$"
   , indent 2 $ text "repackV" <+> text typename <+> text ("un" ++ typename) <+> text "packRep"
   , empty
   , text "instance Packable" <+> storedType <+> text "where"
   , indent 2 $ text "packRep" <+> equals <+> text "wrappedPackRep" <+> packRep
   , empty
-  , text (userEnumValueName tname) <> text "TypesModule :: Module"
-  , text (userEnumValueName tname) <> text "TypesModule" <+> equals
+  , text (ivoryPackageName t) <+> text ":: Module"
+  , text (ivoryPackageName t) <+> equals
     <+> text "package"
     <+> dquotes (text (userTypeStructName tname) <> text "_types")
     <+> text "$ do"
-  , indent 2 $ stack
+  , indent 2 $ stack $
       [ text "depend serializeModule"
       , text "wrappedPackMod" <+> packRep
+      ] ++
+      [ text "depend" <+> text (qualifiedIvoryPackageName dt)
+      | dt <- fmap PrimType (typeLeaves t)
+      , isUserDefined dt
       ]
   ]
   where
@@ -189,7 +206,7 @@ typeDecl (PrimType (Newtype tname n)) = stack
   storedType = parens (text "Stored" <+> text typename)
   packRep = text "pack" <> text typename
 
-typeDecl (PrimType (EnumType tname s es)) = stack
+typeDecl t@(PrimType (EnumType tname s es)) = stack
   [ text "newtype" <+> text typename <+> equals
   , indent 2 $ text typename <+> align
         (lbrace <+> text ("un" ++ typename) <+> text "::" <+>
@@ -206,14 +223,14 @@ typeDecl (PrimType (EnumType tname s es)) = stack
       | (i,e) <- es ]
   , empty
   , packRep <+> colon <> colon <+> text "WrappedPackRep" <+> storedType
-  , packRep <+> equals <+> text "wrapPackRep" <+> dquotes (text typename) <+> text "$"
-  , indent 2 $ text "repackV" <+> text typename  <+> text ("un" ++ typename) <+> text "packRep"
+  , packRep <+> equals <+> text "wrapPackRep" <+> dquotes (text tname) <+> text "$"
+  , indent 2 $ text "repackV" <+> text typename <+> text ("un" ++ typename) <+> text "packRep"
   , empty
   , text "instance Packable" <+> storedType <+> text "where"
   , indent 2 $ text "packRep" <+> equals <+> text "wrappedPackRep" <+> packRep
   , empty
-  , text (userEnumValueName tname) <> text "TypesModule :: Module"
-  , text (userEnumValueName tname) <> text "TypesModule" <+> equals
+  , text (ivoryPackageName t) <+> text ":: Module"
+  , text (ivoryPackageName t) <+> equals
     <+> text "package"
     <+> dquotes (text (userTypeStructName tname) <> text "_types")
     <+> text "$ do"