diff --git a/lib/haskell/natural4/src/LS/Interpreter.hs b/lib/haskell/natural4/src/LS/Interpreter.hs index 6312e189d..45a0cbc7c 100644 --- 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 index 80f74e33a..37d5d0e8a 100644 --- 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