added Data Type Enum Support

lib/namma-dsl/src/NammaDSL/DSL/Parser/TechDesign.hs

@@ -14,11 +14,11 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.RWS.Lazy
 import Data.Aeson
 import Data.Aeson.Key
+import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KM
 import Data.Aeson.Lens (_Array, _Value)
 import Data.Bool
 import qualified Data.ByteString as BS
---import Debug.Trace (traceShowId)
 import Data.Char (isUpper)
 import Data.Default
 import qualified Data.List as L
@@ -61,18 +61,27 @@ parseChangeEntity (dName, changeObj) = do
   let !qDName = maybe (if '.' `T.elem` dName then dName else errorT ("Module not found for " <> dName)) (\m -> m <> "." <> dName) (lookup dName mdlmap)
       (md, accDName) = getMdAndDname qDName
       allCommentChanges = changeObj ^. ix acc_tdComments . _Array . to V.toList . to (mkComments accDName)
-      allNewTypeChange = case L.find ((\f -> f == "declType") . fst) (mkList $ Object changeObj :: [(Text, Text)]) of
-        Just (_, t) -> [AddRecord (getRequiredDeclType t) accDName]
+      allNewTypeChange = case L.find ((== "declType") . fst) (mkList $ Object changeObj :: [(Text, Text)]) of
+        Just (_, t) -> [AddRecord (getRequiredDeclType t) accDName Nothing]
+        _ -> []
+      allDataChanges = case L.find ((== "declType") . fst) (mkList $ Object changeObj :: [(Text, Text)]) of
+        Just (_, t) -> [AddRecord (getRequiredDeclType t) accDName (extractTextValue "enum" changeObj)]
         _ -> []
       allFieldChanges = (mkList $ Object changeObj) & filter (\(f, _) -> f /= "declType") & map \(f, v) -> AddField accDName f v
       extraChange = concatMap extraChanges allFieldChanges
   potentialFilePaths <- mapM (\pfx -> getModuleFilePath pfx (T.unpack md)) tdPathPrefixes
   let correctFilePath = fromMaybe (errorT $ "No File path found for module: " <> md) $ (listToMaybe . catMaybes) potentialFilePaths
-  let annotatedChanges = map (mkAnnotated md correctFilePath) (allNewTypeChange ++ allCommentChanges ++ allFieldChanges ++ extraChange)
+  let annotatedChanges = map (mkAnnotated md correctFilePath) (allDataChanges ++ allNewTypeChange ++ allCommentChanges ++ allFieldChanges ++ extraChange)
   modify $ \s -> s {changes = changes s ++ annotatedChanges}
+  where
+    extractTextValue :: Text -> Object -> Maybe Text
+    extractTextValue key obj = case KM.lookup (Key.fromText key) obj of
+      Just (String s) -> Just s
+      _ -> Nothing
 
 getRequiredDeclType :: Text -> PRecordType
 getRequiredDeclType = \case
+  "data" -> PDATA
   "newtype" -> PNEWTYPE
   "type" -> PTYPE
   _ -> errorT "Invalid DeclType"

lib/namma-dsl/src/NammaDSL/DSL/Syntax/TechDesign.hs

@@ -20,15 +20,15 @@ type EC = [Comment Void]
 
 type DeclSig = Text
 
-data PRecordType = PTYPE | PNEWTYPE deriving (Show, Eq, Ord)
+data PRecordType = PNEWTYPE | PTYPE | PDATA deriving (Show, Eq, Ord)
 
 type RecordName = Text
 
 data PImportType = Simple | Qualified deriving (Show, Eq, Ord)
 
 data PImport = PImport Text PImportType deriving (Show, Eq, Ord)
 
-data Change = AddRecord PRecordType RecordName | AddField DeclSig Text Text | AddImport PImport | AddComment DeclSig Text deriving (Show, Eq, Ord)
+data Change = AddRecord PRecordType RecordName (Maybe Text) | AddField DeclSig Text Text | AddImport PImport | AddComment DeclSig Text deriving (Show, Eq, Ord)
 
 data TechDRead = TechDRead
   { tdPathPrefixes :: [FilePath],

lib/namma-dsl/src/NammaDSL/Generator/Purs/CST.hs

@@ -1,12 +1,15 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module NammaDSL.Generator.Purs.CST (module NammaDSL.Generator.Purs.CST, module ReExport) where
 
 import Control.Arrow ((&&&))
 --import Debug.Trace (traceShowId)
 import Data.Bool (bool)
-import Data.Char (isDigit)
+import Data.Char (isDigit, isSpace)
 import Data.Default
 import qualified Data.List as L
 import Data.Maybe
@@ -475,17 +478,40 @@ pDataHead recType recName =
               ( case recType of
                   PNEWTYPE -> "newtype"
                   PTYPE -> "type"
+                  PDATA -> "data"
               )
           ),
       dataHdName = pName [] [Space 1] (pToken recName) (ProperName recName),
       dataHdVars = []
     }
 
-addNewDecl :: PRecordType -> RecordName -> Declaration ()
-addNewDecl recType recName =
+-- Combine parsing of enum constructors and adding spaces
+addNewDecl :: PRecordType -> RecordName -> Maybe Text -> Declaration ()
+addNewDecl recType recName enumDef =
   let dh = pDataHead recType recName
       eqTok = pSourceToken [] [Space 1] TokEquals
       consName = pName [] [Space 1] (pToken recName) (ProperName recName)
    in case recType of
         PNEWTYPE -> DeclNewtype () dh eqTok consName def
         PTYPE -> DeclType () dh eqTok def
+        PDATA -> case enumDef of
+          Just enum
+            | T.null (T.strip enum) -> error "Enum definition is required for declType: data"
+            | otherwise -> DeclData () dh (Just (eqTok, parseEnumConstructors enum))
+          Nothing -> error "Enum definition is required for declType: data"
+  where
+    parseEnumConstructors enum =
+      let constructors = map T.strip $ T.splitOn "," enum
+          parsedCtors = map parseDataCtor constructors
+       in Separated (head parsedCtors) (zip (repeat pipeSeparator) (tail parsedCtors))
+
+    parseDataCtor ctor =
+      let (name, types) = T.break isSpace (T.strip ctor)
+          ctorName = pName [] [] (pToken name) (ProperName name)
+          ctorTypes =
+            if T.null (T.strip types)
+              then []
+              else [pTypeVar () [Space 1] [] (T.strip types)]
+       in DataCtor () ctorName ctorTypes
+
+    pipeSeparator = pSourceToken [Space 1] [Space 1] TokPipe

lib/namma-dsl/src/NammaDSL/Generator/Purs/TechDesign.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
 module NammaDSL.Generator.Purs.TechDesign where
 
 import Data.Maybe
@@ -26,10 +28,11 @@ applyChange (Ann chg _ fp) = do
         AddComment declSig cmt -> do
           let newDecls = PCST.addCmtUpDeclSig declSig (Comment cmt) (modDecls md)
           pure $ md {modDecls = newDecls}
-        AddRecord _recType _recName -> do
-          if isJust $ PCST.findDeclWithName _recName (modDecls md)
+        AddRecord recType recName enumDef -> do
+          if PCST.findDeclWithName recName (modDecls md) /= Nothing
             then pure md
             else do
-              let newDecl = PCST.addNewDecl _recType _recName
-              pure $ md {modDecls = (modDecls md) ++ [newDecl]}
+              let newDecl = PCST.addNewDecl recType recName enumDef
+              pure $ md {modDecls = modDecls md ++ [newDecl]}
+
       T.writeFile fp (P.printModule newMd)