diff --git a/templatespiler-converter/app/Main.hs b/templatespiler-converter/app/Main.hs index f1e28c4..eb66b5c 100644 --- a/templatespiler-converter/app/Main.hs +++ b/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 "" diff --git a/templatespiler-converter/src/Templatespiler/Convert.hs b/templatespiler-converter/src/Templatespiler/Convert.hs index c2b19c0..bfd3b86 100644 --- a/templatespiler-converter/src/Templatespiler/Convert.hs +++ b/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 diff --git a/templatespiler-converter/src/Templatespiler/Emit/C.hs b/templatespiler-converter/src/Templatespiler/Emit/C.hs index a1ae69a..b0f8036 100644 --- a/templatespiler-converter/src/Templatespiler/Emit/C.hs +++ b/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 diff --git a/templatespiler-converter/src/Templatespiler/Emit/Common.hs b/templatespiler-converter/src/Templatespiler/Emit/Common.hs index 028d3ca..c9469a0 100644 --- a/templatespiler-converter/src/Templatespiler/Emit/Common.hs +++ b/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) diff --git a/templatespiler-converter/src/Templatespiler/Emit/Python.hs b/templatespiler-converter/src/Templatespiler/Emit/Python.hs index f0b66f2..be36df5 100644 --- a/templatespiler-converter/src/Templatespiler/Emit/Python.hs +++ b/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 diff --git a/templatespiler-converter/src/Templatespiler/Emit/Target.hs b/templatespiler-converter/src/Templatespiler/Emit/Target.hs index 6198e64..b5060c3 100644 --- a/templatespiler-converter/src/Templatespiler/Emit/Target.hs +++ b/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 diff --git a/templatespiler-server/src/Main.hs b/templatespiler-server/src/Main.hs index 0eda250..54cd784 100644 --- a/templatespiler-server/src/Main.hs +++ b/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