add an integration test for source generation

hie.yaml

@@ -6,6 +6,9 @@ cradle:
     - path: "templatespiler-converter/src/Main.hs"
       component: "templatespiler-converter:exe:converter"
 
+    - path: "templatespiler-converter/test"
+      component: "templatespiler-converter:test:test"
+
     - path: "templatespiler-generator/src"
       component: "lib:templatespiler-generator"
 
@@ -25,4 +28,4 @@ cradle:
       component: "templatespiler-server:exe:server"
 
     - path: "templatespiler-server/src/Main.hs"
-      component: "templatespiler-server:exe:server"
+      component: "templatespiler-server:exe:server"

templatespiler-converter/converter.cabal

@@ -12,6 +12,7 @@ common shared
     -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns
     -Wmissing-deriving-strategies -Wunused-foralls -Wunused-foralls
     -fprint-explicit-foralls -fprint-explicit-kinds
+    -threaded -rtsopts -with-rtsopts=-N
 
   mixins:
     base hiding (Prelude),
@@ -63,3 +64,24 @@ executable converter
   main-is:        Main.hs
   build-depends:  templatespiler-converter
   hs-source-dirs: app
+
+test-suite test
+  import:             shared
+  type:               exitcode-stdio-1.0
+  main-is:            Main.hs
+  build-depends:
+    , hedgehog               >=1.4
+    , sydtest
+    , sydtest-hedgehog
+    , templatespiler-generator
+    , templatespiler-converter
+    , process
+    , temporary
+    , temporary-resourcet
+    , exceptions
+    , unliftio-core
+    , mmorph
+    , resourcet
+
+  default-extensions: TemplateHaskell
+  hs-source-dirs:     test

templatespiler-converter/src/Templatespiler/Convert.hs

@@ -14,6 +14,7 @@ import Templatespiler.ToLang.Target
 convertTo :: BindingList -> TargetLanguage -> Maybe ConvertResult
 convertTo bindingList lang = case lang of
   Python -> Just $ convertTo' @Python bindingList
+  C -> Just $ convertTo' @C bindingList
   _ -> Nothing
 
 convertTo' ::

templatespiler-converter/src/Templatespiler/Convert/Target.hs

@@ -12,14 +12,15 @@ import Templatespiler.Convert.ToImperative qualified as Imperative
 import Templatespiler.IR.Declarative as DecIR
 import Templatespiler.IR.Imperative as ImpIR
 
-data TargetLanguage = C | Python | Haskell deriving stock (Eq, Show, Generic)
+data TargetLanguage = C | Python deriving stock (Eq, Show, Generic, Enum, Bounded)
 
 data LanguageKind = Imperative | Declarative
 
 type family ParadigmOf (lang :: TargetLanguage) where
   ParadigmOf C = Imperative
   ParadigmOf Python = Imperative
-  ParadigmOf Haskell = Declarative
+
+-- ParadigmOf Haskell = Declarative -- TODO
 
 type family IRTarget (lang :: LanguageKind) = p | p -> lang where
   IRTarget Imperative = ImpIR.Program

templatespiler-converter/test/Main.hs

