packages feed

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