Parcourir la source

add missing file

Pat Hickey il y a 9 ans
Parent
commit
e46555f51d
1 fichiers modifiés avec 54 ajouts et 0 suppressions
  1. 54 0
      src/Gidl/Backend/Tower/Interface.hs

+ 54 - 0
src/Gidl/Backend/Tower/Interface.hs

@@ -0,0 +1,54 @@
+
+module Gidl.Backend.Tower.Interface where
+
+
+import Data.Monoid
+import Data.List (intercalate, nub)
+
+import Gidl.Types
+import Gidl.Interface
+import Gidl.Schema
+import Gidl.Backend.Ivory.Types
+import Gidl.Backend.Ivory.Schema (ifModuleName)
+import Ivory.Artifact
+import Text.PrettyPrint.Mainland
+
+interfaceModule :: [String] -> Interface -> Artifact
+interfaceModule modulepath ir =
+  artifactPath (intercalate "/" modulepath) $
+  artifactText (ifModuleName ir ++ ".hs") $
+  prettyLazyText 80 $
+  stack
+    [ text "{-# LANGUAGE DataKinds #-}"
+    , text "{-# LANGUAGE RankNTypes #-}"
+    , text "{-# LANGUAGE ScopedTypeVariables #-}"
+    , text "{-# OPTIONS_GHC -fno-warn-unused-imports #-}"
+    , empty
+    , text "module"
+      <+> im (ifModuleName ir)
+      <+> text "where"
+    , empty
+    , stack $ typeimports ++ extraimports
+    , empty
+    ]
+  where
+  rootpath = reverse . drop 2 . reverse
+  modAt path = mconcat (punctuate dot (map text path))
+  im mname = modAt (modulepath ++ [mname])
+  tm mname = modAt (rootpath modulepath ++ ["Ivory","Types", mname])
+
+  typeimports = map (importDecl tm)
+              $ nub
+              $ map importType
+              $ interfaceTypes ir
+
+  extraimports =
+    [ text "import" <+> modAt (rootpath modulepath ++ ["Ivory", "Types"])
+    , text "import" <+> im (ifModuleName ir) <> dot <> text "Producer"
+    , text "import" <+> im (ifModuleName ir) <> dot <> text "Consumer"
+    , text "import Ivory.Language"
+    , text "import Ivory.Stdlib"
+    , text "import Ivory.Tower"
+    , text "import Ivory.Serialize"
+    ]
+