refactor converter result to support emitting warnings/errors in a ni…

…ce way

templatespiler-converter/app/Main.hs

@@ -7,6 +7,7 @@ import Main.Utf8 qualified as Utf8
 import Prettyprinter
 import Prettyprinter.Render.Terminal (putDoc)
 import Prettyprinter.Render.Text qualified as PP
+import Templatespiler.Convert (renderConvertResult)
 import Templatespiler.Convert.Target (TargetLanguage (..), toIR)
 import Templatespiler.Emit.Target
 import Templatespiler.IR.Imperative
@@ -29,5 +30,5 @@ main = do
       -- PP.putDoc doc
       putStrLn ""
       let doc2 = emitLang @C c
-      PP.putDoc doc2
+      putTextLn $ renderConvertResult doc2
       putStrLn ""

templatespiler-converter/src/Templatespiler/Convert.hs

@@ -5,12 +5,13 @@ module Templatespiler.Convert where
 
 import Language.Templatespiler.Syntax
 import Prettyprinter
-import Prettyprinter.Render.Text
+import Prettyprinter.Render.Terminal
 import Templatespiler.Convert.Target
+import Templatespiler.Emit.Common
 import Templatespiler.Emit.Target
 import Templatespiler.ToLang.Target
 
-convertTo :: BindingList -> TargetLanguage -> Maybe Text
+convertTo :: BindingList -> TargetLanguage -> Maybe ConvertResult
 convertTo bindingList lang = case lang of
   Python -> Just $ convertTo' @Python bindingList
   _ -> Nothing
@@ -19,9 +20,12 @@ convertTo' ::
   forall (target :: TargetLanguage) ast.
   (ToIR target (ParadigmOf target), ToLang target ast, EmitLang target ast) =>
   BindingList ->
-  Text
+  ConvertResult
 convertTo' bindingList = do
   let ir = toIR @target bindingList :: IRTarget (ParadigmOf target)
   let ast = toLang @target @ast ir
-  let doc = emitLang @target @ast ast
-  renderStrict $ layoutPretty defaultLayoutOptions doc
+  emitLang @target @ast ast
+
+renderConvertResult :: ConvertResult -> Text
+renderConvertResult (ConversionFailed doc) = renderStrict $ layoutPretty defaultLayoutOptions doc
+renderConvertResult (ConvertResult warnings code) = renderStrict $ layoutPretty defaultLayoutOptions $ vsep warnings <> reAnnotate (const mempty) code

templatespiler-converter/src/Templatespiler/Emit/C.hs

@@ -1,21 +1,18 @@
 module Templatespiler.Emit.C where
 
 import Prettyprinter
-import Templatespiler.Emit.Common (indentDepth)
+import Templatespiler.Emit.Common (ConvertResult (..), PDoc, indentDepth)
 import Templatespiler.ToLang.C
 
-emitToCError :: ToCError -> Doc ()
+emitToCError :: ToCError -> PDoc
 emitToCError (LoopEndNotConvertible e) = "Loop end not convertible: " <+> pretty e
 
-emitCWarnings :: [ToCWarning] -> Doc ()
-emitCWarnings = vcat . fmap emitCWarning
-  where
-    emitCWarning :: ToCWarning -> Doc ()
-    emitCWarning (CantEmitCompoundType x) = "Can't emit compound type: " <+> pretty x
+emitCWarning :: ToCWarning -> PDoc
+emitCWarning (CantEmitCompoundType x) = "Can't emit compound type: " <+> pretty x
 
-emitCResult :: Either ToCError (Program, [ToCWarning]) -> Doc ()
-emitCResult (Left e) = emitToCError e
-emitCResult (Right (program, warnings)) = vsep [emitCWarnings warnings, emitC program]
+emitCResult :: Either ToCError (Program, [ToCWarning]) -> ConvertResult
+emitCResult (Left e) = ConversionFailed $ emitToCError e
+emitCResult (Right (program, warnings)) = ConvertResult (fmap emitCWarning warnings) (emitC program)
 
 emitC :: Program -> Doc ()
 emitC program = do

templatespiler-converter/src/Templatespiler/Emit/Common.hs

@@ -1,4 +1,18 @@
 module Templatespiler.Emit.Common where
 
+import Prettyprinter (Doc)
+import Prettyprinter.Render.Terminal (AnsiStyle)
+
 indentDepth :: Int
 indentDepth = 4
+
+type TDoc = Doc ()
+type PDoc = Doc AnsiStyle
+
+data ConvertResult
+  = ConversionFailed PDoc
+  | ConvertResult
+      { warnings :: [PDoc]
+      , code :: TDoc
+      }
+  deriving stock (Show)

templatespiler-converter/src/Templatespiler/Emit/Python.hs

@@ -1,17 +1,14 @@
 module Templatespiler.Emit.Python where
 
 import Prettyprinter
-import Templatespiler.Emit.Common (indentDepth)
+import Templatespiler.Emit.Common (ConvertResult (ConvertResult), PDoc, indentDepth)
 import Templatespiler.ToLang.Python
 
