generate one haskell module

6 files changed, 100 insertions, 57 deletions

diff --git a/Definitions.hs b/Definitions.hs
index 743c233..d4b69be 100644
--- a/Definitions.hs
+++ b/Definitions.hs
@@ -428,3 +428,67 @@ ir = execWriter $ do
       , "streams"       #:: Array "StreamData"
       , "commands"      #:: Array "Command"
       ]
+
+mesh = execWriter $ do
+  data_ "MeshAttribute" $ do
+    const_ "A_Float"  [Array Float]
+    const_ "A_V2F"    [Array v2f]
+    const_ "A_V3F"    [Array v3f]
+    const_ "A_V4F"    [Array v4f]
+    const_ "A_M22F"   [Array m22]
+    const_ "A_M33F"   [Array m33]
+    const_ "A_M44F"   [Array m44]
+    const_ "A_Int"    [Array Int32]
+    const_ "A_Word"   [Array Word32]
+
+  data_ "MeshPrimitive" $ do
+    enum_  "P_Points"
+    enum_  "P_TriangleStrip"
+    enum_  "P_Triangles"
+    const_ "P_TriangleStripI" [Array Int32]
+    const_ "P_TrianglesI"     [Array Int32]
+
+  data_ "Mesh" $ do
+    constR_ "Mesh"
+      [ "mAttributes" #:: Map String "MeshAttribute"
+      , "mPrimitive"  #:: "MeshPrimitive"
+      ]
+
+typeInfo = execWriter $ do
+  data_ "TypeInfo" $ do
+    constR_ "TypeInfo"
+      [ "startLine"   #:: Int
+      , "startColumn" #:: Int
+      , "endLine"     #:: Int
+      , "endColumn"   #:: Int
+      , "text"        #:: String
+      ]
+
+  data_ "MyEither" $ do
+    const_ "MyLeft"   ["TypeInfo", Array "TypeInfo"]
+    const_ "MyRight"  ["TypeInfo"{- "Pipeline" -}, Array "TypeInfo"]
+      
+{-
+type TypeInfoRecord =
+  { startLine   :: Int
+  , startColumn :: Int
+  , endLine     :: Int
+  , endColumn   :: Int
+  , text        :: String
+  }
+data TypeInfo = TypeInfo TypeInfoRecord
+
+instance decodeJsonTypeInfo :: DecodeJson TypeInfo where
+  decodeJson json = do
+    obj <- decodeJson json
+    startL <- obj .? "startL"
+    startC <- obj .? "startC"
+    endL <- obj .? "endL"
+    endC <- obj .? "endC"
+    text <- obj .? "text"
+    return $ TypeInfo {startLine:startL, startColumn:startC, endLine:endL, endColumn:endC, text:text}
+
+data MyEither
+  = MyLeft TypeInfo (Array TypeInfo)
+  | MyRight Pipeline (Array TypeInfo)
+-}
\ No newline at end of file
diff --git a/Generate.hs b/Generate.hs
index 71302cc..8bc725f 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -22,8 +22,6 @@ instance Unquote Type
 main :: IO ()
 main = do
   irHs <- eitherParseFile "templates/data.hs.ede"
-  irEncodeHs <- eitherParseFile "templates/encode.hs.ede"
-  irDecodeHs <- eitherParseFile "templates/decode.hs.ede"
   irPs <- eitherParseFile "templates/data.purs.ede"
   let generate name def = do
         dt <- getCurrentTime
@@ -46,8 +44,8 @@ main = do
 
         -- Haskell
         either error (\x -> writeFile ("out/" ++ name ++ ".hs") $ LText.unpack x) $ irHs >>= (\t -> eitherRenderWith mylib t env)
-        either error (\x -> writeFile ("out/" ++ name ++ "Encode.hs") $ LText.unpack x) $ irEncodeHs >>= (\t -> eitherRenderWith mylib t env)
-        either error (\x -> writeFile ("out/" ++ name ++ "Decode.hs") $ LText.unpack x) $ irDecodeHs >>= (\t -> eitherRenderWith mylib t env)
         -- Purescript
         either error (\x -> writeFile ("out/" ++ name ++ ".purs") $ LText.unpack x) $ irPs >>= (\t -> eitherRenderWith mylib t env)
   generate "IR" ir
+  generate "Mesh" mesh
+  generate "TypeInfo" typeInfo
diff --git a/Language.hs b/Language.hs
index d4cd1b6..15780f6 100644
--- a/Language.hs
+++ b/Language.hs
@@ -152,7 +152,7 @@ hsType aliasMap = \case
   V4 (V3 Float) -> "M34F"
   V4 (V4 Float) -> "M44F"
 
-  Array t       -> "[" ++ hsType aliasMap t ++ "]"
+  Array t       -> "Vector " ++ parens (hsType aliasMap t)
   List t        -> "[" ++ hsType aliasMap t ++ "]"
   Maybe t       -> "Maybe " ++ parens (hsType aliasMap t)
   Map k v       -> "Map " ++ parens (hsType aliasMap k) ++ " " ++ parens (hsType aliasMap v)
