Merge pull request #407 from smucclaw/20230803-typescript

expand enums in GIVEN/DECIDE
smucclaw · Aug 4, 2023 · cab3a66 · cab3a66
2 parents 1a172a6 + 561055a
commit cab3a66
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 1 deletion.
diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-|
 
@@ -204,8 +205,8 @@ topsortedClasses ct =
 -- - DECLARE toplevelEnum                  IS ONEOF enum1 enum2
 -- - DECLARE class1 HAS attr1              IS ONEOF enum3 enum4
 -- - DECLARE class2 HAS attr2 HAS attr3    IS ONEOF enum5 enum6
+-- - GIVEN x                               IS ONEOF x1 x2 x3      DECIDE ...
 -- We return a list of rules rewritten into a standardized toplevel format, preserving the srcref information
--- [TODO] rewrite this to generalize the hosting of (anonymous) inline classes
 extractEnums :: Interpreted -> [Rule]
 extractEnums l4i =
   let rs = origrules l4i
@@ -215,6 +216,15 @@ extractEnums l4i =
     go r@TypeDecl{super = Just (InlineEnum enumtype enumtext)} =
       [r]
     go TypeDecl{has = has} = concatMap go has
+    go Hornlike{given = Just givens, srcref=srcref} =
+      concatMap go [ defaultTypeDecl { name = nameEnum
+                                     , super = gEnum
+                                     , srcref = srcref}
+                   | (gName, gEnum@(Just (InlineEnum _ _))) <- NE.toList givens
+                   , let nameEnum = (\case
+                                        (MTT mtt) -> MTT $ mtt <> "Enum"
+                                        x         -> x) <$> NE.toList gName
+                   ]
     go _ = []
 
 -- | Sometimes multiple rules will have the same decision content: X depends on Z; Y also depends on Z.

diff --git a/lib/haskell/natural4/src/LS/XPile/Typescript.hs b/lib/haskell/natural4/src/LS/XPile/Typescript.hs
@@ -124,6 +124,7 @@ tsClasses l4i =
                                  case attrType children attrname of
                                    Just t@(SimpleType TOptional _) -> " ?:" <+> prettySimpleType "ts" (snake_inner . MTT) t
                                    Just t@(SimpleType TOne      _) -> " :"  <+> prettySimpleType "ts" (snake_inner . MTT) t
+                                   Just t@(InlineEnum TOne      _) -> " :"  <+> snake_case [MTT attrname] <> "Enum"
                                    Just t                          -> " : " <+> prettySimpleType "ts" (snake_inner . MTT) t
                                    Nothing -> ""
                                  <> semi