From 2224e9371524be940f80d7b50f98c278a2254aa0 Mon Sep 17 00:00:00 2001 From: Alexander Wood Date: Tue, 11 Jun 2024 16:37:33 +0100 Subject: [PATCH] make everything work again --- templatespiler-converter/app/Main.hs | 4 +- .../src/Templatespiler/Convert/Target.hs | 1 - .../Templatespiler/Convert/ToImperative.hs | 120 +++++++++--------- .../src/Templatespiler/IR/Imperative.hs | 5 +- .../src/Templatespiler/ToLang/Python.hs | 120 +++++++++--------- .../src/Templatespiler/Server.hs | 5 +- 6 files changed, 128 insertions(+), 127 deletions(-) diff --git a/templatespiler-converter/app/Main.hs b/templatespiler-converter/app/Main.hs index 947abdf..c4865d9 100644 --- a/templatespiler-converter/app/Main.hs +++ b/templatespiler-converter/app/Main.hs @@ -9,7 +9,7 @@ import Prettyprinter.Render.Terminal (putDoc) import Prettyprinter.Render.Text qualified as PP import Templatespiler.Convert.Target (TargetLanguage (..), toIR) import Templatespiler.Emit.Target -import Templatespiler.IR.Imperative (prettyProgram) +import Templatespiler.IR.Imperative import Templatespiler.ToLang.Target (ToLang (toLang)) import Text.Trifecta (parseFromFile) @@ -20,7 +20,7 @@ main = do Nothing -> exitFailure Just bs -> do let ir = toIR @Python bs - putDoc $ prettyProgram ir + -- putDoc $ prettyProgram ir let py = toLang @Python ir putStrLn "" diff --git a/templatespiler-converter/src/Templatespiler/Convert/Target.hs b/templatespiler-converter/src/Templatespiler/Convert/Target.hs index e8be6b0..e697f81 100644 --- a/templatespiler-converter/src/Templatespiler/Convert/Target.hs +++ b/templatespiler-converter/src/Templatespiler/Convert/Target.hs @@ -6,7 +6,6 @@ module Templatespiler.Convert.Target where -import Data.Reflection (Reifies (reflect)) import Language.Templatespiler.Syntax (BindingList) import Templatespiler.Convert.ToDeclarative qualified as Declarative import Templatespiler.Convert.ToImperative qualified as Imperative diff --git a/templatespiler-converter/src/Templatespiler/Convert/ToImperative.hs b/templatespiler-converter/src/Templatespiler/Convert/ToImperative.hs index 332263d..05a700c 100644 --- a/templatespiler-converter/src/Templatespiler/Convert/ToImperative.hs +++ b/templatespiler-converter/src/Templatespiler/Convert/ToImperative.hs @@ -9,74 +9,74 @@ import Prelude hiding (Type) type IRWriter a = Writer [IR.Statement] a toIR :: BindingList -> IR.Program -toIR (BindingList bs) = execWriter $ traverse bindingToIR bs +toIR (BindingList bs) = execWriter $ traverse undefined bs -bindingToIR :: Binding -> IRWriter IR.Expr -bindingToIR (Binding name t) = typeVarToIR name t +-- bindingToIR :: Binding -> IRWriter IR.Expr +-- bindingToIR (Binding name t) = typeVarToIR name t -typeVarToIR :: Ident -> Type -> IRWriter IR.Expr -typeVarToIR name (TerminalType t) = terminalVarToIR name t -typeVarToIR name (CombinatorType c) = combinatorVarToIR name c +-- typeVarToIR :: Ident -> Type -> IRWriter IR.Expr +-- typeVarToIR name (TerminalType t) = terminalVarToIR name t +-- typeVarToIR name (CombinatorType c) = combinatorVarToIR name c -combinatorVarToIR :: Ident -> Combinator -> IRWriter IR.Expr -combinatorVarToIR _ (NamedCombinator newName c) = typeVarToIR newName c -combinatorVarToIR _ (GroupCombinator (BindingList bs)) = do - es <- traverse bindingToIR bs - pure (IR.TupleOrStruct Nothing es) -combinatorVarToIR name (ArrayCombinator len b) = do - let lenExpr = IR.ConstInt len - arrayLike (identToVarName name) lenExpr b -combinatorVarToIR name (SepByCombinator sep (BindingList bindingList)) = do - let toReadAssign (Binding n t) = - ( identToVarName n - , case t of - TerminalType StringType -> IR.ReadString - TerminalType IntType -> IR.ReadInt - TerminalType FloatType -> IR.ReadFloat - CombinatorType c -> error ("CombinatorType in toReadAssign: " <> (show c)) - ) - let rAss = toReadAssign <$> bindingList - tell [IR.MultiReadAssign (toText sep) rAss] - pure (IR.TupleOrStruct (Just (identToVarName name)) (IR.Var . fst <$> rAss)) -combinatorVarToIR name (ListCombinator b) = do - let vn = identToVarName name - let lenName = vn `withSuffix` "len" - tell [IR.Assign lenName IR.IntType (IR.ReadAtom IR.ReadInt)] - arrayLike vn (IR.Var lenName) b +-- combinatorVarToIR :: Ident -> Combinator -> IRWriter IR.Expr +-- combinatorVarToIR _ (NamedCombinator newName c) = typeVarToIR newName c +-- combinatorVarToIR _ (GroupCombinator (BindingList bs)) = do +-- es <- traverse bindingToIR bs +-- pure (IR.TupleOrStruct Nothing es) +-- combinatorVarToIR name (ArrayCombinator len b) = do +-- let lenExpr = IR.ConstInt len +-- arrayLike (identToVarName name) lenExpr b +-- combinatorVarToIR name (SepByCombinator sep (BindingList bindingList)) = do +-- let toReadAssign (Binding n t) = +-- ( identToVarName n +-- , case t of +-- TerminalType StringType -> IR.ReadString +-- TerminalType IntType -> IR.ReadInt +-- TerminalType FloatType -> IR.ReadFloat +-- CombinatorType c -> error ("CombinatorType in toReadAssign: " <> (show c)) +-- ) +-- let rAss = toReadAssign <$> bindingList +-- tell [IR.MultiReadAssign (toText sep) rAss] +-- pure (IR.TupleOrStruct (Just (identToVarName name)) (IR.Var . fst <$> rAss)) +-- combinatorVarToIR name (ListCombinator b) = do +-- let vn = identToVarName name +-- let lenName = vn `withSuffix` "len" +-- tell [IR.Assign lenName IR.IntType (IR.ReadAtom IR.ReadInt)] +-- arrayLike vn (IR.Var lenName) b -arrayLike :: VarName -> IR.Expr -> Type -> IRWriter IR.Expr -arrayLike vn lenExpr b = do - tell [IR.Decl vn (IR.ArrayType lenExpr (tryFigureOutTypeOf (Just lenExpr) b))] +-- arrayLike :: VarName -> IR.Expr -> Type -> IRWriter IR.Expr +-- arrayLike vn lenExpr b = do +-- tell [IR.Decl vn (IR.ArrayType lenExpr (tryFigureOutTypeOf (Just lenExpr) b))] - let idxName = vn `withSuffix` "idx" - let (_, b') = runWriter $ do - e <- typeVarToIR (Ident "unnamed") b - tell [IR.AppendToArray vn (IR.Var idxName) e] +-- let idxName = vn `withSuffix` "idx" +-- let (_, b') = runWriter $ do +-- e <- typeVarToIR (Ident "unnamed") b +-- tell [IR.AppendToArray vn (IR.Var idxName) e] - tell [IR.For idxName (IR.ConstInt 0) lenExpr b'] - pure (IR.Var vn) +-- tell [IR.For idxName (IR.ConstInt 0) lenExpr b'] +-- pure (IR.Var vn) -tryFigureOutTypeOf :: Maybe IR.Expr -> Type -> IR.VarType -tryFigureOutTypeOf _ (TerminalType StringType) = IR.StringType -tryFigureOutTypeOf _ (TerminalType IntType) = IR.IntType -tryFigureOutTypeOf _ (TerminalType FloatType) = IR.FloatType -tryFigureOutTypeOf _ (CombinatorType (NamedCombinator _ t)) = tryFigureOutTypeOf Nothing t -tryFigureOutTypeOf _ (CombinatorType (GroupCombinator (BindingList bs))) = IR.TupleOrStructType Nothing (fmap (\(Binding _ t) -> tryFigureOutTypeOf Nothing t) bs) -tryFigureOutTypeOf _ (CombinatorType (ArrayCombinator len t)) = IR.ArrayType (IR.ConstInt len) (tryFigureOutTypeOf Nothing t) -tryFigureOutTypeOf _ (CombinatorType (SepByCombinator _ (BindingList bs))) = IR.TupleOrStructType Nothing (fmap (\(Binding _ t) -> tryFigureOutTypeOf Nothing t) bs) -tryFigureOutTypeOf (Just len) (CombinatorType (ListCombinator t)) = IR.ArrayType len (tryFigureOutTypeOf Nothing t) -tryFigureOutTypeOf Nothing (CombinatorType (ListCombinator t)) = IR.DynamicArrayType (tryFigureOutTypeOf Nothing t) +-- tryFigureOutTypeOf :: Maybe IR.Expr -> Type -> IR.Type +-- tryFigureOutTypeOf _ (TerminalType StringType) = IR.StringType +-- tryFigureOutTypeOf _ (TerminalType IntType) = IR.IntType +-- tryFigureOutTypeOf _ (TerminalType FloatType) = IR.FloatType +-- tryFigureOutTypeOf _ (CombinatorType (NamedCombinator _ t)) = tryFigureOutTypeOf Nothing t +-- tryFigureOutTypeOf _ (CombinatorType (GroupCombinator (BindingList bs))) = IR.TupleOrStructType Nothing (fmap (\(Binding _ t) -> tryFigureOutTypeOf Nothing t) bs) +-- tryFigureOutTypeOf _ (CombinatorType (ArrayCombinator len t)) = IR.ArrayType (IR.ConstInt len) (tryFigureOutTypeOf Nothing t) +-- tryFigureOutTypeOf _ (CombinatorType (SepByCombinator _ (BindingList bs))) = IR.TupleOrStructType Nothing (fmap (\(Binding _ t) -> tryFigureOutTypeOf Nothing t) bs) +-- tryFigureOutTypeOf (Just len) (CombinatorType (ListCombinator t)) = IR.ArrayType len (tryFigureOutTypeOf Nothing t) +-- tryFigureOutTypeOf Nothing (CombinatorType (ListCombinator t)) = IR.DynamicArrayType (tryFigureOutTypeOf Nothing t) -terminalVarToIR :: Ident -> TerminalType -> IRWriter IR.Expr -terminalVarToIR name StringType = do - tell [IR.Assign (identToVarName name) IR.StringType (IR.ReadAtom IR.ReadString)] - pure (IR.Var (identToVarName name)) -terminalVarToIR name IntType = do - tell [IR.Assign (identToVarName name) IR.IntType (IR.ReadAtom IR.ReadInt)] - pure (IR.Var (identToVarName name)) -terminalVarToIR name FloatType = do - tell [IR.Assign (identToVarName name) IR.FloatType (IR.ReadAtom IR.ReadFloat)] - pure (IR.Var (identToVarName name)) +-- terminalVarToIR :: Ident -> TerminalType -> IRWriter IR.Expr +-- terminalVarToIR name StringType = do +-- tell [IR.Assign (identToVarName name) IR.StringType (IR.ReadAtom IR.ReadString)] +-- pure (IR.Var (identToVarName name)) +-- terminalVarToIR name IntType = do +-- tell [IR.Assign (identToVarName name) IR.IntType (IR.ReadAtom IR.ReadInt)] +-- pure (IR.Var (identToVarName name)) +-- terminalVarToIR name FloatType = do +-- tell [IR.Assign (identToVarName name) IR.FloatType (IR.ReadAtom IR.ReadFloat)] +-- pure (IR.Var (identToVarName name)) identToVarName :: Ident -> VarName identToVarName (Ident name) = VarName (name :| []) diff --git a/templatespiler-converter/src/Templatespiler/IR/Imperative.hs b/templatespiler-converter/src/Templatespiler/IR/Imperative.hs index 962f4e5..9163106 100644 --- a/templatespiler-converter/src/Templatespiler/IR/Imperative.hs +++ b/templatespiler-converter/src/Templatespiler/IR/Imperative.hs @@ -10,7 +10,7 @@ -} module Templatespiler.IR.Imperative where -import Templatespiler.IR.Common (SingleLineString) +-- import Templatespiler.IR.Common (SingleLineString) import Prelude hiding (Type) newtype VarName = VarName Text @@ -27,12 +27,13 @@ data Type VarName Type +type Program = [Statement] data Statement = -- | Variable declaration, for statically typed languages or initialization for scope DeclareVar VarName Type | -- | Read one or more variables from stdin, separated by spaces. Having this as a single statement means more idiomatic usage of things like scanf in C. ReadVars - SingleLineString + Text -- ^ Separator string (NonEmpty (VarName, Type)) -- ^ Variable names and types diff --git a/templatespiler-converter/src/Templatespiler/ToLang/Python.hs b/templatespiler-converter/src/Templatespiler/ToLang/Python.hs index d0ee026..340a3ca 100644 --- a/templatespiler-converter/src/Templatespiler/ToLang/Python.hs +++ b/templatespiler-converter/src/Templatespiler/ToLang/Python.hs @@ -46,68 +46,68 @@ data Stmt type Program = [Stmt] toPython :: IR.Program -> (Program, [ToPythonWarning]) -toPython = runToLang . fmap join . traverse statementToPython +toPython = runToLang . fmap join . traverse undefined -statementToPython :: IR.Statement -> PythonWriter [Stmt] -statementToPython (IR.Decl name t) = - pure - [Assign (nameToPyName name) (defaultTypeValue t)] -statementToPython (IR.Assign name _ e) = do - e' <- exprToPython e - pure - [ Assign - (nameToPyName name) - e' - ] -statementToPython (IR.MultiReadAssign sep bindings) = do - let i = Input - let split = Split sep i - let uniqBindingsTypes = ordNub (fmap snd (toList bindings)) - case uniqBindingsTypes of - [] -> error "impossible" - [IR.ReadString] -> - -- if we're only reading strings, we already have all the parts as a list, so we just need to assign - pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) split] - [IR.ReadInt] -> do - let mapped = Map (Var "int") split -- map all inputs to int - pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) mapped] - [IR.ReadFloat] -> do - let mapped = Map (Var "float") split - pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) mapped] - _ -> do - let multi = MultiAssign (fmap (nameToPyName . fst) (toList bindings)) split - let makeCast (name, as) = case as of - IR.ReadString -> Nothing - IR.ReadInt -> Just $ Assign (nameToPyName name) (CastToInt (Var (nameToPyName name))) - IR.ReadFloat -> Just $ Assign (nameToPyName name) (CastToFloat (Var (nameToPyName name))) - let casts = mapMaybe makeCast (toList bindings) - pure (multi : casts) -statementToPython (IR.For v start end body) = do - start' <- exprToPython start - end' <- exprToPython end - body' <- join <$> traverse statementToPython body - pure [For (nameToPyName v) start' end' body'] -statementToPython (IR.AppendToArray arr _ val) = do - val' <- exprToPython val - pure [Append (Var $ nameToPyName arr) val'] -exprToPython :: IR.Expr -> PythonWriter Expr -exprToPython (IR.ConstInt i) = pure (Int i) -exprToPython (IR.Var n) = pure (Var (nameToPyName n)) -exprToPython (IR.ReadAtom IR.ReadString) = pure Input -exprToPython (IR.ReadAtom IR.ReadInt) = pure (CastToInt Input) -exprToPython (IR.ReadAtom IR.ReadFloat) = pure (CastToFloat Input) -exprToPython (IR.TupleOrStruct _ exprs) = do - exprs' <- traverse exprToPython exprs - pure (Tuple (toList exprs')) +-- statementToPython :: IR.Statement -> PythonWriter [Stmt] +-- statementToPython (IR.Decl name t) = +-- pure +-- [Assign (nameToPyName name) (defaultTypeValue t)] +-- statementToPython (IR.Assign name _ e) = do +-- e' <- exprToPython e +-- pure +-- [ Assign +-- (nameToPyName name) +-- e' +-- ] +-- statementToPython (IR.MultiReadAssign sep bindings) = do +-- let i = Input +-- let split = Split sep i +-- let uniqBindingsTypes = ordNub (fmap snd (toList bindings)) +-- case uniqBindingsTypes of +-- [] -> error "impossible" +-- [IR.ReadString] -> +-- -- if we're only reading strings, we already have all the parts as a list, so we just need to assign +-- pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) split] +-- [IR.ReadInt] -> do +-- let mapped = Map (Var "int") split -- map all inputs to int +-- pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) mapped] +-- [IR.ReadFloat] -> do +-- let mapped = Map (Var "float") split +-- pure [MultiAssign (fmap (nameToPyName . fst) (toList bindings)) mapped] +-- _ -> do +-- let multi = MultiAssign (fmap (nameToPyName . fst) (toList bindings)) split +-- let makeCast (name, as) = case as of +-- IR.ReadString -> Nothing +-- IR.ReadInt -> Just $ Assign (nameToPyName name) (CastToInt (Var (nameToPyName name))) +-- IR.ReadFloat -> Just $ Assign (nameToPyName name) (CastToFloat (Var (nameToPyName name))) +-- let casts = mapMaybe makeCast (toList bindings) +-- pure (multi : casts) +-- statementToPython (IR.For v start end body) = do +-- start' <- exprToPython start +-- end' <- exprToPython end +-- body' <- join <$> traverse statementToPython body +-- pure [For (nameToPyName v) start' end' body'] +-- statementToPython (IR.AppendToArray arr _ val) = do +-- val' <- exprToPython val +-- pure [Append (Var $ nameToPyName arr) val'] +-- exprToPython :: IR.Expr -> PythonWriter Expr +-- exprToPython (IR.ConstInt i) = pure (Int i) +-- exprToPython (IR.Var n) = pure (Var (nameToPyName n)) +-- exprToPython (IR.ReadAtom IR.ReadString) = pure Input +-- exprToPython (IR.ReadAtom IR.ReadInt) = pure (CastToInt Input) +-- exprToPython (IR.ReadAtom IR.ReadFloat) = pure (CastToFloat Input) +-- exprToPython (IR.TupleOrStruct _ exprs) = do +-- exprs' <- traverse exprToPython exprs +-- pure (Tuple (toList exprs')) -defaultTypeValue :: IR.VarType -> Expr -defaultTypeValue IR.IntType = Int 0 -defaultTypeValue IR.FloatType = Float 0.0 -defaultTypeValue IR.StringType = String "" -defaultTypeValue (IR.ArrayType _ _) = List [] -defaultTypeValue (IR.DynamicArrayType _) = List [] -defaultTypeValue (IR.TupleOrStructType _ _) = Tuple [] -defaultTypeValue IR.UnknownType = None +-- defaultTypeValue :: IR.VarType -> Expr +-- defaultTypeValue IR.IntType = Int 0 +-- defaultTypeValue IR.FloatType = Float 0.0 +-- defaultTypeValue IR.StringType = String "" +-- defaultTypeValue (IR.ArrayType _ _) = List [] +-- defaultTypeValue (IR.DynamicArrayType _) = List [] +-- defaultTypeValue (IR.TupleOrStructType _ _) = Tuple [] +-- defaultTypeValue IR.UnknownType = None nameToPyName :: VarName -> Text nameToPyName = toCaseStyle SnakeCase diff --git a/templatespiler-server/src/Templatespiler/Server.hs b/templatespiler-server/src/Templatespiler/Server.hs index a03ebe6..cfa7e95 100644 --- a/templatespiler-server/src/Templatespiler/Server.hs +++ b/templatespiler-server/src/Templatespiler/Server.hs @@ -10,6 +10,7 @@ module Templatespiler.Server where import Data.Aeson +import Data.Base64.Types import Data.Text (toLower) import Data.Text.Encoding.Base64 import Data.UUID @@ -33,10 +34,10 @@ data TemplateParseRequest = TemplateParseRequest newtype Base64String = Base64String Text deriving newtype (Eq, Show, ToJSON) unBase64 :: Base64String -> Either Text Text -unBase64 (Base64String t) = decodeBase64 t +unBase64 (Base64String t) = decodeBase64Untyped t toBase64 :: Text -> Base64String -toBase64 = Base64String . encodeBase64 +toBase64 = Base64String . extractBase64 . encodeBase64 instance FromJSON TemplateParseRequest where parseJSON = withObject "TemplateParseRequest" $ \o ->