packages feed

hydra-0.1.0: src/main/haskell/Hydra/Ext/Scala/Serde.hs

module Hydra.Ext.Scala.Serde where

import Hydra.Util.Codetree.Ast
import Hydra.Util.Codetree.Script
import qualified Hydra.Lib.Literals as Literals
import qualified Hydra.Util.Codetree.Ast as CT
import qualified Hydra.Ext.Scala.Meta as Scala

import qualified Data.List as L
import qualified Data.Maybe as Y


dotOp :: Op
dotOp = Op (Symbol ".") (Padding WsNone WsNone) (Precedence 0) AssociativityLeft

functionArrowOp :: Op
functionArrowOp = op "=>" (negate 1) AssociativityRight

matchOp :: Op
matchOp = Op (Symbol "match") (Padding WsSpace WsBreakAndIndent) (Precedence 0) AssociativityNone

writeCase :: Scala.Case -> CT.Expr
writeCase (Scala.Case pat _ term) = spaceSep [cst "case", writePat pat, cst "=>", writeTerm term]

writeDefn :: Scala.Defn -> CT.Expr
writeDefn def = case def of
  Scala.DefnDef (Scala.Defn_Def _ name tparams [params] scod body) -> spaceSep [
      cst "def", nameAndParams, cst "=", writeTerm body]
    where
      nameAndParams = noSep $ Y.catMaybes [
        Just $ writeData_Name name,
        if L.null tparams then Nothing else Just $ bracketList inlineStyle (writeType_Param <$> tparams),
        Just $ parenList False (writeData_Param <$> params),
        fmap (\t -> spaceSep [cst ":", writeType t]) scod]
  Scala.DefnVal (Scala.Defn_Val _ [Scala.PatVar (Scala.Pat_Var (Scala.Data_Name (Scala.PredefString name)))] typ term) -> spaceSep [
      cst "val", nameAndType, cst "=", writeTerm term]
    where
      nameAndType = Y.maybe (cst name) (\t -> spaceSep [cst $ name ++ ":", writeType t]) typ

writeImportExportStat :: Scala.ImportExportStat -> CT.Expr
writeImportExportStat ie = case ie of
  Scala.ImportExportStatImport (Scala.Import importers) -> newlineSep (writeImporter <$> importers)
--  Scala.ImportExportStatExport exp ->

writeImporter :: Scala.Importer -> CT.Expr
writeImporter (Scala.Importer (Scala.Data_RefName (Scala.Data_Name (Scala.PredefString ref))) importees) = spaceSep [
    cst "import", noSep [cst ref, forImportees importees]]
  where
    forImportee it = cst $ case it of
      Scala.ImporteeWildcard -> "*"
      Scala.ImporteeName (Scala.Importee_Name (Scala.NameValue name)) -> name
    forImportees its = if L.null its
      then cst ""
      else if L.length its == 1
      then noSep [cst ".", forImportee $ L.head its]
      else noSep [cst ".", curlyBracesList inlineStyle (forImportee <$> its)]
writeLit :: Scala.Lit -> CT.Expr
writeLit lit = case lit of
--  Scala.LitNull
  Scala.LitInt i -> cst $ Literals.showInt32 i
--  Scala.LitDouble Double
--  Scala.LitFloat Float
--  Scala.LitByte Integer
--  Scala.LitShort Integer
--  Scala.LitChar Integer
--  Scala.LitLong Int64
  Scala.LitBoolean b -> cst $ if b then "true" else "false"
  Scala.LitUnit -> cst "()"
  Scala.LitString s -> cst $ Literals.showString s
--  Scala.LitSymbol sym ->
  _ -> cst $ Literals.showString $ "TODO:literal:" ++ show lit

writeName :: Scala.Name -> CT.Expr
writeName name = case name of
  Scala.NameValue s -> cst s

writePat :: Scala.Pat -> CT.Expr
writePat pat = case pat of
  Scala.PatExtract (Scala.Pat_Extract fun args) -> noSep [writeTerm fun, parenList False (writePat <$> args)]
  Scala.PatVar (Scala.Pat_Var tname) -> writeData_Name tname

writePkg :: Scala.Pkg -> CT.Expr
writePkg (Scala.Pkg name _ stats) = doubleNewlineSep $ package:(writeStat <$> stats)
  where
    package = spaceSep [cst "package", writeData_Name name]

writeStat :: Scala.Stat -> CT.Expr
writeStat stat = case stat of
--  Scala.StatTerm Term ->
--  Scala.StatDecl Decl ->
  Scala.StatDefn def -> writeDefn def
  Scala.StatImportExport ie -> writeImportExportStat ie

writeTerm :: Scala.Data -> CT.Expr
writeTerm term = case term of
  Scala.DataLit lit -> writeLit lit
  Scala.DataRef ref -> writeData_Ref ref
  Scala.DataApply (Scala.Data_Apply fun args) -> noSep [writeTerm fun, parenList False (writeTerm <$> args)]
  Scala.DataAssign assign -> cst ">ASSIGN"
  Scala.DataTuple (Scala.Data_Tuple args) -> parenList False (writeTerm <$> args)
  Scala.DataMatch (Scala.Data_Match expr cases) -> ifx matchOp (writeTerm expr) $ newlineSep (writeCase <$> cases)
  Scala.DataFunctionData ft -> writeData_FunctionData ft

writeData_FunctionData :: Scala.Data_FunctionData -> CT.Expr
writeData_FunctionData ft = case ft of
  Scala.Data_FunctionDataFunction (Scala.Data_Function params body) ->
    spaceSep [parenList False (writeData_Param <$> params), cst "=>", writeTerm body]

writeData_Name :: Scala.Data_Name -> CT.Expr
writeData_Name (Scala.Data_Name (Scala.PredefString name)) = cst name

writeData_Param :: Scala.Data_Param -> CT.Expr
writeData_Param (Scala.Data_Param _ name stype _) = noSep $ Y.catMaybes [
  Just $ writeName name,
  fmap (\t -> spaceSep [cst ":", writeType t]) stype]

writeData_Ref :: Scala.Data_Ref -> CT.Expr
writeData_Ref ref = case ref of
  Scala.Data_RefName name -> writeData_Name name
  Scala.Data_RefSelect sel -> writeData_Select sel

writeData_Select :: Scala.Data_Select -> CT.Expr
writeData_Select (Scala.Data_Select arg name) = ifx dotOp (writeTerm arg) (writeTerm proj)
  where
    proj = Scala.DataRef $ Scala.Data_RefName name

writeType :: Scala.Type -> CT.Expr
writeType typ = case typ of
  Scala.TypeRef (Scala.Type_RefName name) -> writeType_Name name
  Scala.TypeApply (Scala.Type_Apply fun args) -> noSep [writeType fun, bracketList inlineStyle (writeType <$> args)]
  Scala.TypeFunctionType (Scala.Type_FunctionTypeFunction (Scala.Type_Function [dom] cod)) -> ifx functionArrowOp (writeType dom) (writeType cod)
  Scala.TypeLambda (Scala.Type_Lambda params body) -> noSep [writeType body, bracketList inlineStyle (writeType_Param <$> params)]
  Scala.TypeVar (Scala.Type_Var name) -> writeType_Name name
  _ -> cst $ "UNKNOWN TYPE: " ++ show typ

writeType_Name :: Scala.Type_Name -> CT.Expr
writeType_Name (Scala.Type_Name name) = cst name

writeType_Param :: Scala.Type_Param -> CT.Expr
writeType_Param (Scala.Type_Param [] n [] [] [] []) = writeName n