diff --git a/lib/haskell/natural4/natural4.cabal b/lib/haskell/natural4/natural4.cabal index 67aca6dd2..5fa56f961 100644 --- a/lib/haskell/natural4/natural4.cabal +++ b/lib/haskell/natural4/natural4.cabal @@ -450,6 +450,7 @@ test-suite natural4-test LS.XPile.JSONSchemaSpec LS.XPile.LogicalEnglishSpec LS.XPile.PrologSpec + LS.XPile.PurescriptSpec LS.XPile.SimalaSpec Parsing.BoolStructParserSpec Parsing.CoreL4ParserSpec diff --git a/lib/haskell/natural4/test/LS/XPile/PurescriptSpec.hs b/lib/haskell/natural4/test/LS/XPile/PurescriptSpec.hs new file mode 100644 index 000000000..17764e27f --- /dev/null +++ b/lib/haskell/natural4/test/LS/XPile/PurescriptSpec.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# OPTIONS_GHC -Wall #-} + +module LS.XPile.PurescriptSpec (spec) where + +import Control.Monad (unless) +import Data.Either (lefts, rights) +import Data.Foldable qualified as DF +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.IO qualified as TL +import LS qualified as SFL4 +import LS.NLP.NLG (NLGEnv, allLangs, langEng, myNLGEnv, printLangs) +import LS.XPile.Logging (XPileLogW, fmapE, mutter, xpLog) +import LS.XPile.Purescript (translate2PS) +import System.FilePath +import System.IO.Unsafe (unsafeInterleaveIO) +import Test.Hspec (Spec, describe, it, runIO) +import Test.Hspec.Golden ( Golden(..) ) +import Prelude hiding (exp, seq) +import LS.Interpreter (l4interpret) + +goldenGeneric :: String -> TL.Text -> Golden TL.Text +goldenGeneric name myoutput = + Golden + { output = myoutput, + encodePretty = TL.unpack, + writeToFile = TL.writeFile, + readFromFile = TL.readFile, + goldenFile = testPath <.> "purs.expected", + actualFile = Just (testPath <.> "purs.actual"), + failFirstTime = False + } + where + testPath = "test" "testdata" "golden" "PurescriptSpec" name + +data NLGData + = MkNLGData + { env :: NLGEnv, + allEnv :: [NLGEnv], + allEnvErr :: XPileLogW, + engErr :: XPileLogW + } + +spec :: Spec +spec = do + describe "toMathLang for arithRule3" do + let testPath = "test" "testdata" "golden" "PurescriptSpec" "must_sing.csv" + opts = SFL4.defaultOptions {SFL4.file = [testPath]} + nlgLangs <- runIO allLangs + strLangs <- runIO $ printLangs allLangs + rules <- runIO (SFL4.dumpRules opts) + l4i <- runIO $ l4interpret rules + (engE, engErr) <- runIO $ xpLog <$> langEng + (_, nlgData) <- runIO $ + case engE of + Left err -> do + putStrLn $ unlines $ "natural4: encountered error when obtaining langEng" : err + pure (Nothing, Nothing) + Right eng -> do + (nlgEnv, _nlgEnvErr) <- unsafeInterleaveIO $ xpLog <$> myNLGEnv l4i eng -- Only load the NLG environment if we need it. + (allNLGEnv, allNLGEnvErr) <- unsafeInterleaveIO do + xps <- traverse (myNLGEnv l4i) nlgLangs + return (xpLog $ sequenceA xps) + + case nlgEnv of + Left err -> do + putStrLn $ unlines $ "natural4: encountered error while obtaining myNLGEnv" : err + pure (Nothing, Nothing) + Right nlgEnvR -> do + let allNLGEnvErrors = mconcat $ lefts allNLGEnv + unless (null allNLGEnvErrors) do + putStrLn "natural4: encountered error while obtaining allNLGEnv" + DF.traverse_ putStrLn allNLGEnvErrors + + let allNLGEnvR = rights allNLGEnv + + let nlgData = + MkNLGData + nlgEnvR + allNLGEnvR + allNLGEnvErr + engErr + + pure (Just nlgEnvR, Just nlgData) + let Just justNLGDate = nlgData + nlgEnvs = justNLGDate.allEnv + eng = justNLGDate.env + (psResult, _) = xpLog do + mutter "* main calling translate2PS" + fmapE (<> ("\n\n" <> "allLang = [\"" <> strLangs <> "\"]")) (translate2PS nlgEnvs eng rules) + (Right justResult) = psResult + finalResult = TL.pack justResult + it "convert must sing to Purescript" $ goldenGeneric "must_sing" finalResult \ No newline at end of file diff --git a/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.csv b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.csv new file mode 100755 index 000000000..9fbfcafc0 --- /dev/null +++ b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.csv @@ -0,0 +1,5 @@ +,,EVERY,Person,,,,,,,,,,,, +,,WHO,walks,,,,,,,,,,,, +,,AND,,eats,,,,,,,,,,, +,,,OR,drinks,,,,,,,,,,, +,,MUST,sing,,,,,,,,,,,, \ No newline at end of file diff --git a/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.purs.expected b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.purs.expected new file mode 100644 index 000000000..f4010b45f --- /dev/null +++ b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/must_sing.purs.expected @@ -0,0 +1,92 @@ +-- This file was automatically generated by natural4. +-- Do not edit by hand. +-- Instead, revise the toolchain starting at smucclaw/dsl/lib/haskell/natural4/app/Main.hs + +module RuleLib.Interview where + +import Prelude +import Data.Either +import Data.Maybe +import Data.Tuple +import Data.Map as Map +import Foreign.Object as Object + +import AnyAll.Types + +interviewRules :: Item String +interviewRules = All + ( Pre "all of:" ) + [ Leaf "does the person walk?" + , Any + ( Pre "any of:" ) + [ Leaf "does the person eat?" + , Leaf "does the person drink?" + ] + ] + + +interviewRules_nl :: NLDict +interviewRules_nl = + Map.fromFoldable + [ ] + +nl4chi :: Object.Object (Item String) +nl4chi = Object.fromFoldable + [ Tuple "Person" + ( All + ( Pre "all of:" ) + [ Leaf "人 走 吗？" + , Any + ( Pre "any of:" ) + [ Leaf "人 吃 吗？" + , Leaf "人 喝 吗？" + ] + ] + ) +] + +nl4chiMarking :: Marking +nl4chiMarking = Marking $ Map.fromFoldable + [] + +nl4eng :: Object.Object (Item String) +nl4eng = Object.fromFoldable + [ Tuple "Person" + ( All + ( Pre "all of:" ) + [ Leaf "does the person walk?" + , Any + ( Pre "any of:" ) + [ Leaf "does the person eat?" + , Leaf "does the person drink?" + ] + ] + ) +] + +nl4engMarking :: Marking +nl4engMarking = Marking $ Map.fromFoldable + [] + +nl4may :: Object.Object (Item String) +nl4may = Object.fromFoldable + [ Tuple "Person" + ( All + ( Pre "all of:" ) + [ Leaf "adakah seseorang berjalan?" + , Any + ( Pre "any of:" ) + [ Leaf "adakah seseorang makan?" + , Leaf "adakah seseorang minum?" + ] + ] + ) +] + +nl4mayMarking :: Marking +nl4mayMarking = Marking $ Map.fromFoldable + [] + + + +allLang = ["nl4chi", "nl4eng", "nl4may"] \ No newline at end of file diff --git a/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.csv b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.csv new file mode 100755 index 000000000..0dcb928df --- /dev/null +++ b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.csv @@ -0,0 +1,27 @@ +,§,Covered If …,,,,,,,,,,, +FALSE,DECIDE,Loss or Damage 1,IS,,Covered,,,,,,,, +TRUE,IF,NOT,,Loss or Damage,caused by,rodents,FALSE,,,,,, +,,,,,OR,insects,TRUE,,,,,, +,,,,,OR,vermin,FALSE,,,,,, +,,,,,OR,birds,FALSE,,,,,, +FALSE,,,UNLESS,,,Loss or Damage,IS,to Contents,,FALSE,,, +,,,,,AND,"""","""",caused by,birds,FALSE,,, +TRUE,,,,OR,,"""","""",ensuing covered loss,TRUE,,,, +FALSE,,,,,UNLESS,,any other exclusion applies,,FALSE,,,, +FALSE,,,,,,OR,an animal caused water to escape from,,,a household appliance,,,FALSE +,,,,,,,,,OR,a swimming pool,,,FALSE +,,,,,,,,,OR,"a plumbing, heating, or air conditioning system",,,FALSE +;;,,,,,,,,,,,,, +,§,Not Covered If …,,,,,,,,,,, +FALSE,DECIDE,Loss or Damage 2,IS,,Covered,,,,,,,, +FALSE,IF,Loss or Damage,caused by,rodents,FALSE,,,,,,,, +,,,OR,insects,FALSE,,,,,,,, +,,,OR,vermin,FALSE,,,,,,,, +,,,OR,birds,FALSE,,,,,,,, +FALSE,UNLESS,,,Loss or Damage,IS,to Contents,,FALSE,,,,, +,,,AND,"""","""",caused by,birds,FALSE,,,,, +FALSE,,OR,,Loss or Damage,IS,ensuing covered loss,FALSE,,,,,, +FALSE,,,UNLESS,,any other exclusion applies,,FALSE,,,,,, +FALSE,,,,OR,an animal caused water to escape from,,,a household appliance,,,FALSE,, +,,,,,,,OR,a swimming pool,,,FALSE,, +,,,,,,,OR,"a plumbing, heating, or air conditioning system",,,FALSE,, diff --git a/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.purs.expected b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.purs.expected new file mode 100644 index 000000000..ec1563f51 --- /dev/null +++ b/lib/haskell/natural4/test/testdata/golden/PurescriptSpec/rodents.purs.expected @@ -0,0 +1,322 @@ +-- This file was automatically generated by natural4. +-- Do not edit by hand. +-- Instead, revise the toolchain starting at smucclaw/dsl/lib/haskell/natural4/app/Main.hs + +module RuleLib.Interview where + +import Prelude +import Data.Either +import Data.Maybe +import Data.Tuple +import Data.Map as Map +import Foreign.Object as Object + +import AnyAll.Types + +interviewRules :: Item String +interviewRules = Not + ( All + ( Pre "all of:" ) + [ Any + ( Pre "Is the Loss or Damage caused by" ) + [ Leaf "rodents?" + , Leaf "insects?" + , Leaf "vermin?" + , Leaf "birds?" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage to contents?" + , Leaf "is Loss or Damage caused by birds?" + ] + , All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage ensuing covered loss?" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "does any other exclusion apply?" + , Any + ( Pre "did an animal cause water to escape from" ) + [ Leaf "a household appliance?" + , Leaf "a swimming pool?" + , Leaf "a plumbing, heating, or air conditioning system?" + ] + ] + ) + ] + ] + ) + ] + ) + + +interviewRules_nl :: NLDict +interviewRules_nl = + Map.fromFoldable + [ ] + +nl4chi :: Object.Object (Item String) +nl4chi = Object.fromFoldable + [ Tuple "Covered If …" + ( Not + ( All + ( Pre "all of:" ) + [ Any + ( Pre "那 个 损 失 或 损 害 的 原 因" ) + [ Leaf "些 啮 齿？" + , Leaf "些 昆 虫？" + , Leaf "蠹 虫？" + , Leaf "些 鸟？" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "" + , Leaf "损 失 或 损 害 是 被 些 鸟 的 原 因 的 吗？" + ] + , All + ( Pre "all of:" ) + [ Leaf "损 失 或 损 害 是 保 户 [UseN] 接 着 的 吗？" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "任 何 其 他 排 除 [UseV] [UseV] [UseV] [UseV] 吗？" + , Any + ( Pre "" ) + [ Leaf "一 个 家 用 电 器？" + , Leaf "一 个 游 泳 池？" + , Leaf "管 路 系 统 或 暖 通 空 调？" + ] + ] + ) + ] + ] + ) + ] + ) + ) +, Tuple "Not Covered If …" + ( All + ( Pre "all of:" ) + [ Any + ( Pre "那 个 损 失 或 损 害 的 原 因" ) + [ Leaf "些 啮 齿？" + , Leaf "些 昆 虫？" + , Leaf "蠹 虫？" + , Leaf "些 鸟？" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "" + , Leaf "损 失 或 损 害 是 被 些 鸟 的 原 因 的 吗？" + ] + , All + ( Pre "all of:" ) + [ Leaf "损 失 或 损 害 是 保 户 [UseN] 接 着 的 吗？" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "任 何 其 他 排 除 [UseV] [UseV] [UseV] [UseV] 吗？" + , Any + ( Pre "" ) + [ Leaf "一 个 家 用 电 器？" + , Leaf "一 个 游 泳 池？" + , Leaf "管 路 系 统 或 暖 通 空 调？" + ] + ] + ) + ] + ] + ) + ] + ) +] + +nl4chiMarking :: Marking +nl4chiMarking = Marking $ Map.fromFoldable + [] + +nl4eng :: Object.Object (Item String) +nl4eng = Object.fromFoldable + [ Tuple "Covered If …" + ( Not + ( All + ( Pre "all of:" ) + [ Any + ( Pre "Is the Loss or Damage caused by" ) + [ Leaf "rodents?" + , Leaf "insects?" + , Leaf "vermin?" + , Leaf "birds?" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage to contents?" + , Leaf "is Loss or Damage caused by birds?" + ] + , All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage ensuing covered loss?" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "does any other exclusion apply?" + , Any + ( Pre "did an animal cause water to escape from" ) + [ Leaf "a household appliance?" + , Leaf "a swimming pool?" + , Leaf "a plumbing, heating, or air conditioning system?" + ] + ] + ) + ] + ] + ) + ] + ) + ) +, Tuple "Not Covered If …" + ( All + ( Pre "all of:" ) + [ Any + ( Pre "Is the Loss or Damage caused by" ) + [ Leaf "rodents?" + , Leaf "insects?" + , Leaf "vermin?" + , Leaf "birds?" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage to contents?" + , Leaf "is Loss or Damage caused by birds?" + ] + , All + ( Pre "all of:" ) + [ Leaf "is Loss or Damage ensuing covered loss?" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "does any other exclusion apply?" + , Any + ( Pre "did an animal cause water to escape from" ) + [ Leaf "a household appliance?" + , Leaf "a swimming pool?" + , Leaf "a plumbing, heating, or air conditioning system?" + ] + ] + ) + ] + ] + ) + ] + ) +] + +nl4engMarking :: Marking +nl4engMarking = Marking $ Map.fromFoldable + [] + +nl4may :: Object.Object (Item String) +nl4may = Object.fromFoldable + [ Tuple "Covered If …" + ( Not + ( All + ( Pre "all of:" ) + [ Any + ( Pre "Adakah Kerugian atau Kerosakan disebabkan oleh" ) + [ Leaf "rodensia-rodensia?" + , Leaf "serangga-serangga?" + , Leaf "binatang perosak?" + , Leaf "burung-burung?" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "" + , Leaf "adakah Kerugian atau Kerosakan disebabkan burung-burung?" + ] + , All + ( Pre "all of:" ) + [ Leaf "adakah Kerugian atau Kerosakan berlaku akibat [UseN] yang dilindungi [UseN]?" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "adakah sebarang pengecualian lain [UseV]?" + , Any + ( Pre "" ) + [ Leaf "perkakas rumah?" + , Leaf "kolam renang?" + , Leaf "sistem paip atau HVAC?" + ] + ] + ) + ] + ] + ) + ] + ) + ) +, Tuple "Not Covered If …" + ( All + ( Pre "all of:" ) + [ Any + ( Pre "Adakah Kerugian atau Kerosakan disebabkan oleh" ) + [ Leaf "rodensia-rodensia?" + , Leaf "serangga-serangga?" + , Leaf "binatang perosak?" + , Leaf "burung-burung?" + ] + , Not + ( Any + ( Pre "any of:" ) + [ All + ( Pre "all of:" ) + [ Leaf "" + , Leaf "adakah Kerugian atau Kerosakan disebabkan burung-burung?" + ] + , All + ( Pre "all of:" ) + [ Leaf "adakah Kerugian atau Kerosakan berlaku akibat [UseN] yang dilindungi [UseN]?" + , Not + ( Any + ( Pre "any of:" ) + [ Leaf "adakah sebarang pengecualian lain [UseV]?" + , Any + ( Pre "" ) + [ Leaf "perkakas rumah?" + , Leaf "kolam renang?" + , Leaf "sistem paip atau HVAC?" + ] + ] + ) + ] + ] + ) + ] + ) +] + +nl4mayMarking :: Marking +nl4mayMarking = Marking $ Map.fromFoldable + [] + + + +allLang = ["nl4chi", "nl4eng", "nl4may"] \ No newline at end of file