hydra-0.15.0: src/main/haskell/Hydra/Sources/Go/Serde.hs
-- | Serialization of Go syntax to source code.
--
-- This module provides functions for converting Go AST nodes to source code text,
-- using Hydra's Ast.Expr representation as an intermediate form.
module Hydra.Sources.Go.Serde where
import Hydra.Constants
import Hydra.Kernel
import Hydra.Serialization
import qualified Hydra.Ast as Ast
import qualified Hydra.Go.Syntax as Go
import qualified Data.List as L
import qualified Data.Maybe as Y
import qualified Data.Char as C
import Data.Char (ord, toUpper)
import Numeric (showHex)
-- ============================================================================
-- Source File Structure
-- ============================================================================
writeSourceFile :: Go.SourceFile -> Ast.Expr
writeSourceFile (Go.SourceFile pkg imports decls) = doubleNewlineSep $ Y.catMaybes [
Just $ singleLineComment warningAutoGeneratedFile,
Just $ writePackageClause pkg,
if L.null imports then Nothing else Just $ newlineSep (writeImportDecl <$> imports),
if L.null decls then Nothing else Just $ doubleNewlineSep (writeTopLevelDecl <$> decls)]
writeModule :: Go.Module -> Ast.Expr
writeModule (Go.Module pkg imports decls) = doubleNewlineSep $ Y.catMaybes [
Just $ singleLineComment warningAutoGeneratedFile,
Just $ writePackageClause pkg,
if L.null imports then Nothing else Just $ newlineSep (writeImportDecl <$> imports),
if L.null decls then Nothing else Just $ doubleNewlineSep (writeTopLevelDecl <$> decls)]
writePackageClause :: Go.PackageClause -> Ast.Expr
writePackageClause (Go.PackageClause ident) = spaceSep [cst "package", writeIdentifier ident]
writeImportDecl :: Go.ImportDecl -> Ast.Expr
writeImportDecl (Go.ImportDecl specs) = case specs of
[spec] -> spaceSep [cst "import", writeImportSpec spec]
_ -> spaceSep [cst "import", parenList True (writeImportSpec <$> specs)]
writeImportSpec :: Go.ImportSpec -> Ast.Expr
writeImportSpec (Go.ImportSpec malias path) = case malias of
Nothing -> writeImportPath path
Just alias -> spaceSep [writeImportAlias alias, writeImportPath path]
writeImportAlias :: Go.ImportAlias -> Ast.Expr
writeImportAlias alias = case alias of
Go.ImportAliasDot -> cst "."
Go.ImportAliasName ident -> writeIdentifier ident
writeImportPath :: Go.ImportPath -> Ast.Expr
writeImportPath (Go.ImportPath lit) = writeStringLit lit
-- ============================================================================
-- Declarations
-- ============================================================================
writeTopLevelDecl :: Go.TopLevelDecl -> Ast.Expr
writeTopLevelDecl decl = case decl of
Go.TopLevelDeclDeclaration d -> writeDeclaration d
Go.TopLevelDeclFunction f -> writeFunctionDecl f
Go.TopLevelDeclMethod m -> writeMethodDecl m
writeDeclaration :: Go.Declaration -> Ast.Expr
writeDeclaration decl = case decl of
Go.DeclarationConst c -> writeConstDecl c
Go.DeclarationType t -> writeTypeDecl t
Go.DeclarationVar v -> writeVarDecl v
writeConstDecl :: Go.ConstDecl -> Ast.Expr
writeConstDecl (Go.ConstDecl specs) = case specs of
[spec] -> spaceSep [cst "const", writeConstSpec spec]
_ -> spaceSep [cst "const", parenList True (writeConstSpec <$> specs)]
writeConstSpec :: Go.ConstSpec -> Ast.Expr
writeConstSpec (Go.ConstSpec names mtyp values) = spaceSep $ Y.catMaybes [
Just $ commaSep inlineStyle (writeIdentifier <$> names),
writeType <$> mtyp,
if L.null values then Nothing else Just $ spaceSep [cst "=", commaSep inlineStyle (writeExpression <$> values)]]
writeVarDecl :: Go.VarDecl -> Ast.Expr
writeVarDecl (Go.VarDecl specs) = case specs of
[spec] -> spaceSep [cst "var", writeVarSpec spec]
_ -> spaceSep [cst "var", parenList True (writeVarSpec <$> specs)]
writeVarSpec :: Go.VarSpec -> Ast.Expr
writeVarSpec (Go.VarSpec names mtyp values) = spaceSep $ Y.catMaybes [
Just $ commaSep inlineStyle (writeIdentifier <$> names),
writeType <$> mtyp,
if L.null values then Nothing else Just $ spaceSep [cst "=", commaSep inlineStyle (writeExpression <$> values)]]
writeShortVarDecl :: Go.ShortVarDecl -> Ast.Expr
writeShortVarDecl (Go.ShortVarDecl names values) = spaceSep [
commaSep inlineStyle (writeIdentifier <$> names),
cst ":=",
commaSep inlineStyle (writeExpression <$> values)]
writeTypeDecl :: Go.TypeDecl -> Ast.Expr
writeTypeDecl (Go.TypeDecl specs) = case specs of
[spec] -> spaceSep [cst "type", writeTypeSpec spec]
_ -> spaceSep [cst "type", parenList True (writeTypeSpec <$> specs)]
writeTypeSpec :: Go.TypeSpec -> Ast.Expr
writeTypeSpec spec = case spec of
Go.TypeSpecAlias a -> writeAliasDecl a
Go.TypeSpecDefinition d -> writeTypeDef d
writeAliasDecl :: Go.AliasDecl -> Ast.Expr
writeAliasDecl (Go.AliasDecl name typ) = spaceSep [writeIdentifier name, cst "=", writeType typ]
writeTypeDef :: Go.TypeDef -> Ast.Expr
writeTypeDef (Go.TypeDef name mtparams typ) = spaceSep $ Y.catMaybes [
Just $ writeIdentifier name,
writeTypeParameters <$> mtparams,
Just $ writeType typ]
writeTypeParameters :: Go.TypeParameters -> Ast.Expr
writeTypeParameters (Go.TypeParameters decls) = brackets squareBrackets inlineStyle $
commaSep inlineStyle (writeTypeParamDecl <$> decls)
writeTypeParamDecl :: Go.TypeParamDecl -> Ast.Expr
writeTypeParamDecl (Go.TypeParamDecl names constraint) = spaceSep [
commaSep inlineStyle (writeIdentifier <$> names),
writeTypeConstraint constraint]
writeTypeConstraint :: Go.TypeConstraint -> Ast.Expr
writeTypeConstraint (Go.TypeConstraint elem) = writeTypeElem elem
writeFunctionDecl :: Go.FunctionDecl -> Ast.Expr
writeFunctionDecl (Go.FunctionDecl name mtparams sig mbody) = spaceSep $ Y.catMaybes [
Just $ cst "func",
Just $ noSep $ Y.catMaybes [
Just $ writeIdentifier name,
writeTypeParameters <$> mtparams],
Just $ writeSignature sig,
writeFunctionBody <$> mbody]
writeFunctionBody :: Go.FunctionBody -> Ast.Expr
writeFunctionBody (Go.FunctionBody block) = writeBlock block
writeMethodDecl :: Go.MethodDecl -> Ast.Expr
writeMethodDecl (Go.MethodDecl recv name sig mbody) = spaceSep $ Y.catMaybes [
Just $ cst "func",
Just $ writeReceiver recv,
Just $ noSep [writeIdentifier name, writeSignature sig],
writeFunctionBody <$> mbody]
writeReceiver :: Go.Receiver -> Ast.Expr
writeReceiver (Go.Receiver mname typ) = parenList False $ case mname of
Nothing -> [writeType typ]
Just name -> [spaceSep [writeIdentifier name, writeType typ]]
-- ============================================================================
-- Types
-- ============================================================================
writeType :: Go.Type -> Ast.Expr
writeType typ = case typ of
Go.TypeName_ tn -> writeTypeName tn
Go.TypeLiteral lit -> writeTypeLit lit
Go.TypeParen t -> parens (writeType t)
writeTypeName :: Go.TypeName -> Ast.Expr
writeTypeName (Go.TypeName qid targs) = noSep $ Y.catMaybes [
Just $ writeQualifiedIdent qid,
if L.null targs then Nothing else Just $ brackets squareBrackets inlineStyle $
commaSep inlineStyle (writeType <$> targs)]
writeQualifiedIdent :: Go.QualifiedIdent -> Ast.Expr
writeQualifiedIdent (Go.QualifiedIdent mpkg name) = case mpkg of
Nothing -> writeIdentifier name
Just pkg -> dotSep [writeIdentifier pkg, writeIdentifier name]
writeTypeLit :: Go.TypeLit -> Ast.Expr
writeTypeLit lit = case lit of
Go.TypeLitArray a -> writeArrayType a
Go.TypeLitStruct s -> writeStructType s
Go.TypeLitPointer p -> writePointerType p
Go.TypeLitFunction f -> writeFunctionType f
Go.TypeLitInterface i -> writeInterfaceType i
Go.TypeLitSlice s -> writeSliceType s
Go.TypeLitMap m -> writeMapType m
Go.TypeLitChannel c -> writeChannelType c
writeArrayType :: Go.ArrayType -> Ast.Expr
writeArrayType (Go.ArrayType len elem) = noSep [
brackets squareBrackets inlineStyle (writeExpression len),
writeType elem]
writeSliceType :: Go.SliceType -> Ast.Expr
writeSliceType (Go.SliceType elem) = noSep [cst "[]", writeType elem]
writeStructType :: Go.StructType -> Ast.Expr
writeStructType (Go.StructType fields) = if L.null fields
then cst "struct{}"
else spaceSep [cst "struct", curlyBlock fullBlockStyle $ newlineSep (writeFieldDecl <$> fields)]
writeFieldDecl :: Go.FieldDecl -> Ast.Expr
writeFieldDecl field = case field of
Go.FieldDeclNamed nf -> writeNamedField nf
Go.FieldDeclEmbedded ef -> writeEmbeddedField ef
writeNamedField :: Go.NamedField -> Ast.Expr
writeNamedField (Go.NamedField names typ mtag) = spaceSep $ Y.catMaybes [
Just $ commaSep inlineStyle (writeIdentifier <$> names),
Just $ writeType typ,
writeTag <$> mtag]
writeEmbeddedField :: Go.EmbeddedField -> Ast.Expr
writeEmbeddedField (Go.EmbeddedField isPtr typName mtag) = spaceSep $ Y.catMaybes [
Just $ noSep $ Y.catMaybes [
if isPtr then Just (cst "*") else Nothing,
Just $ writeTypeName typName],
writeTag <$> mtag]
writeTag :: Go.Tag -> Ast.Expr
writeTag (Go.Tag lit) = writeStringLit lit
writePointerType :: Go.PointerType -> Ast.Expr
writePointerType (Go.PointerType typ) = noSep [cst "*", writeType typ]
writeFunctionType :: Go.FunctionType -> Ast.Expr
writeFunctionType (Go.FunctionType sig) = noSep [cst "func", writeSignature sig]
writeSignature :: Go.Signature -> Ast.Expr
writeSignature (Go.Signature params mresult) = noSep $ Y.catMaybes [
Just $ writeParameters params,
writeResult <$> mresult]
writeResult :: Go.Result -> Ast.Expr
writeResult result = case result of
Go.ResultParameters p -> spaceSep [cst "", writeParameters p]
Go.ResultType t -> spaceSep [cst "", writeType t]
writeParameters :: Go.Parameters -> Ast.Expr
writeParameters (Go.Parameters decls) = parenList False (writeParameterDecl <$> decls)
writeParameterDecl :: Go.ParameterDecl -> Ast.Expr
writeParameterDecl (Go.ParameterDecl names variadic typ) = spaceSep $ Y.catMaybes [
if L.null names then Nothing else Just $ commaSep inlineStyle (writeIdentifier <$> names),
Just $ noSep $ Y.catMaybes [
if variadic then Just (cst "...") else Nothing,
Just $ writeType typ]]
writeInterfaceType :: Go.InterfaceType -> Ast.Expr
writeInterfaceType (Go.InterfaceType elems) = if L.null elems
then cst "interface{}"
else spaceSep [cst "interface", curlyBlock fullBlockStyle $ newlineSep (writeInterfaceElem <$> elems)]
writeInterfaceElem :: Go.InterfaceElem -> Ast.Expr
writeInterfaceElem elem = case elem of
Go.InterfaceElemMethod m -> writeMethodElem m
Go.InterfaceElemType t -> writeTypeElem t
writeMethodElem :: Go.MethodElem -> Ast.Expr
writeMethodElem (Go.MethodElem name sig) = noSep [writeIdentifier name, writeSignature sig]
writeTypeElem :: Go.TypeElem -> Ast.Expr
writeTypeElem (Go.TypeElem terms) = sep (orOp False) (writeTypeTerm <$> terms)
writeTypeTerm :: Go.TypeTerm -> Ast.Expr
writeTypeTerm (Go.TypeTerm underlying typ) = noSep $ Y.catMaybes [
if underlying then Just (cst "~") else Nothing,
Just $ writeType typ]
writeMapType :: Go.MapType -> Ast.Expr
writeMapType (Go.MapType key val) = noSep [
cst "map",
brackets squareBrackets inlineStyle (writeType key),
writeType val]
writeChannelType :: Go.ChannelType -> Ast.Expr
writeChannelType (Go.ChannelType dir elem) = spaceSep [writeChannelDirection dir, writeType elem]
writeChannelDirection :: Go.ChannelDirection -> Ast.Expr
writeChannelDirection dir = case dir of
Go.ChannelDirectionBidirectional -> cst "chan"
Go.ChannelDirectionSend -> cst "chan<-"
Go.ChannelDirectionReceive -> cst "<-chan"
-- ============================================================================
-- Expressions
-- ============================================================================
writeExpression :: Go.Expression -> Ast.Expr
writeExpression expr = case expr of
Go.ExpressionUnary u -> writeUnaryExpr u
Go.ExpressionBinary b -> writeBinaryExpr b
writeUnaryExpr :: Go.UnaryExpr -> Ast.Expr
writeUnaryExpr expr = case expr of
Go.UnaryExprPrimary p -> writePrimaryExpr p
Go.UnaryExprOp op -> writeUnaryOperation op
writeUnaryOperation :: Go.UnaryOperation -> Ast.Expr
writeUnaryOperation (Go.UnaryOperation op operand) = noSep [writeUnaryOp op, writeUnaryExpr operand]
writeBinaryExpr :: Go.BinaryExpr -> Ast.Expr
writeBinaryExpr (Go.BinaryExpr left op right) = spaceSep [
writeExpression left,
writeBinaryOp op,
writeExpression right]
writeBinaryOp :: Go.BinaryOp -> Ast.Expr
writeBinaryOp op = cst $ case op of
Go.BinaryOpOr -> "||"
Go.BinaryOpAnd -> "&&"
Go.BinaryOpEqual -> "=="
Go.BinaryOpNotEqual -> "!="
Go.BinaryOpLess -> "<"
Go.BinaryOpLessEqual -> "<="
Go.BinaryOpGreater -> ">"
Go.BinaryOpGreaterEqual -> ">="
Go.BinaryOpAdd -> "+"
Go.BinaryOpSubtract -> "-"
Go.BinaryOpBitwiseOr -> "|"
Go.BinaryOpBitwiseXor -> "^"
Go.BinaryOpMultiply -> "*"
Go.BinaryOpDivide -> "/"
Go.BinaryOpRemainder -> "%"
Go.BinaryOpLeftShift -> "<<"
Go.BinaryOpRightShift -> ">>"
Go.BinaryOpBitwiseAnd -> "&"
Go.BinaryOpBitClear -> "&^"
writePrimaryExpr :: Go.PrimaryExpr -> Ast.Expr
writePrimaryExpr expr = case expr of
Go.PrimaryExprOperand o -> writeOperand o
Go.PrimaryExprConversion c -> writeConversion c
Go.PrimaryExprMethodExpr m -> writeMethodExpr m
Go.PrimaryExprSelector s -> writeSelectorExpr s
Go.PrimaryExprIndex i -> writeIndexExpr i
Go.PrimaryExprSlice s -> writeSliceExpr s
Go.PrimaryExprTypeAssertion t -> writeTypeAssertionExpr t
Go.PrimaryExprCall c -> writeCallExpr c
writeSelectorExpr :: Go.SelectorExpr -> Ast.Expr
writeSelectorExpr (Go.SelectorExpr expr sel) = dotSep [writePrimaryExpr expr, writeIdentifier sel]
writeIndexExpr :: Go.IndexExpr -> Ast.Expr
writeIndexExpr (Go.IndexExpr expr idx) = noSep [
writePrimaryExpr expr,
brackets squareBrackets inlineStyle (writeExpression idx)]
writeSliceExpr :: Go.SliceExpr -> Ast.Expr
writeSliceExpr (Go.SliceExpr expr slice) = noSep [writePrimaryExpr expr, writeSlice slice]
writeTypeAssertionExpr :: Go.TypeAssertionExpr -> Ast.Expr
writeTypeAssertionExpr (Go.TypeAssertionExpr expr typ) = noSep [
writePrimaryExpr expr,
cst ".",
parenList False [writeType typ]]
writeCallExpr :: Go.CallExpr -> Ast.Expr
writeCallExpr (Go.CallExpr func args) = noSep [writePrimaryExpr func, writeArguments args]
writeOperand :: Go.Operand -> Ast.Expr
writeOperand op = case op of
Go.OperandLiteral l -> writeLiteral l
Go.OperandName_ n -> writeOperandName n
Go.OperandParen e -> parens (writeExpression e)
writeOperandName :: Go.OperandName -> Ast.Expr
writeOperandName (Go.OperandName qid targs) = noSep $ Y.catMaybes [
Just $ writeQualifiedIdent qid,
if L.null targs then Nothing else Just $ brackets squareBrackets inlineStyle $
commaSep inlineStyle (writeType <$> targs)]
writeLiteral :: Go.Literal -> Ast.Expr
writeLiteral lit = case lit of
Go.LiteralBasic b -> writeBasicLit b
Go.LiteralComposite c -> writeCompositeLit c
Go.LiteralFunction f -> writeFunctionLit f
writeBasicLit :: Go.BasicLit -> Ast.Expr
writeBasicLit lit = case lit of
Go.BasicLitInt i -> writeIntLit i
Go.BasicLitFloat f -> writeFloatLit f
Go.BasicLitImaginary i -> writeImaginaryLit i
Go.BasicLitRune r -> writeRuneLit r
Go.BasicLitString s -> writeStringLit s
writeCompositeLit :: Go.CompositeLit -> Ast.Expr
writeCompositeLit (Go.CompositeLit typ val) = noSep [writeLiteralType typ, writeLiteralValue val]
writeLiteralType :: Go.LiteralType -> Ast.Expr
writeLiteralType typ = case typ of
Go.LiteralTypeStruct s -> writeStructType s
Go.LiteralTypeArray a -> writeArrayType a
Go.LiteralTypeInferredArray t -> noSep [cst "[...]", writeType t]
Go.LiteralTypeSlice s -> writeSliceType s
Go.LiteralTypeMap m -> writeMapType m
Go.LiteralTypeName n -> writeTypeName n
writeLiteralValue :: Go.LiteralValue -> Ast.Expr
writeLiteralValue (Go.LiteralValue elems) = if L.null elems
then cst "{}"
else curlyBracesList Nothing inlineStyle (writeKeyedElement <$> elems)
writeKeyedElement :: Go.KeyedElement -> Ast.Expr
writeKeyedElement (Go.KeyedElement mkey elem) = case mkey of
Nothing -> writeElement elem
Just key -> spaceSep [noSep [writeKey key, cst ":"], writeElement elem]
writeKey :: Go.Key -> Ast.Expr
writeKey key = case key of
Go.KeyField ident -> writeIdentifier ident
Go.KeyExpression e -> writeExpression e
Go.KeyLiteral lv -> writeLiteralValue lv
writeElement :: Go.Element -> Ast.Expr
writeElement elem = case elem of
Go.ElementExpression e -> writeExpression e
Go.ElementLiteral lv -> writeLiteralValue lv
writeFunctionLit :: Go.FunctionLit -> Ast.Expr
writeFunctionLit (Go.FunctionLit sig body) = spaceSep [
cst "func",
writeSignature sig,
writeFunctionBody body]
writeSelector :: Go.Selector -> Ast.Expr
writeSelector (Go.Selector ident) = noSep [cst ".", writeIdentifier ident]
writeIndex :: Go.Index -> Ast.Expr
writeIndex (Go.Index exprs) = brackets squareBrackets inlineStyle $ commaSep inlineStyle (writeExpression <$> exprs)
writeSlice :: Go.Slice -> Ast.Expr
writeSlice slice = case slice of
Go.SliceSimple s -> writeSimpleSlice s
Go.SliceFull f -> writeFullSlice f
writeSimpleSlice :: Go.SimpleSlice -> Ast.Expr
writeSimpleSlice (Go.SimpleSlice mlo mhi) = brackets squareBrackets inlineStyle $ noSep [
Y.maybe (cst "") writeExpression mlo,
cst ":",
Y.maybe (cst "") writeExpression mhi]
writeFullSlice :: Go.FullSlice -> Ast.Expr
writeFullSlice (Go.FullSlice mlo hi maxv) = brackets squareBrackets inlineStyle $ noSep [
Y.maybe (cst "") writeExpression mlo,
cst ":",
writeExpression hi,
cst ":",
writeExpression maxv]
writeTypeAssertion :: Go.TypeAssertion -> Ast.Expr
writeTypeAssertion (Go.TypeAssertion typ) = noSep [cst ".", parenList False [writeType typ]]
writeArguments :: Go.Arguments -> Ast.Expr
writeArguments (Go.Arguments mtypeArg exprs ellipsis) = parenList False $ Y.catMaybes $
[writeType <$> mtypeArg] ++ (fmap Just (writeExpression <$> exprs)) ++ [if ellipsis then Just (cst "...") else Nothing]
writeMethodExpr :: Go.MethodExpr -> Ast.Expr
writeMethodExpr (Go.MethodExpr recv method) = dotSep [writeType recv, writeIdentifier method]
writeConversion :: Go.Conversion -> Ast.Expr
writeConversion (Go.Conversion typ expr) = noSep [writeType typ, parenList False [writeExpression expr]]
-- ============================================================================
-- Statements
-- ============================================================================
writeStatement :: Go.Statement -> Ast.Expr
writeStatement stmt = case stmt of
Go.StatementDeclaration d -> writeDeclaration d
Go.StatementLabeled l -> writeLabeledStmt l
Go.StatementSimple s -> writeSimpleStmt s
Go.StatementGo g -> writeGoStmt g
Go.StatementReturn r -> writeReturnStmt r
Go.StatementBreak b -> writeBreakStmt b
Go.StatementContinue c -> writeContinueStmt c
Go.StatementGoto g -> writeGotoStmt g
Go.StatementFallthrough f -> writeFallthroughStmt f
Go.StatementBlock b -> writeBlock b
Go.StatementIf i -> writeIfStmt i
Go.StatementSwitch s -> writeSwitchStmt s
Go.StatementSelect s -> writeSelectStmt s
Go.StatementFor f -> writeForStmt f
Go.StatementDefer d -> writeDeferStmt d
writeSimpleStmt :: Go.SimpleStmt -> Ast.Expr
writeSimpleStmt stmt = case stmt of
Go.SimpleStmtEmpty e -> writeEmptyStmt e
Go.SimpleStmtExpression e -> writeExpressionStmt e
Go.SimpleStmtSend s -> writeSendStmt s
Go.SimpleStmtIncDec i -> writeIncDecStmt i
Go.SimpleStmtAssignment a -> writeAssignment a
Go.SimpleStmtShortVarDecl s -> writeShortVarDecl s
writeEmptyStmt :: Go.EmptyStmt -> Ast.Expr
writeEmptyStmt (Go.EmptyStmt ()) = cst ""
writeLabeledStmt :: Go.LabeledStmt -> Ast.Expr
writeLabeledStmt (Go.LabeledStmt label stmt) = newlineSep [
noSep [writeIdentifier label, cst ":"],
writeStatement stmt]
writeExpressionStmt :: Go.ExpressionStmt -> Ast.Expr
writeExpressionStmt (Go.ExpressionStmt expr) = writeExpression expr
writeSendStmt :: Go.SendStmt -> Ast.Expr
writeSendStmt (Go.SendStmt ch val) = spaceSep [writeExpression ch, cst "<-", writeExpression val]
writeIncDecStmt :: Go.IncDecStmt -> Ast.Expr
writeIncDecStmt (Go.IncDecStmt expr isInc) = noSep [
writeExpression expr,
cst $ if isInc then "++" else "--"]
writeAssignment :: Go.Assignment -> Ast.Expr
writeAssignment (Go.Assignment lhs op rhs) = spaceSep [
commaSep inlineStyle (writeExpression <$> lhs),
writeAssignOp op,
commaSep inlineStyle (writeExpression <$> rhs)]
writeAssignOp :: Go.AssignOp -> Ast.Expr
writeAssignOp op = case op of
Go.AssignOpSimple -> cst "="
Go.AssignOpAdd addOp -> noSep [writeAddOp addOp, cst "="]
Go.AssignOpMul mulOp -> noSep [writeMulOp mulOp, cst "="]
writeIfStmt :: Go.IfStmt -> Ast.Expr
writeIfStmt (Go.IfStmt minit cond thenBlock melseClause) = spaceSep $ Y.catMaybes [
Just $ cst "if",
(\s -> noSep [writeSimpleStmt s, cst ";"]) <$> minit,
Just $ writeExpression cond,
Just $ writeBlock thenBlock,
writeElseClause <$> melseClause]
writeElseClause :: Go.ElseClause -> Ast.Expr
writeElseClause clause = case clause of
Go.ElseClauseIf ifStmt -> spaceSep [cst "else", writeIfStmt ifStmt]
Go.ElseClauseBlock block -> spaceSep [cst "else", writeBlock block]
writeSwitchStmt :: Go.SwitchStmt -> Ast.Expr
writeSwitchStmt stmt = case stmt of
Go.SwitchStmtExpression e -> writeExprSwitchStmt e
Go.SwitchStmtType t -> writeTypeSwitchStmt t
writeExprSwitchStmt :: Go.ExprSwitchStmt -> Ast.Expr
writeExprSwitchStmt (Go.ExprSwitchStmt minit mexpr cases) = spaceSep $ Y.catMaybes [
Just $ cst "switch",
(\s -> noSep [writeSimpleStmt s, cst ";"]) <$> minit,
writeExpression <$> mexpr,
Just $ curlyBlock fullBlockStyle $ newlineSep (writeExprCaseClause <$> cases)]
writeExprCaseClause :: Go.ExprCaseClause -> Ast.Expr
writeExprCaseClause (Go.ExprCaseClause mexprs stmts) = newlineSep [
case mexprs of
Nothing -> cst "default:"
Just exprs -> noSep [cst "case ", commaSep inlineStyle (writeExpression <$> exprs), cst ":"],
indentBlock (writeStatement <$> stmts)]
writeTypeSwitchStmt :: Go.TypeSwitchStmt -> Ast.Expr
writeTypeSwitchStmt (Go.TypeSwitchStmt minit guard cases) = spaceSep $ Y.catMaybes [
Just $ cst "switch",
(\s -> noSep [writeSimpleStmt s, cst ";"]) <$> minit,
Just $ writeTypeSwitchGuard guard,
Just $ curlyBlock fullBlockStyle $ newlineSep (writeTypeCaseClause <$> cases)]
writeTypeSwitchGuard :: Go.TypeSwitchGuard -> Ast.Expr
writeTypeSwitchGuard (Go.TypeSwitchGuard mname expr) = case mname of
Nothing -> noSep [writePrimaryExpr expr, cst ".(type)"]
Just name -> spaceSep [writeIdentifier name, cst ":=", noSep [writePrimaryExpr expr, cst ".(type)"]]
writeTypeCaseClause :: Go.TypeCaseClause -> Ast.Expr
writeTypeCaseClause (Go.TypeCaseClause mtypes stmts) = newlineSep [
case mtypes of
Nothing -> cst "default:"
Just types -> noSep [cst "case ", commaSep inlineStyle (writeType <$> types), cst ":"],
indentBlock (writeStatement <$> stmts)]
writeForStmt :: Go.ForStmt -> Ast.Expr
writeForStmt (Go.ForStmt mclause body) = spaceSep $ Y.catMaybes [
Just $ cst "for",
writeForClauseOrRange <$> mclause,
Just $ writeBlock body]
writeForClauseOrRange :: Go.ForClauseOrRange -> Ast.Expr
writeForClauseOrRange clause = case clause of
Go.ForClauseOrRangeCondition e -> writeExpression e
Go.ForClauseOrRangeClause c -> writeForClause c
Go.ForClauseOrRangeRange r -> writeRangeClause r
writeForClause :: Go.ForClause -> Ast.Expr
writeForClause (Go.ForClause minit mcond mpost) = noSep [
Y.maybe (cst "") writeSimpleStmt minit,
cst ";",
Y.maybe (cst "") (\e -> spaceSep [cst "", writeExpression e]) mcond,
cst ";",
Y.maybe (cst "") (\s -> spaceSep [cst "", writeSimpleStmt s]) mpost]
writeRangeClause :: Go.RangeClause -> Ast.Expr
writeRangeClause (Go.RangeClause mvars expr) = spaceSep $ Y.catMaybes [
writeRangeVars <$> mvars,
Just $ cst "range",
Just $ writeExpression expr]
writeRangeVars :: Go.RangeVars -> Ast.Expr
writeRangeVars vars = case vars of
Go.RangeVarsAssign exprs -> spaceSep [commaSep inlineStyle (writeExpression <$> exprs), cst "="]
Go.RangeVarsDeclare idents -> spaceSep [commaSep inlineStyle (writeIdentifier <$> idents), cst ":="]
writeGoStmt :: Go.GoStmt -> Ast.Expr
writeGoStmt (Go.GoStmt expr) = spaceSep [cst "go", writeExpression expr]
writeSelectStmt :: Go.SelectStmt -> Ast.Expr
writeSelectStmt (Go.SelectStmt clauses) = spaceSep [
cst "select",
curlyBlock fullBlockStyle $ newlineSep (writeCommClause <$> clauses)]
writeCommClause :: Go.CommClause -> Ast.Expr
writeCommClause (Go.CommClause commCase stmts) = newlineSep [
writeCommCase commCase,
indentBlock (writeStatement <$> stmts)]
writeCommCase :: Go.CommCase -> Ast.Expr
writeCommCase commCase = case commCase of
Go.CommCaseSend s -> noSep [cst "case ", writeSendStmt s, cst ":"]
Go.CommCaseReceive r -> noSep [cst "case ", writeReceiveCase r, cst ":"]
Go.CommCaseDefault -> cst "default:"
writeReceiveCase :: Go.ReceiveCase -> Ast.Expr
writeReceiveCase (Go.ReceiveCase mvars expr) = spaceSep $ Y.catMaybes [
writeRangeVars <$> mvars,
Just $ noSep [cst "<-", writeExpression expr]]
writeReturnStmt :: Go.ReturnStmt -> Ast.Expr
writeReturnStmt (Go.ReturnStmt exprs) = if L.null exprs
then cst "return"
else spaceSep [cst "return", commaSep inlineStyle (writeExpression <$> exprs)]
writeBreakStmt :: Go.BreakStmt -> Ast.Expr
writeBreakStmt (Go.BreakStmt mlabel) = case mlabel of
Nothing -> cst "break"
Just label -> spaceSep [cst "break", writeIdentifier label]
writeContinueStmt :: Go.ContinueStmt -> Ast.Expr
writeContinueStmt (Go.ContinueStmt mlabel) = case mlabel of
Nothing -> cst "continue"
Just label -> spaceSep [cst "continue", writeIdentifier label]
writeGotoStmt :: Go.GotoStmt -> Ast.Expr
writeGotoStmt (Go.GotoStmt label) = spaceSep [cst "goto", writeIdentifier label]
writeFallthroughStmt :: Go.FallthroughStmt -> Ast.Expr
writeFallthroughStmt (Go.FallthroughStmt ()) = cst "fallthrough"
writeDeferStmt :: Go.DeferStmt -> Ast.Expr
writeDeferStmt (Go.DeferStmt expr) = spaceSep [cst "defer", writeExpression expr]
writeBlock :: Go.Block -> Ast.Expr
writeBlock (Go.Block stmts) = curlyBlock fullBlockStyle $ newlineSep (writeStatement <$> stmts)
-- ============================================================================
-- Operators
-- ============================================================================
writeUnaryOp :: Go.UnaryOp -> Ast.Expr
writeUnaryOp op = cst $ case op of
Go.UnaryOpPlus -> "+"
Go.UnaryOpMinus -> "-"
Go.UnaryOpNot -> "!"
Go.UnaryOpXor -> "^"
Go.UnaryOpDeref -> "*"
Go.UnaryOpAddressOf -> "&"
Go.UnaryOpReceive -> "<-"
writeMulOp :: Go.MulOp -> Ast.Expr
writeMulOp op = cst $ case op of
Go.MulOpMultiply -> "*"
Go.MulOpDivide -> "/"
Go.MulOpRemainder -> "%"
Go.MulOpLeftShift -> "<<"
Go.MulOpRightShift -> ">>"
Go.MulOpBitwiseAnd -> "&"
Go.MulOpBitClear -> "&^"
writeAddOp :: Go.AddOp -> Ast.Expr
writeAddOp op = cst $ case op of
Go.AddOpAdd -> "+"
Go.AddOpSubtract -> "-"
Go.AddOpBitwiseOr -> "|"
Go.AddOpBitwiseXor -> "^"
writeRelOp :: Go.RelOp -> Ast.Expr
writeRelOp op = cst $ case op of
Go.RelOpEqual -> "=="
Go.RelOpNotEqual -> "!="
Go.RelOpLess -> "<"
Go.RelOpLessEqual -> "<="
Go.RelOpGreater -> ">"
Go.RelOpGreaterEqual -> ">="
-- ============================================================================
-- Terminal Tokens
-- ============================================================================
writeIdentifier :: Go.Identifier -> Ast.Expr
writeIdentifier (Go.Identifier s) = cst s
writeIntLit :: Go.IntLit -> Ast.Expr
writeIntLit (Go.IntLit n) = cst $ show n
writeFloatLit :: Go.FloatLit -> Ast.Expr
writeFloatLit (Go.FloatLit d) = cst $ show d
writeImaginaryLit :: Go.ImaginaryLit -> Ast.Expr
writeImaginaryLit (Go.ImaginaryLit d) = cst $ show d ++ "i"
writeRuneLit :: Go.RuneLit -> Ast.Expr
writeRuneLit (Go.RuneLit c) = cst $ "'" ++ escapeRune (C.chr $ fromIntegral c) ++ "'"
where
escapeRune ch = case ch of
'\'' -> "\\'"
'\\' -> "\\\\"
'\n' -> "\\n"
'\r' -> "\\r"
'\t' -> "\\t"
_ -> if ord ch >= 32 && ord ch < 127
then [ch]
else if ord ch > 0xFFFF
then -- Supplementary plane: use UTF-16 surrogate pair
let n = ord ch - 0x10000
hi = 0xD800 + (n `div` 0x400)
lo = 0xDC00 + (n `mod` 0x400)
padH x = let h = fmap C.toUpper $ showHex x "" in
replicate (4 - L.length h) '0' ++ h
in "\\u" ++ padH hi ++ "\\u" ++ padH lo
else "\\u" ++ L.take (4 - L.length hex) "0000" ++ hex
where hex = showHex (ord ch) ""
writeStringLit :: Go.StringLit -> Ast.Expr
writeStringLit lit = case lit of
Go.StringLitRaw r -> writeRawStringLit r
Go.StringLitInterpreted i -> writeInterpretedStringLit i
writeRawStringLit :: Go.RawStringLit -> Ast.Expr
writeRawStringLit (Go.RawStringLit s) = cst $ "`" ++ s ++ "`"
writeInterpretedStringLit :: Go.InterpretedStringLit -> Ast.Expr
writeInterpretedStringLit (Go.InterpretedStringLit s) = cst $ "\"" ++ escapeGoString s ++ "\""
where
escapeGoString = concatMap escapeChar
escapeChar c = case c of
'"' -> "\\\""
'\\' -> "\\\\"
'\n' -> "\\n"
'\r' -> "\\r"
'\t' -> "\\t"
_ | c < ' ' || c > '~' -> goUnicodeEscape (ord c)
| otherwise -> [c]
goUnicodeEscape n
| n > 0xFFFF = -- Supplementary plane: use UTF-16 surrogate pair
let n' = n - 0x10000
hi = 0xD800 + (n' `div` 0x400)
lo = 0xDC00 + (n' `mod` 0x400)
in "\\u" ++ padHex hi ++ "\\u" ++ padHex lo
| otherwise = "\\u" ++ padHex n
padHex n = replicate (4 - length hex) '0' ++ hex
where hex = fmap toUpper $ showHex n ""
-- ============================================================================
-- Hydra-specific constructs
-- ============================================================================
writeAnnotatedDeclaration :: Go.AnnotatedDeclaration -> Ast.Expr
writeAnnotatedDeclaration (Go.AnnotatedDeclaration comment decl) = newlineSep [
writeComment comment,
writeTopLevelDecl decl]
writeComment :: String -> Ast.Expr
writeComment s = if L.null (lines s)
then cst ""
else newlineSep (singleLineComment <$> lines s)
-- ============================================================================
-- Helpers
-- ============================================================================
singleLineComment :: String -> Ast.Expr
singleLineComment c = cst $ "// " ++ sanitizeGoComment c
sanitizeGoComment :: String -> String
sanitizeGoComment = id -- Go comments don't need special escaping like HTML