Quellcode durchsuchen

tower backend: rename Interface to Server, generate an umbrella module

Pat Hickey vor 9 Jahren
Ursprung
Commit
77144739e8
3 geänderte Dateien mit 32 neuen und 10 gelöschten Zeilen
  1. 1 1
      gidl.cabal
  2. 3 2
      src/Gidl/Backend/Tower.hs
  3. 28 7
      src/Gidl/Backend/Tower/Interface.hs

+ 1 - 1
gidl.cabal

@@ -36,7 +36,7 @@ library
                        Gidl.Backend.Ivory.Types,
                        Gidl.Backend.Tower,
                        Gidl.Backend.Tower.Schema,
-                       Gidl.Backend.Tower.Interface
+                       Gidl.Backend.Tower.Server
 
   other-modules:       Paths_gidl
 

+ 3 - 2
src/Gidl/Backend/Tower.hs

@@ -14,7 +14,7 @@ import Gidl.Backend.Cabal
 import Gidl.Backend.Ivory (dotwords, ivorySources)
 import Gidl.Backend.Ivory.Schema (ifModuleName)
 import Gidl.Backend.Tower.Schema
-import Gidl.Backend.Tower.Interface
+import Gidl.Backend.Tower.Server
 
 towerBackend :: TypeEnv -> InterfaceEnv -> String -> String -> [Artifact]
 towerBackend te ie pkgname namespace_raw =
@@ -45,7 +45,8 @@ towerSources (InterfaceEnv ie) namespace = towerInterfaces
   towerInterfaces = concat
     [ [ schemaModule    ifnamespace i (producerSchema i)
       , schemaModule    ifnamespace i (consumerSchema i)
-      , interfaceModule ifnamespace i
+      , serverModule    ifnamespace i
+      , umbrellaModule  ifnamespace i
       ]
     | (_iname, i) <- ie ]
   ifnamespace = namespace ++ ["Interface"]

+ 28 - 7
src/Gidl/Backend/Tower/Interface.hs

@@ -1,5 +1,5 @@
 
-module Gidl.Backend.Tower.Interface where
+module Gidl.Backend.Tower.Server where
 
 
 import Data.Monoid
@@ -12,11 +12,32 @@ import Gidl.Backend.Ivory.Schema (ifModuleName)
 import Ivory.Artifact
 import Text.PrettyPrint.Mainland
 
-interfaceModule :: [String] -> Interface -> Artifact
-interfaceModule modulepath i =
+umbrellaModule :: [String] -> Interface -> Artifact
+umbrellaModule modulepath i =
   artifactPath (intercalate "/" modulepath) $
   artifactText (ifModuleName i ++ ".hs") $
   prettyLazyText 80 $
+  stack
+    [ text "module" <+> mname
+    , indent 2 $ encloseStack lparen (rparen <+> text "where") comma
+        [ text "module" <+> im "Producer"
+        , text "module" <+> im "Consumer"
+        , text "module" <+> im "Server"
+        ]
+    , text "import" <+> im "Producer"
+    , text "import" <+> im "Consumer"
+    , text "import" <+> im "Server"
+    ]
+  where
+  modAt path = mconcat (punctuate dot (map text path))
+  mname = modAt (modulepath ++ [ifModuleName i])
+  im m = modAt (modulepath ++ [ifModuleName i, m])
+
+serverModule :: [String] -> Interface -> Artifact
+serverModule modulepath i =
+  artifactPath (intercalate "/" (modulepath ++ [ifModuleName i])) $
+  artifactText "Server.hs" $
+  prettyLazyText 80 $
   stack
     [ text "{-# LANGUAGE DataKinds #-}"
     , text "{-# LANGUAGE RankNTypes #-}"
@@ -27,7 +48,7 @@ interfaceModule modulepath i =
     , text "{-# OPTIONS_GHC -fno-warn-unused-matches #-}"
     , empty
     , text "module"
-      <+> im (ifModuleName i)
+      <+> im "Server"
       <+> text "where"
     , empty
     , stack imports
@@ -47,12 +68,12 @@ interfaceModule modulepath i =
   where
   rootpath = reverse . drop 2 . reverse
   modAt path = mconcat (punctuate dot (map text path))
-  im mname = modAt (modulepath ++ [mname])
+  im mname = modAt (modulepath ++ [ifModuleName i, mname])
 
   imports =
     [ text "import" <+> modAt (rootpath modulepath ++ ["Tower", "Attr"])
-    , text "import" <+> im (ifModuleName i) <> dot <> text "Producer"
-    , text "import" <+> im (ifModuleName i) <> dot <> text "Consumer"
+    , text "import" <+> im "Producer"
+    , text "import" <+> im "Consumer"
     , text "import Ivory.Language"
     , text "import Ivory.Tower"
     ]