From f673ca48a9f14bdf7e64d7e992ce063911581424 Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 21 Jul 2024 22:45:31 +0200
Subject: [PATCH] Add record and variant AST types

---
 TODO                     |  3 +--
 src/Language/Elna/AST.hs | 24 +++++++++++++++++++++---
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/TODO b/TODO
index b563094..1dc182b 100644
--- a/TODO
+++ b/TODO
@@ -1,5 +1,4 @@
 # AST missing
 
 - Import
-- Record
-- Union
+- Record and Union initialization
diff --git a/src/Language/Elna/AST.hs b/src/Language/Elna/AST.hs
index 30c6627..45e85a7 100644
--- a/src/Language/Elna/AST.hs
+++ b/src/Language/Elna/AST.hs
@@ -12,6 +12,8 @@ module Language.Elna.AST
 
 import Data.Int (Int32)
 import Data.List (intercalate)
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Word (Word8)
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -174,13 +176,29 @@ instance Show VariableDeclaration
         <> maybe "" ((" = " <>) . show) initialValue <> ";"
         <> showAttributes exports
 
-data Program = Program [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
+data TypeDefinition
+    = RecordDefinition Identifier (NonEmpty Parameter)
+    | VariantDefinition Identifier (NonEmpty Parameter)
+    deriving Eq
+
+instance Show TypeDefinition
+  where
+    show (RecordDefinition identifier fields) = show identifier
+        <> " = record " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
+        <> " end;"
+    show (VariantDefinition identifier fields) = show identifier
+        <> " = variant " <> intercalate "; " (NonEmpty.toList $ show <$> fields)
+        <> " end;"
+
+data Program =
+    Program [TypeDefinition] [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
     deriving Eq
 
 instance Show Program
   where
-    show (Program constants globals procedures body)
-        = showConstants constants <> showVariables globals
+    show (Program types constants globals procedures body)
+        = unlines (show <$> types)
+        <> showConstants constants <> showVariables globals
         <> unlines (show <$> procedures) <> show body <> "."
 
 showAttributes :: Bool -> String