@@ -0,0 +1,108 @@
+{-# LANGUAGE PackageImports #-}
+
+module Main where
+
+import Control.Monad.Catch
+import Control.Monad.IO.Unlift
+import Control.Monad.Morph (hoist)
+import Control.Monad.Trans.Resource
+import Data.Text.IO qualified as Text
+import Hedgehog (MonadTest, evalEither, evalMaybe, forAll, property, (===))
+import Hedgehog.Gen qualified as Gen
+import Hedgehog.Internal.Property (failWith)
+import Hedgehog.Range qualified as Range
+import Language.Templatespiler.Parser
+import Language.Templatespiler.Syntax
+import Prettyprinter
+import Prettyprinter.Render.Terminal
+import System.IO (hClose)
+import System.Process
+import Templatespiler.Convert
+import Templatespiler.Convert.Target
+import Templatespiler.Emit.Common
+import Templatespiler.Generate (arbitraryInput)
+import Templatespiler.Generator
+import Test.Syd
+import Test.Syd.Hedgehog
+import Text.Trifecta
+import Util (shouldBeJust, shouldBeRight)
+import "temporary" System.IO.Temp qualified as Temp
+import "temporary-resourcet" System.IO.Temp qualified as TempResourceT
+import System.FilePath ((</>))
+
+main :: IO ()
+main = sydTest spec
+
+spec :: Spec
+spec = describe "Integration Test" $ do
+  it "Simple Template" $ do
+    property . hoist runResourceT $ do
+      let parsed = parseTemplate simpleTemplate3Ints
+      res <- evalEither parsed
+
+      let allLanguages = [minBound ..] :: [TargetLanguage]
+      for_ allLanguages $ \lang -> do
+        genResult <- evalMaybe $ convertTo res lang
+        code <- case genResult of
+          ConversionFailed errorDoc -> failWith Nothing $ toString $ renderStrict $ layoutPretty defaultLayoutOptions errorDoc
+          ConvertResult warnings code -> do
+            liftIO $ putDoc $ vsep warnings
+            pure $ show code
+
+        pass
+        exec <- withCompiled lang code
+        input <- forAll $ arbitraryInput res
+        liftIO $ exec input
+
+
+withCompiled :: MonadResource m => TargetLanguage -> Text -> m ([Text] -> IO ())
+withCompiled lang code = do
+  (_, fp) <- TempResourceT.createTempDirectory Nothing "templatespiler"
+
+  let sourceExt = case lang of
+        Python -> ".py"
+        C -> ".c"
+  (_, sourceFp, sourceHandle) <- TempResourceT.openTempFile (Just fp) ("source" <> sourceExt)
+  liftIO $ Text.hPutStrLn sourceHandle code
+  liftIO $ hClose sourceHandle
+  compiledFile <- case lang of
+    Python -> pure sourceFp
+    C -> do
+      liftIO $ callProcess "gcc" [sourceFp, "-o", fp </> "a.out"]
+      pure $ fp <> "/a.out"
+
+  let (cmdToRun, argsToRun) = case lang of
+        Python -> ("python3", [toText compiledFile])
+        C -> (toText compiledFile, [])
+
+  pure $ \inputs -> runProcessWithStdin cmdToRun argsToRun inputs
+
+runProcessWithStdin :: Text -> [Text] -> [Text] -> IO ()
+runProcessWithStdin processName args input = do
+  let inputText = unlines input
+  (Just hin, Just hout, _, _) <- createProcess (proc (toString processName) (map toString args)) {std_in = CreatePipe, std_out = CreatePipe}
+  Text.hPutStrLn hin inputText
+  hFlush hin
+  -- assert that the process exits successfully with no output
+  output <- Text.hGetContents hout
+  output `shouldBe` ""
+
+parseTemplate :: Text -> Either Text BindingList
+parseTemplate input = do
+  let x = parseByteString parseBindingList mempty . encodeUtf8 $ input
+  case x of
+    Success a -> Right a
+    Failure e -> Left $ renderStrict $ layoutPretty defaultLayoutOptions $ _errDoc e
+
+-- tests :: TestTree
+-- tests =
+--   testGroup
+--     "Test Generation"
+--     [ testCaseSteps "Simple Template" $ \step -> do
+--         step "Parse Template"
+--         let parsed = parseTemplate simpleTemplate3Ints
+
+--     ]
+
+simpleTemplate3Ints :: Text
+simpleTemplate3Ints = "a : Integer\n b : Integer\n c : Integer\n"

templatespiler-converter/test/Util.hs

@@ -0,0 +1,15 @@
+module Util where
+
+import Test.Syd
+
+shouldBeRight :: (Show a, HasCallStack) => Either Text a -> IO a
+shouldBeRight theEither = do
+  shouldSatisfyNamed theEither "IsRight" isRight
+  Right a <- pure theEither
+  pure a
+
+shouldBeJust :: (Show a, HasCallStack) => Text -> Maybe a -> IO a
+shouldBeJust annotation theMaybe = do
+  shouldSatisfyNamed theMaybe (toString ("IsJust: " <> annotation)) isJust
+  Just a <- pure theMaybe
+  pure a