-emitPyWarnings :: [ToPythonWarning] -> Doc ()
-emitPyWarnings = vcat . fmap emitPyWarning
-  where
-    emitPyWarning :: ToPythonWarning -> Doc ()
-    emitPyWarning x = case x of {}
+emitPyWarning :: ToPythonWarning -> PDoc
+emitPyWarning x = case x of {}
 
-emitPyResult :: (Program, [ToPythonWarning]) -> Doc ()
-emitPyResult (program, warnings) = vsep [emitPyWarnings warnings, emitPy program]
+emitPyResult :: (Program, [ToPythonWarning]) -> ConvertResult
+emitPyResult (program, warnings) = ConvertResult (emitPyWarning <$> warnings) (emitPy program)
 
 emitPy :: Program -> Doc ()
 emitPy = vsep . fmap emitStmt

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

@@ -6,13 +6,14 @@ module Templatespiler.Emit.Target where
 import Prettyprinter
 import Templatespiler.Convert.Target
 import Templatespiler.Emit.C qualified as C
+import Templatespiler.Emit.Common (ConvertResult)
 import Templatespiler.Emit.Python qualified as Py
 import Templatespiler.ToLang.C qualified as C
 import Templatespiler.ToLang.Python qualified as Py
 import Templatespiler.ToLang.Target
 
 class (LangAST lang ~ ast) => EmitLang (lang :: TargetLanguage) ast where
-  emitLang :: LangASTRes lang -> Doc ()
+  emitLang :: LangASTRes lang -> ConvertResult
 
 instance EmitLang 'Python Py.Program where
   emitLang = Py.emitPyResult

templatespiler-server/src/Main.hs

@@ -11,8 +11,9 @@ import Network.Wai.Handler.Warp (run)
 import Network.Wai.Middleware.Cors
 import Prettyprinter
 import Prettyprinter.Render.Text
-import Servant (Application, Handler, Server, ServerError (..), ServerT, err400, hoistServer, serve, throwError, (:<|>) (..))
-import Templatespiler.Convert (convertTo)
+import Servant (Application, Handler, ServerError (..), ServerT, err400, hoistServer, serve, throwError, (:<|>) (..))
+import Templatespiler.Convert (convertTo, renderConvertResult)
+import Templatespiler.Emit.Common (ConvertResult (..), PDoc, TDoc)
 import Templatespiler.Generator (generateInput)
 import Templatespiler.Server
 import Text.Trifecta (ErrInfo (_errDoc), Result (..), parseByteString)
@@ -54,26 +55,34 @@ templatespilerServer =
           pure $ ParsedTemplate templateID
         Failure err -> throwError $ err400 {errBody = encodeUtf8 $ renderStrict $ layoutPretty defaultLayoutOptions $ _errDoc err}
     generate :: TemplateID -> Int -> AppM GenerateResponse
-    generate id len = do
+    generate templateId len = do
       state <- ask
       templates' <- readTVarIO (templates state)
-      case lookup id templates' of
+      case lookup templateId templates' of
         Nothing -> throwError $ err400 {errBody = "Template not found"}
         Just bindingList -> do
           inputs <- liftIO $ replicateM len $ generateInput bindingList
           pure $ GenerateResponse inputs
     compile :: TemplateID -> Language -> AppM CompiledTemplateResponse
-    compile id l@(Language lang) = do
+    compile templateId l@(Language lang) = do
       state <- ask
       templates' <- readTVarIO (templates state)
-      case lookup id templates' of
+      case lookup templateId templates' of
         Nothing -> throwError $ err400 {errBody = "Template not found"}
         Just bindingList -> do
-          liftIO $ putStrLn $ "Compiling template " <> show id <> " to " <> show l
+          liftIO $ putStrLn $ "Compiling template " <> show templateId <> " to " <> show l
           let compiled = convertTo bindingList lang
           case compiled of
             Nothing -> throwError $ err400 {errBody = "Language not supported"}
-            Just compiled -> do
-              liftIO $ putStrLn $ "Compiled template " <> show id <> " to " <> show l
-              liftIO $ putTextLn compiled
-              pure $ CompiledTemplateResponse [] (CompiledTemplate l (toBase64 compiled))
+            Just compileResult -> do
+              liftIO $ putStrLn $ "Compiled template " <> show templateId <> " to " <> show l
+              liftIO $ putTextLn $ renderConvertResult compileResult
+              case compileResult of
+                ConversionFailed doc -> throwError $ err400 {errBody = encodeUtf8 $ renderPDoc doc}
+                ConvertResult warnings code -> pure $ CompiledTemplateResponse (renderPDoc <$> warnings) (CompiledTemplate l (toBase64 (renderTDoc code)))
+
+renderPDoc :: PDoc -> Text
+renderPDoc = renderTDoc . unAnnotate
+
+renderTDoc :: TDoc -> Text
+renderTDoc = renderStrict . layoutPretty defaultLayoutOptions