summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCsaba Hruska <csaba.hruska@gmail.com>2015-09-11 00:34:20 +0200
committerCsaba Hruska <csaba.hruska@gmail.com>2015-09-11 00:34:20 +0200
commit32daa3c315949f63b39a69a5a663dd214c640e90 (patch)
treeea7bdb508023a4af59de921f9767eafd852d08a3
parent93f747e7836cb3d15976a8608a453e3396c0d428 (diff)
generate one haskell module
-rw-r--r--Definitions.hs64
-rw-r--r--Generate.hs6
-rw-r--r--Language.hs2
-rw-r--r--templates/data.hs.ede33
-rw-r--r--templates/decode.hs.ede26
-rw-r--r--templates/encode.hs.ede26
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
428 , "streams" #:: Array "StreamData" 428 , "streams" #:: Array "StreamData"
429 , "commands" #:: Array "Command" 429 , "commands" #:: Array "Command"
430 ] 430 ]
431
432mesh = execWriter $ do
433 data_ "MeshAttribute" $ do
434 const_ "A_Float" [Array Float]
435 const_ "A_V2F" [Array v2f]
436 const_ "A_V3F" [Array v3f]
437 const_ "A_V4F" [Array v4f]
438 const_ "A_M22F" [Array m22]
439 const_ "A_M33F" [Array m33]
440 const_ "A_M44F" [Array m44]
441 const_ "A_Int" [Array Int32]
442 const_ "A_Word" [Array Word32]
443
444 data_ "MeshPrimitive" $ do
445 enum_ "P_Points"
446 enum_ "P_TriangleStrip"
447 enum_ "P_Triangles"
448 const_ "P_TriangleStripI" [Array Int32]
449 const_ "P_TrianglesI" [Array Int32]
450
451 data_ "Mesh" $ do
452 constR_ "Mesh"
453 [ "mAttributes" #:: Map String "MeshAttribute"
454 , "mPrimitive" #:: "MeshPrimitive"
455 ]
456
457typeInfo = execWriter $ do
458 data_ "TypeInfo" $ do
459 constR_ "TypeInfo"
460 [ "startLine" #:: Int
461 , "startColumn" #:: Int
462 , "endLine" #:: Int
463 , "endColumn" #:: Int
464 , "text" #:: String
465 ]
466
467 data_ "MyEither" $ do
468 const_ "MyLeft" ["TypeInfo", Array "TypeInfo"]
469 const_ "MyRight" ["TypeInfo"{- "Pipeline" -}, Array "TypeInfo"]
470
471{-
472type TypeInfoRecord =
473 { startLine :: Int
474 , startColumn :: Int
475 , endLine :: Int
476 , endColumn :: Int
477 , text :: String
478 }
479data TypeInfo = TypeInfo TypeInfoRecord
480
481instance decodeJsonTypeInfo :: DecodeJson TypeInfo where
482 decodeJson json = do
483 obj <- decodeJson json
484 startL <- obj .? "startL"
485 startC <- obj .? "startC"
486 endL <- obj .? "endL"
487 endC <- obj .? "endC"
488 text <- obj .? "text"
489 return $ TypeInfo {startLine:startL, startColumn:startC, endLine:endL, endColumn:endC, text:text}
490
491data MyEither
492 = MyLeft TypeInfo (Array TypeInfo)
493 | MyRight Pipeline (Array TypeInfo)
494-} \ 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
22main :: IO () 22main :: IO ()
23main = do 23main = do
24 irHs <- eitherParseFile "templates/data.hs.ede" 24 irHs <- eitherParseFile "templates/data.hs.ede"
25 irEncodeHs <- eitherParseFile "templates/encode.hs.ede"
26 irDecodeHs <- eitherParseFile "templates/decode.hs.ede"
27 irPs <- eitherParseFile "templates/data.purs.ede" 25 irPs <- eitherParseFile "templates/data.purs.ede"
28 let generate name def = do 26 let generate name def = do
29 dt <- getCurrentTime 27 dt <- getCurrentTime
@@ -46,8 +44,8 @@ main = do
46 44
47 -- Haskell 45 -- Haskell
48 either error (\x -> writeFile ("out/" ++ name ++ ".hs") $ LText.unpack x) $ irHs >>= (\t -> eitherRenderWith mylib t env) 46 either error (\x -> writeFile ("out/" ++ name ++ ".hs") $ LText.unpack x) $ irHs >>= (\t -> eitherRenderWith mylib t env)
49 either error (\x -> writeFile ("out/" ++ name ++ "Encode.hs") $ LText.unpack x) $ irEncodeHs >>= (\t -> eitherRenderWith mylib t env)
50 either error (\x -> writeFile ("out/" ++ name ++ "Decode.hs") $ LText.unpack x) $ irDecodeHs >>= (\t -> eitherRenderWith mylib t env)
51 -- Purescript 47 -- Purescript
52 either error (\x -> writeFile ("out/" ++ name ++ ".purs") $ LText.unpack x) $ irPs >>= (\t -> eitherRenderWith mylib t env) 48 either error (\x -> writeFile ("out/" ++ name ++ ".purs") $ LText.unpack x) $ irPs >>= (\t -> eitherRenderWith mylib t env)
53 generate "IR" ir 49 generate "IR" ir
50 generate "Mesh" mesh
51 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
152 V4 (V3 Float) -> "M34F" 152 V4 (V3 Float) -> "M34F"
153 V4 (V4 Float) -> "M44F" 153 V4 (V4 Float) -> "M44F"
154 154
155 Array t -> "[" ++ hsType aliasMap t ++ "]" 155 Array t -> "Vector " ++ parens (hsType aliasMap t)
156 List t -> "[" ++ hsType aliasMap t ++ "]" 156 List t -> "[" ++ hsType aliasMap t ++ "]"
157 Maybe t -> "Maybe " ++ parens (hsType aliasMap t) 157 Maybe t -> "Maybe " ++ parens (hsType aliasMap t)
158 Map k v -> "Map " ++ parens (hsType aliasMap k) ++ " " ++ parens (hsType aliasMap v) 158 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 @@
1-- generated file, do not modify! 1-- generated file, do not modify!
2-- {{ dateTime }} 2-- {{ dateTime }}
3 3
4{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
4module {{ moduleName }} where 5module {{ moduleName }} where
5 6
6import Data.Int 7import Data.Int
7import Data.Word 8import Data.Word
8import Data.Map 9import Data.Map
10import Data.Vector (Vector(..))
9import Linear 11import Linear
10 12
13import Data.Text
14import Data.Aeson hiding (Value,Bool)
15import Data.Aeson.Types hiding (Value,Bool)
16import Control.Monad
17
11{% for t in dataAndType %} 18{% for t in dataAndType %}
12{% case t.value | constType %} 19{% case t.value | constType %}
13{% when "DataDef" %} 20{% when "DataDef" %}
@@ -25,3 +32,29 @@ type {{ t.value.aliasName }} = {{ t.value.aliasType | hsType }}
25{% endcase %} 32{% endcase %}
26 33
27{% endfor %} 34{% endfor %}
35
36(.-) :: Text -> Text -> Pair
37a .- b = a .= b
38
39{% for t in definitions %}
40instance ToJSON {{ t.value.dataName }} where
41 toJSON v = case v of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
42 {{ c.value.name }}{..} -> object
43 [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}
44 , "{{ f.value.fieldName }}" .= {{ f.value.fieldName }}{% endfor %}
45 ]{% else %}
46 {{ 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 %}
47
48instance FromJSON {{ t.value.dataName }} where
49 parseJSON (Object obj) = do
50 tag <- obj .: "tag"
51 case tag :: Text of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
52 "{{ c.value.name }}" -> do{% for f in c.value.fields %}
53 {{ f.value.fieldName }} <- obj .: "{{ f.value.fieldName }}"{% endfor %}
54 pure $ {{ c.value.name }}{% for f in c.value.fields %}
55 {% if f.first %}{ {% else %}, {%endif%}{{ f.value.fieldName }} = {{ f.value.fieldName }}{% endfor %}
56 } {% else %}
57 "{{ 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 %}
58 parseJSON _ = mzero
59
60{% 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 @@
1-- generated file, do not modify!
2-- {{ dateTime }}
3
4{-# LANGUAGE OverloadedStrings #-}
5module {{ moduleName }}Decode where
6
7import Data.Text
8import Data.Aeson hiding (Value,Bool)
9import Control.Monad
10import Linear
11import {{ moduleName }}
12
13{% for t in definitions %}
14instance FromJSON {{ t.value.dataName }} where
15 parseJSON (Object obj) = do
16 tag <- obj .: "tag"
17 case tag :: Text of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
18 "{{ c.value.name }}" -> do{% for f in c.value.fields %}
19 {{ f.value.fieldName }} <- obj .: "{{ f.value.fieldName }}"{% endfor %}
20 pure $ {{ c.value.name }}{% for f in c.value.fields %}
21 {% if f.first %}{ {% else %}, {%endif%}{{ f.value.fieldName }} = {{ f.value.fieldName }}{% endfor %}
22 } {% else %}
23 "{{ 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 %}
24 parseJSON _ = mzero
25
26{% 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 @@
1-- generated file, do not modify!
2-- {{ dateTime }}
3
4{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
5module {{ moduleName }}Encode where
6
7import Data.Text
8import Data.Aeson hiding (Value,Bool)
9import Data.Aeson.Types hiding (Value,Bool)
10import Linear
11
12import {{ moduleName }}
13
14(.-) :: Text -> Text -> Pair
15a .- b = a .= b
16
17{% for t in definitions %}
18instance ToJSON {{ t.value.dataName }} where
19 toJSON v = case v of{% for c in t.value.constructors %}{% if c.value.fields | hasFieldNames %}
20 {{ c.value.name }}{..} -> object
21 [ "tag" .- "{{ c.value.name }}"{% for f in c.value.fields %}
22 , "{{ f.value.fieldName }}" .= {{ f.value.fieldName }}{% endfor %}
23 ]{% else %}
24 {{ 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 %}
25
26{% endfor %} \ No newline at end of file