From 09f45b81253423924444b1612d2be034d96546b1 Mon Sep 17 00:00:00 2001 From: Ruslan Khafizov Date: Thu, 3 Oct 2024 16:53:11 +0800 Subject: [PATCH] More code for aajson --- lib/haskell/natural4/src/LS/XPile/AaJson.hs | 25 ++++++++-- .../golden/AaJsonSpec/must_sing.json.expected | 50 ++++++++++--------- 2 files changed, 48 insertions(+), 27 deletions(-) diff --git a/lib/haskell/natural4/src/LS/XPile/AaJson.hs b/lib/haskell/natural4/src/LS/XPile/AaJson.hs index e1597f577..f60ec72ec 100644 --- a/lib/haskell/natural4/src/LS/XPile/AaJson.hs +++ b/lib/haskell/natural4/src/LS/XPile/AaJson.hs @@ -17,7 +17,7 @@ module LS.XPile.AaJson where import AnyAll qualified as AA -import AnyAll.BoolStruct (alwaysLabeled) +import AnyAll.BoolStruct (alwaysLabeled, BoolStructLT) import Control.Monad (join) import Data.Bifunctor (Bifunctor (..), second) import Data.Char qualified as Char @@ -66,6 +66,10 @@ import LS.XPile.Logging ) import PGF (showLanguage) import Text.Pretty.Simple (pShowNoColor) +import Data.Aeson (ToJSON(toJSON), object, (.=),Value, encode) +import Data.Aeson.Key (fromString) +import Base (Generic) +import Data.Aeson.Encode.Pretty (encodePretty) -- | extract the tree-structured rules from Interpreter -- currently: construct a Data.Map of rulenames to exposed decision root expanded BSR @@ -77,6 +81,22 @@ import Text.Pretty.Simple (pShowNoColor) data Tuple a b = Tuple a b deriving (Show, Eq, Ord) +labelToAaJson :: AA.Label T.Text -> Value +labelToAaJson (AA.Pre a) = object [ "Pre" .= a ] +labelToAaJson (AA.PrePost a b) = object [ "PrePost" .= [a,b] ] +labelToAaJson (AA.Metadata a) = object [ "Metadata" .= a ] + +bsToAaJson :: BoolStructLT -> Value +bsToAaJson (AA.All l bs) = object [ "All" .= object["label" .= labelToAaJson l, "children" .= [bsToAaJson c | c <- bs] ]] +bsToAaJson (AA.Any l bs) = object [ "Any" .= object["label" .= labelToAaJson l, "children" .= [bsToAaJson c | c <- bs] ]] +bsToAaJson (AA.Leaf a) = object [ "Leaf" .= a ] +bsToAaJson (AA.Not bs) = object [ "Not" .= bs] + +instance ToJSON (Tuple String BoolStructLT) where + toJSON (Tuple a b) = + object [ fromString a .= bsToAaJson b] + + -- | output Haskell tuples to Purescript toTuple :: (a,b) -> Tuple a b toTuple (x,y) = Tuple x y @@ -309,8 +329,7 @@ translate2AaJson nlgEnvs eng l4i = do case hornByLang of Left err -> xpError err Right hornByLang -> xpReturn [__i| - { - #{pShowNoColor $ DL.nub hornByLang} + #{encodePretty $ toJSON $ DL.nub hornByLang} |] -- mutterdhsf 2 "qaHornsAllLangs" pShowNoColorS qaHornsRights diff --git a/lib/haskell/natural4/test/testdata/golden/AaJsonSpec/must_sing.json.expected b/lib/haskell/natural4/test/testdata/golden/AaJsonSpec/must_sing.json.expected index 1732de545..ec72d1600 100644 --- a/lib/haskell/natural4/test/testdata/golden/AaJsonSpec/must_sing.json.expected +++ b/lib/haskell/natural4/test/testdata/golden/AaJsonSpec/must_sing.json.expected @@ -1,31 +1,33 @@ -{ - "Person": { - "All": { - "label": { - "Pre": "all of:" - }, - "children": [ - { - "Leaf": "does the person walk?" - }, - { - "Any": { - "label": { - "Pre": "any of:" - }, - "children": [ - { - "Leaf": "does the person eat?" - }, - { - "Leaf": "does the person drink?" +[ + { + "Person": { + "All": { + "children": [ + { + "Leaf": "does the person walk?" + }, + { + "Any": { + "children": [ + { + "Leaf": "does the person eat?" + }, + { + "Leaf": "does the person drink?" + } + ], + "label": { + "Pre": "any of:" } - ] + } } + ], + "label": { + "Pre": "all of:" } - ] + } } } -} \ No newline at end of file +] \ No newline at end of file