diff --git a/language-typescript.cabal b/language-typescript.cabal --- a/language-typescript.cabal +++ b/language-typescript.cabal @@ -1,5 +1,5 @@ name: language-typescript -version: 0.0.2 +version: 0.0.3 cabal-version: >=1.4 build-type: Simple license: MIT @@ -15,11 +15,11 @@ data-dir: "" library - build-depends: base >= 3 && <= 5, containers -any, parsec -any - exposed-modules: Language.TypeScript Language.TypeScript.Parser - Language.TypeScript.Lexer Language.TypeScript.Types + build-depends: base >=3 && <=5, containers -any, parsec -any, pretty -any + exposed-modules: Language.TypeScript.Pretty Language.TypeScript + Language.TypeScript.Parser Language.TypeScript.Lexer + Language.TypeScript.Types exposed: True buildable: True hs-source-dirs: src - other-modules: diff --git a/src/Language/TypeScript.hs b/src/Language/TypeScript.hs --- a/src/Language/TypeScript.hs +++ b/src/Language/TypeScript.hs @@ -15,9 +15,11 @@ module Language.TypeScript ( module Language.TypeScript.Types, module Language.TypeScript.Lexer, - module Language.TypeScript.Parser + module Language.TypeScript.Parser, + module Language.TypeScript.Pretty ) where import Language.TypeScript.Types import Language.TypeScript.Lexer import Language.TypeScript.Parser +import Language.TypeScript.Pretty diff --git a/src/Language/TypeScript/Pretty.hs b/src/Language/TypeScript/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/Language/TypeScript/Pretty.hs @@ -0,0 +1,272 @@ +----------------------------------------------------------------------------- +-- +-- Module : Language.TypeScript.Pretty +-- Copyright : (c) DICOM Grid Inc. 2013 +-- License : MIT +-- +-- Maintainer : Phillip Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Language.TypeScript.Pretty ( + renderDeclarationSourceFile +) where + +import Language.TypeScript.Types +import Text.PrettyPrint + +renderDeclarationSourceFile :: [DeclarationElement] -> String +renderDeclarationSourceFile = render . declarationSourceFile + +declarationSourceFile :: [DeclarationElement] -> Doc +declarationSourceFile = vcat . map declarationElement + +exported :: Exported -> Doc +exported _ = text "export" + +renderMaybe :: (a -> Doc) -> Maybe a -> Doc +renderMaybe f = maybe empty f + +stringLiteral :: String -> Doc +stringLiteral = doubleQuotes . text + +declarationElement :: DeclarationElement -> Doc +declarationElement (InterfaceDeclaration _ e i) = + renderMaybe exported e + <+> interface i +declarationElement (ImportDeclaration e name entityName) = + renderMaybe exported e + <+> text "import" + <+> text name + <+> char '=' + <+> renderEntityName entityName +declarationElement (ExportDeclaration name) = + exported Exported + <+> text "=" + <+> text name +declarationElement (ExternalImportDeclaration e name imp) = + renderMaybe exported e + <+> text "import" + <+> text name + <+> char '=' + <+> text "require" + <+> stringLiteral imp +declarationElement (AmbientDeclaration _ e a) = + renderMaybe exported e + <+> text "declare" + <+> renderAmbientDeclaration a + +renderAmbientDeclaration :: Ambient -> Doc +renderAmbientDeclaration (AmbientVariableDeclaration _ name ty) = + text "var" + <+> text name + <+> renderMaybe typeAnnotation ty + <+> semi +renderAmbientDeclaration (AmbientFunctionDeclaration _ name plrt) = + text "function" + <+> text name + <+> parameterListAndReturnType plrt + <+> semi +renderAmbientDeclaration (AmbientClassDeclaration _ name ps exts imps els) = + text "class" + <+> text name + <+> renderMaybe typeParameters ps + <+> renderMaybe extendsClause exts + <+> renderMaybe implementsClause imps + <+> braces (sepEndBy semi (renderAmbientClassBodyElement . snd ) els) +renderAmbientDeclaration (AmbientInterfaceDeclaration i) = interface i +renderAmbientDeclaration (AmbientEnumDeclaration _ name members) = + text "enum" <+> text name <+> braces (sepEndBy comma enumMember members) + where + enumMember (name, val) = text name <+> renderMaybe (\n -> char '=' <+> integer n) val +renderAmbientDeclaration (AmbientModuleDeclaration _ name ds) = + text "module" + <+> sepBy dot text name + <+> braces (vcat (map renderAmbientDeclaration ds)) +renderAmbientDeclaration (AmbientExternalModuleDeclaration _ name es) = + text "module" + <+> stringLiteral name + <+> braces (vcat (map renderAmbientExternalModuleElement es)) + +renderAmbientExternalModuleElement :: AmbientExternalModuleElement -> Doc +renderAmbientExternalModuleElement (AmbientModuleElement a) = renderAmbientDeclaration a +renderAmbientExternalModuleElement (ExportAssignment name) = + text "export" + <+> char '=' + <+> text name + <+> semi +renderAmbientExternalModuleElement (AmbientModuleExternalImportDeclaration e name imp) = + renderMaybe exported e + <+> text "import" + <+> text name + <+> char '=' + <+> text "require" + <+> stringLiteral imp + +renderAmbientClassBodyElement :: AmbientClassBodyElement -> Doc +renderAmbientClassBodyElement (AmbientConstructorDeclaration ps) = + text "constructor" + <+> parameterList ps + <+> semi +renderAmbientClassBodyElement (AmbientMemberDeclaration p s prop (Left ty)) = + renderMaybe publicOrPrivate p + <+> renderMaybe static s + <+> propertyName prop + <+> renderMaybe typeAnnotation ty +renderAmbientClassBodyElement (AmbientMemberDeclaration p s prop (Right ps)) = + renderMaybe publicOrPrivate p + <+> renderMaybe static s + <+> propertyName prop + <+> parameterListAndReturnType ps +renderAmbientClassBodyElement (AmbientIndexSignature i) = renderIndexSignature i + +renderIndexSignature :: IndexSignature -> Doc +renderIndexSignature (IndexSignature s sn ty) = + text s + <+> colon + <+> stringOrNumber sn + <+> typeAnnotation ty + +dot :: Doc +dot = char '.' + +sepEndBy :: Doc -> (a -> Doc) -> [a] -> Doc +sepEndBy s f as = hsep $ map (\e -> f e <+> s) as + +renderEntityName :: EntityName -> Doc +renderEntityName (EntityName Nothing e) = text e +renderEntityName (EntityName (Just (ModuleName es)) e) = hcat (punctuate dot (map text es)) <> text e + +interface :: Interface -> Doc +interface (Interface _ name ps exts ty) = + text "interface" + <+> text name + <+> renderMaybe typeParameters ps + <+> renderMaybe extendsClause exts + <+> objectType ty + +extendsClause :: [TypeRef] -> Doc +extendsClause rs = text "extends" <+> classOrInterfaceTypeList rs + +implementsClause :: [TypeRef] -> Doc +implementsClause rs = text "implements" <+> classOrInterfaceTypeList rs + +sepBy :: Doc -> (a -> Doc) -> [a] -> Doc +sepBy s f as = hsep $ punctuate s (map f as) + +commaSep :: (a -> Doc) -> [a] -> Doc +commaSep = sepBy comma + +classOrInterfaceTypeList :: [TypeRef] -> Doc +classOrInterfaceTypeList = commaSep typeRef + +objectType :: TypeBody -> Doc +objectType = braces . typeBody + +typeBody :: TypeBody -> Doc +typeBody (TypeBody ms) = hcat . map (\(_, m) -> typeMember m <+> semi) $ ms + +typeMember :: TypeMember -> Doc +typeMember (MethodSignature name opt plrt) = + propertyName name + <+> renderMaybe optional opt + <+> parameterListAndReturnType plrt +typeMember (PropertySignature name opt ty) = + propertyName name + <+> renderMaybe optional opt + <+> renderMaybe typeAnnotation ty +typeMember (CallSignature plrt) = parameterListAndReturnType plrt +typeMember (ConstructSignature tyArgs pl ty) = + text "new" + <+> renderMaybe typeParameters tyArgs + <+> parens (parameterList pl) + <+> renderMaybe typeAnnotation ty +typeMember (TypeIndexSignature i) = renderIndexSignature i + +propertyName :: String -> Doc +propertyName = text + +typeAnnotation :: Type -> Doc +typeAnnotation t = colon <+> _type t + +parameterListAndReturnType :: ParameterListAndReturnType -> Doc +parameterListAndReturnType (ParameterListAndReturnType ps pl ty) = + renderMaybe typeParameters ps + <+> parens (parameterList pl) + <+> renderMaybe typeAnnotation ty + +parameterList :: [Parameter] -> Doc +parameterList = commaSep parameter + +optional :: Optional -> Doc +optional _ = char '?' + +parameter :: Parameter -> Doc +parameter (RequiredOrOptionalParameter pop name opt ty) = + renderMaybe publicOrPrivate pop + <+> text name + <+> renderMaybe optional opt + <+> renderMaybe typeAnnotation ty +parameter (RestParameter name ty) = + text "..." + <+> text name + <+> renderMaybe typeAnnotation ty + +static :: Static -> Doc +static _ = text "static" + +publicOrPrivate :: PublicOrPrivate -> Doc +publicOrPrivate Public = text "public" +publicOrPrivate Private = text "private" + +stringOrNumber :: StringOrNumber -> Doc +stringOrNumber String = text "string" +stringOrNumber Number = text "number" + +typeParameters :: [TypeParameter] -> Doc +typeParameters ps = char '<' <+> commaSep typeParameter ps <+> char '>' + +typeParameter :: TypeParameter -> Doc +typeParameter (TypeParameter name ext) = + text name + <+> renderMaybe (\t -> text "extends" <+> _type t) ext + +_type :: Type -> Doc +_type (ArrayType t) = _type t <+> text "[]" +_type (Predefined p) = predefinedType p +_type (TypeReference r) = typeRef r +_type (ObjectType o) = objectType o +_type (FunctionType ps pl ret) = + renderMaybe typeParameters ps + <+> parens (parameterList pl) + <+> text "=>" + <+> _type ret +_type (ConstructorType ps pl ret) = + text "new" + <+> renderMaybe typeParameters ps + <+> parens (parameterList pl) + <+> text "=>" + <+> _type ret + +typeRef :: TypeRef -> Doc +typeRef (TypeRef n as) = + typeName n + <+> renderMaybe typeArguments as + +predefinedType :: PredefinedType -> Doc +predefinedType AnyType = text "any" +predefinedType NumberType = text "number" +predefinedType BooleanType = text "boolean" +predefinedType StringType = text "string" +predefinedType VoidType = text "void" + +typeName :: TypeName -> Doc +typeName (TypeName Nothing t) = text t +typeName (TypeName (Just (ModuleName ts)) t) = sepBy dot text ts <+> text t + +typeArguments :: [Type] -> Doc +typeArguments ts = char '<' <+> commaSep _type ts <+> char '>' diff --git a/src/Language/TypeScript/Types.hs b/src/Language/TypeScript/Types.hs --- a/src/Language/TypeScript/Types.hs +++ b/src/Language/TypeScript/Types.hs @@ -21,8 +21,8 @@ import Data.Data (Typeable, Data) data Comment = Comment - { text :: [String] - , other :: [(String, String)] + { commentText :: [String] + , commentOther :: [(String, String)] } deriving (Show, Data, Typeable) instance Monoid Comment where