gidl: empty implementation for haskell interface backend

gidl.cabal

@@ -19,6 +19,7 @@ library
                        Gidl.Types.Base,
                        Gidl.Backend.Cabal,
                        Gidl.Backend.Haskell,
+                       Gidl.Backend.Haskell.Interface,
                        Gidl.Backend.Haskell.Types
 
   build-depends:       base >=4.7 && <4.8,

src/Gidl/Backend/Haskell.hs

@@ -5,6 +5,7 @@ import Gidl.Parse
 import Gidl.Interface
 import Gidl.Backend.Cabal
 import Gidl.Backend.Haskell.Types
+import Gidl.Backend.Haskell.Interface
 
 import Ivory.Artifact
 
@@ -13,16 +14,19 @@ import System.Exit (exitFailure, exitSuccess)
 
 haskellBackend :: TypeEnv -> InterfaceEnv -> String -> [String] -> [Artifact]
 haskellBackend te@(TypeEnv te') ie@(InterfaceEnv ie') pkgname namespace =
-  cabalFileArtifact cf : (map (artifactPath "src") tmods)
+  cabalFileArtifact cf : (map (artifactPath "src") (tmods ++ imods))
   where
   tmods = [ typeModule (namespace ++ ["Types"]) tr
           | (tn, _t) <- te'
           , let tr = typeDescrToRepr tn te
           , isUserDefined tr
           ]
-
+  imods = [ interfaceModule (namespace ++ ["Interface"]) ir
+          | (iname, _i) <- ie'
+          , let ir = interfaceDescrToRepr iname ie te
+          ]
   cf = defaultCabalFile pkgname mods deps
-  mods = [ filePathToPackage (artifactFileName m) | m <- tmods]
+  mods = [ filePathToPackage (artifactFileName m) | m <- (tmods ++ imods)]
   deps = []
 
 

src/Gidl/Backend/Haskell/Interface.hs

@@ -0,0 +1,41 @@
+
+module Gidl.Backend.Haskell.Interface where
+
+
+import Data.Monoid
+import Data.List (intercalate, nub)
+import Data.Char (toUpper)
+
+import Gidl.Types
+import Gidl.Interface
+import Ivory.Artifact
+import Text.PrettyPrint.Mainland
+
+interfaceModule :: [String] -> InterfaceRepr -> Artifact
+interfaceModule modulepath ir =
+  artifactPath (intercalate "/" modulepath) $
+  artifactText ((ifModuleName ir) ++ ".hs") $
+  prettyLazyText 80 $
+  stack
+    [ text "module"
+      <+> tm (ifModuleName ir)
+      <+> text "where"
+    , empty
+    ]
+  where
+  tm mname = mconcat $ punctuate dot
+                     $ map text (modulepath ++ [mname])
+
+
+ifModuleName :: InterfaceRepr -> String
+ifModuleName (InterfaceRepr iname _) = aux iname
+  where
+  aux :: String -> String
+  aux = first_cap . u_to_camel
+  first_cap (s:ss) = (toUpper s) : ss
+  first_cap []     = []
+  u_to_camel ('_':'i':[]) = []
+  u_to_camel ('_':[]) = []
+  u_to_camel ('_':a:as) = (toUpper a) : u_to_camel as
+  u_to_camel (a:as) = a : u_to_camel as
+  u_to_camel [] = []

src/Gidl/Backend/Haskell/Types.hs

@@ -9,6 +9,7 @@ import Ivory.Artifact
 import Text.PrettyPrint.Mainland
 
 -- invariant: only make a typeModule from a StructType, NewtypeType, or EnumType
+-- i.e. when isUserDefined is true.
 typeModule :: [String] -> TypeRepr -> Artifact
 typeModule modulepath tr@(TypeRepr _ td) =
   artifactPath (intercalate "/" modulepath) $

src/Gidl/Interface.hs

@@ -2,7 +2,7 @@
 module Gidl.Interface
   ( module Gidl.Interface.AST
   , InterfaceDescr
-  , InterfaceRepr
+  , InterfaceRepr(..)
   , interfaceDescrToRepr
   , lookupInterface
   , insertInterface