diff --git a/templates/data.hs.ede b/templates/data.hs.ede
index b2ad9de..fccd7dc 100644
--- a/templates/data.hs.ede
+++ b/templates/data.hs.ede
@@ -1,13 +1,20 @@
 -- generated file, do not modify!
 -- {{ dateTime }}
 
+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 module {{ moduleName }} where
 
 import Data.Int
 import Data.Word
 import Data.Map
+import Data.Vector (Vector(..))
 import Linear
 
+import Data.Text
+import Data.Aeson hiding (Value,Bool)
+import Data.Aeson.Types hiding (Value,Bool)
+import Control.Monad
+
 {% for t in dataAndType %}
 {% case t.value | constType %}
 {% when "DataDef" %}
@@ -25,3 +32,29 @@ type {{ t.value.aliasName }} = {{ t.value.aliasType | hsType }}
 {% endcase %}
 
 {% endfor %}
+
+(.-) :: Text -> Text -> Pair
+a .- b = a .= b
+
+{% for t in definitions %}
+instance ToJSON {{ t.value.dataName }} where
+  toJSON v = case v of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
+    {{ c.value.name }}{..} -> object
+      [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}
+      , "{{ f.value.fieldName }}" .= {{ f.value.fieldName }}{% endfor %}
+      ]{% else %}
+    {{ c.value.name }}{% for f in c.value.fields %} arg{{ f.index0 }}{% endfor %} -> object [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}, "arg{{ f.index0 }}" .= arg{{ f.index0 }}{% endfor %}]{% endif %}{% endfor %}
+
+instance FromJSON {{ t.value.dataName }} where
+  parseJSON (Object obj) = do
+    tag <- obj .: "tag"
+    case tag :: Text of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
+      "{{ c.value.name }}" -> do{% for f in c.value.fields %}
+        {{ f.value.fieldName }} <- obj .: "{{ f.value.fieldName }}"{% endfor %}
+        pure $ {{ c.value.name }}{% for f in c.value.fields %}
+          {% if f.first %}{ {% else %}, {%endif%}{{ f.value.fieldName }} = {{ f.value.fieldName }}{% endfor %}
+          } {% else %}
+      "{{ c.value.name }}" -> {% for f in c.value.fields %}{% if f.first %}{{ c.value.name }} <$>{% else %} <*>{% endif %} obj .: "arg{{ f.index0 }}"{%else%}pure {{ c.value.name }}{% endfor %}{% endif %}{% endfor %}
+  parseJSON _ = mzero
+
+{% endfor %}
\ No newline at end of file
diff --git a/templates/decode.hs.ede b/templates/decode.hs.ede
deleted file mode 100644
index 743bb39..0000000
--- a/templates/decode.hs.ede
+++ /dev/null
@@ -1,26 +0,0 @@
--- generated file, do not modify!
--- {{ dateTime }}
-
-{-# LANGUAGE OverloadedStrings #-}
-module {{ moduleName }}Decode where
-
-import Data.Text
-import Data.Aeson hiding (Value,Bool)
-import Control.Monad
-import Linear
-import {{ moduleName }}
-
-{% for t in definitions %}
-instance FromJSON {{ t.value.dataName }} where
-  parseJSON (Object obj) = do
-    tag <- obj .: "tag"
-    case tag :: Text of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
-      "{{ c.value.name }}" -> do{% for f in c.value.fields %}
-        {{ f.value.fieldName }} <- obj .: "{{ f.value.fieldName }}"{% endfor %}
-        pure $ {{ c.value.name }}{% for f in c.value.fields %}
-          {% if f.first %}{ {% else %}, {%endif%}{{ f.value.fieldName }} = {{ f.value.fieldName }}{% endfor %}
-          } {% else %}
-      "{{ c.value.name }}" -> {% for f in c.value.fields %}{% if f.first %}{{ c.value.name }} <$>{% else %} <*>{% endif %} obj .: "arg{{ f.index0 }}"{%else%}pure {{ c.value.name }}{% endfor %}{% endif %}{% endfor %}
-  parseJSON _ = mzero
-
-{% endfor %}
\ No newline at end of file
diff --git a/templates/encode.hs.ede b/templates/encode.hs.ede
deleted file mode 100644
index f305eb1..0000000
--- a/templates/encode.hs.ede
+++ /dev/null
@@ -1,26 +0,0 @@
--- generated file, do not modify!
--- {{ dateTime }}
-
-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
-module {{ moduleName }}Encode where
-
-import Data.Text
-import Data.Aeson hiding (Value,Bool)
-import Data.Aeson.Types hiding (Value,Bool)
-import Linear
-
-import {{ moduleName }}
-
-(.-) :: Text -> Text -> Pair
-a .- b = a .= b
-
-{% for t in definitions %}
-instance ToJSON {{ t.value.dataName }} where
-  toJSON v = case v of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
-    {{ c.value.name }}{..} -> object
-      [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}
-      , "{{ f.value.fieldName }}" .= {{ f.value.fieldName }}{% endfor %}
-      ]{% else %}
-    {{ c.value.name }}{% for f in c.value.fields %} arg{{ f.index0 }}{% endfor %} -> object [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}, "arg{{ f.index0 }}" .= arg{{ f.index0 }}{% endfor %}]{% endif %}{% endfor %}
-
-{% endfor %}
\ No newline at end of file