From 32daa3c315949f63b39a69a5a663dd214c640e90 Mon Sep 17 00:00:00 2001 From: Csaba Hruska Date: Fri, 11 Sep 2015 00:34:20 +0200 Subject: generate one haskell module --- Definitions.hs | 64 +++++++++++++++++++++++++++++++++++++++++++++++++ Generate.hs | 6 ++--- Language.hs | 2 +- templates/data.hs.ede | 33 +++++++++++++++++++++++++ templates/decode.hs.ede | 26 -------------------- templates/encode.hs.ede | 26 -------------------- 6 files changed, 100 insertions(+), 57 deletions(-) delete mode 100644 templates/decode.hs.ede delete mode 100644 templates/encode.hs.ede 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 -- cgit v1.2.3