diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +The MIT License (MIT) + +Copyright (c) 2013 Phil Freeman + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal in +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS +FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR +COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER +IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,6 @@ +#!/usr/bin/runhaskell +> module Main where +> import Distribution.Simple +> main :: IO () +> main = defaultMain + diff --git a/src/Language/TypeScript/Docs.hs b/src/Language/TypeScript/Docs.hs new file mode 100644 --- /dev/null +++ b/src/Language/TypeScript/Docs.hs @@ -0,0 +1,34 @@ +----------------------------------------------------------------------------- +-- +-- Module : Language.TypeScript.Docs +-- Copyright : (c) DICOM Grid Inc. 2013 +-- License : MIT +-- +-- Maintainer : Phillip Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Language.TypeScript.Docs ( + convertDeclarationsToHtml, + module Language.TypeScript.Docs.Comments, + module Language.TypeScript.Docs.Html +) where + +import Language.TypeScript.Docs.Comments +import Language.TypeScript.Docs.Html + +import Language.TypeScript.Parser + +import Text.Parsec +import Text.Blaze.Html.Renderer.String +import qualified Data.Map as M +import Data.Maybe (fromMaybe) + +convertDeclarationsToHtml :: String -> Either String String +convertDeclarationsToHtml dts = do + decls <- either (Left . show) Right $ parse declarationSourceFile "TypeScript Declaration File" dts + return . renderHtml . generateDocument $ appendComments dts decls diff --git a/src/Language/TypeScript/Docs/Comments.hs b/src/Language/TypeScript/Docs/Comments.hs new file mode 100644 --- /dev/null +++ b/src/Language/TypeScript/Docs/Comments.hs @@ -0,0 +1,82 @@ +----------------------------------------------------------------------------- +-- +-- Module : Language.TypeScript.Docs.Comments +-- Copyright : (c) DICOM Grid Inc. 2013 +-- License : MIT +-- +-- Maintainer : Phillip Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Language.TypeScript.Docs.Comments ( + appendComments +) where + +import Data.Data +import Data.Generics +import Text.Parsec +import Text.Parsec.Pos +import qualified Data.Map as M +import Control.Applicative (Applicative(..), (<$>), (<*>)) +import Control.Monad (when, (>=>)) +import Language.TypeScript +import Data.List (intercalate, break) +import Data.Maybe (mapMaybe, fromMaybe) +import Data.Char (isSpace) +import System.IO.Unsafe (unsafePerformIO) + +findComments :: String -> (Int, Int) -> CommentPlaceholder +findComments s pos@(line, col) = + let + before = unlines $ toString (line - 1) col $ lines s + in + maybe (Left pos) (Right . parseComment . getContent) (findCommentBlock before) + where + findCommentBlock s = do + let reversed = reverse s + s1 <- findEndOfComment reversed + findStartOfComment [] s1 + findEndOfComment (c:s) | isSpace c = findEndOfComment s + findEndOfComment ('/':'*':s) = Just s + findEndOfComment _ = Nothing + findStartOfComment s (c:'*':'*':'/':_) | isSpace c = Just s + findStartOfComment s (c:'*':'/':_) = Nothing + findStartOfComment s (c:s1) = findStartOfComment (c:s) s1 + findStartOfComment s [] = Nothing + +toString line col (s:_) | line <= 0 = [take (col - 1) s] +toString line _ [] | line <= 0 = [] +toString line col (s:ss) = s:toString (line - 1) col ss + +getContent :: String -> [String] +getContent = map dropStar . lines + where + dropStar :: String -> String + dropStar ('*':c:s) | isSpace c = s + dropStar ('*':s) = s + dropStar (c:s) | isSpace c = dropStar s + dropStar s = s + +parseComment :: [String] -> Comment +parseComment = fst . foldr go (Comment [] [], True) + where + go ('@':rest) (comment, _) = + let + (key, value) = break (== ' ') rest + in + (comment { other = (key, dropWhile isSpace value):other comment}, True) + go line (comment, _) | all isSpace line = (comment, True) + go line (comment, True) = + (comment { text = line:text comment }, False) + go line (comment@Comment{ text = init:tail }, False) = + (comment { text = (line ++ " " ++ init):tail }, False) + +appendComments :: String -> [DeclarationElement] -> [DeclarationElement] +appendComments source = everywhere (mkT appendComments') + where + appendComments' (Left pos) = findComments source pos + appendComments' r = r diff --git a/src/Language/TypeScript/Docs/Html.hs b/src/Language/TypeScript/Docs/Html.hs new file mode 100644 --- /dev/null +++ b/src/Language/TypeScript/Docs/Html.hs @@ -0,0 +1,427 @@ +----------------------------------------------------------------------------- +-- +-- Module : Language.TypeScript.Docs.Html +-- Copyright : (c) DICOM Grid Inc. 2013 +-- License : MIT +-- +-- Maintainer : Phillip Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE OverloadedStrings #-} + +module Language.TypeScript.Docs.Html ( + generateDocument +) where + +import Language.TypeScript.Types +import Text.Blaze.Html +import qualified Text.Blaze.Html5 as H +import qualified Text.Blaze.Html5.Attributes as A +import Data.Maybe (mapMaybe) +import Data.Monoid (Monoid(..), Monoid) +import Data.Either (rights) +import Data.List (sortBy, groupBy, intercalate, intersperse) +import Data.String (IsString(..)) +import Control.Monad (MonadPlus(..), when, unless) +import qualified Data.Map as M +import Data.Function (on) +import Data.Ord (comparing) +import Data.List.Split (splitOn) + +header :: Int -> H.Html -> H.Html +header 1 = H.h1 +header 2 = H.h2 +header 3 = H.h3 +header 4 = H.h4 +header 5 = H.h5 +header _ = H.h6 + +topLevelInterfaces :: [DeclarationElement] -> [(Maybe Exported, Interface)] +topLevelInterfaces = + sortBy (comparing $ (\(_, Interface _ name _ _ _) -> name)) + . map collect + . groupBy ((==) `on` (\(_, Interface _ name _ _ _) -> name)) + . mapMaybe toInterface + where + toInterface (InterfaceDeclaration com e (Interface com1 name tps exts body)) = Just (e, Interface (com <.> Just com1) name tps exts body) + toInterface _ = Nothing + collect = foldl1 (\(e1, Interface com1 name tps exts (TypeBody body1)) + (e2, Interface com2 _ _ _ (TypeBody body2)) -> + (e1 `mplus` e2, Interface (com1 <..> Just com2) name tps exts (TypeBody $ body1 ++ body2))) + +ambientDeclarations :: [DeclarationElement] -> [(Maybe Exported, Ambient, CommentPlaceholder)] +ambientDeclarations = mapMaybe toAmbient + where + toAmbient (AmbientDeclaration com e a) = Just (e, a, com) + toAmbient _ = Nothing + +lift :: (Monoid m) => (a -> m) -> Maybe a -> m +lift f Nothing = mempty +lift f (Just a) = f a + +surround :: H.Html -> H.Html -> H.Html -> H.Html +surround open close inside = open >> inside >> close + +parens = surround (syntax "(") (syntax ")") +angles = surround (syntax "<") (syntax ">") +braces = surround (syntax "{") (syntax "}") +squares = surround (syntax "[") (syntax "]") + +renderComment :: CommentPlaceholder -> H.Html +renderComment (Left _) = mempty +renderComment (Right comments) = do + flip mapM_ (text comments) $ \line -> + H.p ! A.class_ "comments" $ H.toHtml line + let groups = groupBy ((==) `on` fst) (other comments) + flip mapM_ groups $ \all@((key,_):_) -> do + H.p $ H.strong $ H.toHtml key + H.ul $ mapM_ (H.li . renderCommentKeyValuePair) all + +renderCommentKeyValuePair :: (String, String) -> H.Html +renderCommentKeyValuePair ("see", value) = linkToBookmark (splitOn "." value) $ H.toHtml value +renderCommentKeyValuePair (_, value) = H.toHtml value + +intersperseM :: (Functor m, Monad m) => m b -> [m a] -> m [a] +intersperseM sep as = fmap rights $ sequence $ intersperse (fmap Left sep) (map (fmap Right) as) + +intersperseM_ :: (Functor m, Monad m) => m b -> [m a] -> m () +intersperseM_ sep = fmap (const ()) . intersperseM sep + +sp :: H.Html +sp = preEscapedToHtml (" " :: String) + +withClass :: String -> String -> H.Html +withClass _class text = H.span ! A.class_ (fromString _class) $ H.toHtml text + +keyword = withClass "keyword" +ident = withClass "identifier" +syntax = withClass "syntax" +literal = withClass "literal" + +comma = syntax "," +colon = syntax ":" + +bookmark :: [String] -> H.Html +bookmark names = H.a ! A.name (fromString $ intercalate "-" names) $ mempty + +linkToBookmark :: [String] -> H.Html -> H.Html +linkToBookmark names = H.a ! A.href (fromString ('#' : intercalate "-" names)) + +renderExported :: Exported -> H.Html +renderExported _ = keyword "export" >> sp + +renderStatic :: Static -> H.Html +renderStatic _ = keyword "static" >> sp + +renderOptional :: Optional -> H.Html +renderOptional _ = syntax "?" + +renderPublicOrPrivate :: PublicOrPrivate -> H.Html +renderPublicOrPrivate Public = keyword "public" >> sp +renderPublicOrPrivate Private = keyword "private" >> sp + +renderStringOrNumber :: StringOrNumber -> H.Html +renderStringOrNumber String = keyword "string" +renderStringOrNumber Number = keyword "number" + +(<.>) :: CommentPlaceholder -> Maybe CommentPlaceholder -> CommentPlaceholder +_ <.> (Just r@(Right _)) = r +r@(Right _) <.> _ = r +l <.> _ = l + +(<..>) :: CommentPlaceholder -> Maybe CommentPlaceholder -> CommentPlaceholder +Right l <..> (Just (Right r)) = Right $ l `mappend` r +l <..> r = l <.> r + +renderInterface :: [String] -> Int -> (Maybe Exported, Interface) -> H.Html +renderInterface moduleName level (e, Interface com name typeParameters extends body) = do + bookmark $ moduleName ++ [name] + header level $ ident name + H.div ! A.class_ "interface" $ do + H.p ! A.class_ "class_decl mono" $ do + lift renderExported e + keyword "interface" + sp + ident name + (lift $ angles . intersperseM_ (comma >> sp) . map (renderTypeParameter moduleName)) typeParameters + lift (\e -> sp >> keyword "extends" >> sp >> intersperseM_ (comma >> sp) (map (renderTypeReference moduleName) e)) extends + renderComment com + renderTypeBody moduleName (H.ul . mapM_ H.li) body + +predefinedTypeToString :: PredefinedType -> String +predefinedTypeToString AnyType = "any" +predefinedTypeToString NumberType = "number" +predefinedTypeToString BooleanType = "boolean" +predefinedTypeToString StringType = "string" +predefinedTypeToString VoidType = "void" + +renderTypeName :: [String] -> TypeName -> H.Html +renderTypeName moduleName (TypeName Nothing name) = + linkToBookmark (moduleName ++ [name]) $ ident name +renderTypeName _ (TypeName (Just m@(ModuleName moduleName)) name) = do + renderModuleName m + syntax "." + linkToBookmark (moduleName ++ [name]) $ ident name + +renderModuleName :: ModuleName -> H.Html +renderModuleName (ModuleName parts) = linkToBookmark parts $ ident $ intercalate "." parts + +renderTypeBody :: [String] -> ([H.Html] -> H.Html) -> TypeBody -> H.Html +renderTypeBody moduleName wrap (TypeBody members) = wrap $ map (renderTypeMember moduleName) members + +renderParameterListAndReturnType :: [String] -> ParameterListAndReturnType -> H.Html +renderParameterListAndReturnType moduleName (ParameterListAndReturnType gens args ret) = do + (lift $ angles . intersperseM_ comma . map (renderTypeParameter moduleName)) gens + (parens . intersperseM_ (comma >> sp) . map (renderParameter moduleName)) args + lift (renderTypeAnnotation moduleName) ret + +renderTypeAnnotation :: [String] -> Type -> H.Html +renderTypeAnnotation moduleName ty = do + syntax ":" + sp + renderType moduleName ty + +renderParameter :: [String] -> Parameter -> H.Html +renderParameter moduleName (RequiredOrOptionalParameter publicOrPrivate name opt ty) = do + lift renderPublicOrPrivate publicOrPrivate + ident name + lift renderOptional opt + lift (renderTypeAnnotation moduleName) ty +renderParameter moduleName (RestParameter name ty) = do + syntax "..." + ident name + lift (renderTypeAnnotation moduleName) ty + +renderTypeMember :: [String] -> (CommentPlaceholder, TypeMember) -> H.Html +renderTypeMember moduleName (com, mem) = do + H.span ! A.class_ "mono" $ renderTypeMember' mem + renderComment com + where + renderTypeMember' (PropertySignature name opt ty) = do + ident name + lift renderOptional opt + colon + sp + lift (renderType moduleName) ty + renderTypeMember' (MethodSignature name opt prt) = do + ident name + lift renderOptional opt + renderParameterListAndReturnType moduleName prt + renderTypeMember' (CallSignature prt) = renderParameterListAndReturnType moduleName prt + renderTypeMember' (ConstructSignature gens args ret) = do + (lift $ angles . intersperseM_ (comma >> sp) . map (renderTypeParameter moduleName)) gens + (parens . intersperseM_ (comma >> sp) . map (renderParameter moduleName)) args + lift (renderTypeAnnotation moduleName) ret + renderTypeMember' (TypeIndexSignature index) = renderIndexSignature moduleName index + +renderIndexSignature :: [String] -> IndexSignature -> H.Html +renderIndexSignature moduleName (IndexSignature name key ret) = do + squares $ do + ident name + colon + renderStringOrNumber key + renderTypeAnnotation moduleName ret + +renderTypeParameter :: [String] -> TypeParameter -> H.Html +renderTypeParameter moduleName (TypeParameter name ext) = do + ident name + flip lift ext $ \ty -> do + keyword "extends" + sp + renderType moduleName ty + +renderTypeReference :: [String] -> TypeRef -> H.Html +renderTypeReference moduleName (TypeRef name args) = do + renderTypeName moduleName name + (lift $ angles . intersperseM_ (comma >> sp) . map (renderType moduleName)) args + +renderType :: [String] -> Type -> H.Html +renderType _ (Predefined pre) = keyword $ predefinedTypeToString pre +renderType moduleName (TypeReference tr) = renderTypeReference moduleName tr +renderType moduleName (ObjectType body) = renderTypeBody moduleName (braces . intersperseM_ (comma >> sp)) body +renderType moduleName (ArrayType ty) = renderType moduleName ty >> syntax "[]" +renderType moduleName (FunctionType gens args ret) = do + (lift $ angles . intersperseM_ (comma >> sp) . map (renderTypeParameter moduleName)) gens + (parens . intersperseM_ (comma >> sp) . map (renderParameter moduleName)) args + renderTypeAnnotation moduleName ret +renderType moduleName (ConstructorType gens args ret) = do + keyword "new" + sp + (lift $ angles . intersperseM_ (comma >> sp) . map (renderTypeParameter moduleName)) gens + (parens . intersperseM_ (comma >> sp) . map (renderParameter moduleName)) args + renderTypeAnnotation moduleName ret + +renderAmbientClassBodyElement :: [String] -> (CommentPlaceholder, AmbientClassBodyElement) -> H.Html +renderAmbientClassBodyElement moduleName (com, el) = do + H.span ! A.class_ "mono" $ renderAmbientClassBodyElement' el + renderComment com + where + renderAmbientClassBodyElement' (AmbientConstructorDeclaration args) = do + keyword "constructor" + (parens . intersperseM_(comma >> sp) . map (renderParameter moduleName)) args + renderAmbientClassBodyElement' (AmbientMemberDeclaration publicOrPrivate static name (Left ty)) = do + lift renderPublicOrPrivate publicOrPrivate + lift renderStatic static + keyword "var" + sp + ident name + lift (renderTypeAnnotation moduleName) ty + renderAmbientClassBodyElement' (AmbientMemberDeclaration publicOrPrivate static name (Right prt)) = do + lift renderPublicOrPrivate publicOrPrivate + lift renderStatic static + keyword "function" + sp + ident name + renderParameterListAndReturnType moduleName prt + renderAmbientClassBodyElement' (AmbientIndexSignature indexSignature) = renderIndexSignature moduleName indexSignature + +ambientVariableDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, String, Maybe Type, CommentPlaceholder)] +ambientVariableDeclarations = mapMaybe p + where + p (e, AmbientVariableDeclaration com name ty, com1) = Just (e, name, ty, com <.> com1) + p _ = Nothing + +renderAmbientVariableDeclaration :: [String] -> (Maybe Exported, String, Maybe Type, CommentPlaceholder) -> H.Html +renderAmbientVariableDeclaration moduleName (e, name, ty, com) = do + do + H.span ! A.class_ "mono" $ do + lift renderExported e + keyword "var" + sp + ident name + lift (renderTypeAnnotation moduleName) ty + renderComment com + +ambientFunctionDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, String, ParameterListAndReturnType, CommentPlaceholder)] +ambientFunctionDeclarations = mapMaybe p + where + p (e, AmbientFunctionDeclaration com name ps, com1) = Just (e, name, ps, com <.> com1) + p _ = Nothing + +renderAmbientFunctionDeclaration :: [String] -> (Maybe Exported, String, ParameterListAndReturnType, CommentPlaceholder) -> H.Html +renderAmbientFunctionDeclaration moduleName (e, name, prt, com) = + do + H.span ! A.class_ "mono" $ do + lift renderExported e + keyword "function" + sp + ident name + renderParameterListAndReturnType moduleName prt + renderComment com + +ambientClassDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, String, Maybe [TypeParameter], Maybe [TypeRef], Maybe [TypeRef], [(CommentPlaceholder, AmbientClassBodyElement)], CommentPlaceholder)] +ambientClassDeclarations = mapMaybe p + where + p (e, AmbientClassDeclaration com name tps exts imps els, com1) = Just (e, name, tps, exts, imps, els, com <.> com1) + p _ = Nothing + +renderAmbientClassDeclaration :: [String] -> Int -> (Maybe Exported, String, Maybe [TypeParameter], Maybe [TypeRef], Maybe [TypeRef], [(CommentPlaceholder, AmbientClassBodyElement)], CommentPlaceholder) -> H.Html +renderAmbientClassDeclaration moduleName level (e, name, gens, exts, imps, els, com) = do + bookmark $ moduleName ++ [name] + header level $ do + lift renderExported e + H.toHtml name + H.div ! A.class_ "class" $ do + renderComment com + H.p ! A.class_ "class_decl mono" $ do + keyword "class" + sp + ident name + (lift $ angles . intersperseM_ (comma >> sp) . map (renderTypeParameter moduleName)) gens + lift (\e -> sp >> keyword "extends" >> sp >> intersperseM_ (comma >> sp) (map (renderTypeReference moduleName) e)) exts + lift (\e -> sp >> keyword "implements" >> sp >> intersperseM_ (comma >> sp) (map (renderTypeReference moduleName) e)) imps + H.ul $ mapM_ (H.li . renderAmbientClassBodyElement moduleName) els + +ambientInterfaceDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, Interface)] +ambientInterfaceDeclarations = mapMaybe p + where + p (e, AmbientInterfaceDeclaration (Interface com a b c d), com1) = Just (e, Interface (com <.> com1) a b c d) + p _ = Nothing + +renderAmbientInterfaceDeclaration :: [String] -> Int -> (Maybe Exported, Interface) -> H.Html +renderAmbientInterfaceDeclaration moduleName level = renderInterface moduleName level + +ambientEnumDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, String, [(String, Maybe Integer)], CommentPlaceholder)] +ambientEnumDeclarations = mapMaybe p + where + p (e, AmbientEnumDeclaration com name els, com1) = Just (e, name, els, com <.> com1) + p _ = Nothing + +renderAmbientEnumDeclaration :: [String] -> (Maybe Exported, String, [(String, Maybe Integer)], CommentPlaceholder) -> H.Html +renderAmbientEnumDeclaration moduleName (e, name, els, comments) = + H.div ! A.class_ "enum" $ do + bookmark $ moduleName ++ [name] + renderComment comments + lift renderExported e + keyword "enum" + sp + ident name + H.ul $ flip mapM_ els $ \(name, value) -> H.li ! A.class_ "mono" $ do + ident name + flip lift value $ \val -> do + sp + syntax "=" + sp + literal (show val) + +ambientModuleDeclarations :: [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> [(Maybe Exported, String, [Ambient], CommentPlaceholder)] +ambientModuleDeclarations = + sortBy (comparing $ \(_, name, _, _) -> name) + . map collect + . groupBy ((==) `on` \(_, name, _, _) -> name) + . mapMaybe p + where + p (e, AmbientModuleDeclaration com names ambs, com1) = Just (e, intercalate "." names, ambs, com <.> com1) + p (e, AmbientExternalModuleDeclaration com name ambs, com1) = Just (e, name, ambs, com <.> com1) + p _ = Nothing + collect = foldl1 (\(e1, name, els1, com1) (e2, _, els2, com2) -> (e1 `mplus` e2, name, els1 ++ els2, com1 <..> Just com2)) + +renderAmbientModuleDeclaration :: [String] -> Int -> (Maybe Exported, String, [Ambient], Maybe CommentPlaceholder) -> H.Html +renderAmbientModuleDeclaration moduleName level (e, name, els, comments) = + H.div ! A.class_ "section" $ do + bookmark moduleName + header level $ H.toHtml $ "Module " ++ (intercalate "." moduleName) + lift renderComment comments + renderAmbientDeclarations moduleName (level + 1) $ map (\a -> (e, a, Nothing)) els + +renderAmbientDeclarations :: [String] -> Int -> [(Maybe Exported, Ambient, Maybe CommentPlaceholder)] -> H.Html +renderAmbientDeclarations moduleName level ds = do + let vars = ambientVariableDeclarations ds + let functions = ambientFunctionDeclarations ds + let classes = ambientClassDeclarations ds + let interfaces = ambientInterfaceDeclarations ds + let enums = ambientEnumDeclarations ds + let modules = ambientModuleDeclarations ds + section H.ul H.li "Variables" vars (renderAmbientVariableDeclaration moduleName) + section H.ul H.li "Functions" functions (renderAmbientFunctionDeclaration moduleName) + section id id "Classes" classes (renderAmbientClassDeclaration moduleName (level + 1)) + section id id "Interfaces" interfaces (renderAmbientInterfaceDeclaration moduleName (level + 1)) + section id id "Enums" enums (renderAmbientEnumDeclaration moduleName) + section id id "Modules" modules $ \m@(a, name, b, c) -> renderAmbientModuleDeclaration (moduleName ++ [name]) (level + 1) (a, name, b, Just c) + where + section :: (H.Html -> H.Html) -> (H.Html -> H.Html) -> String -> [a] -> (a -> H.Html) -> H.Html + section outer inner name xs render = + unless (null xs) $ H.div ! A.class_ "section" $ do + header level $ H.toHtml name + outer $ mapM_ (inner . render) xs + +generateDocument :: [DeclarationElement] -> H.Html +generateDocument ds = do + H.docType + H.html $ do + H.head (H.title mempty) + H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href "style.css" + H.body $ do + let interfaces = topLevelInterfaces ds + unless (null interfaces) $ do + header 1 $ H.toHtml ("Interfaces" :: String) + mapM_ (renderInterface [] 2) interfaces + let declarations = ambientDeclarations ds + unless (null interfaces) $ do + header 1 $ H.toHtml ("Declarations" :: String) + renderAmbientDeclarations [] 2 (map (\(a, b, c) -> (a, b, Just c)) declarations) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,59 @@ +----------------------------------------------------------------------------- +-- +-- Module : Main +-- Copyright : (c) DICOM Grid Inc. 2013 +-- License : MIT +-- +-- Maintainer : Phillip Freeman +-- Stability : experimental +-- Portability : +-- +-- | +-- +----------------------------------------------------------------------------- + +module Main ( + main +) where + +import Language.TypeScript +import Language.TypeScript.Docs +import System.Console.CmdTheLine +import Control.Applicative +import System.Exit (exitSuccess, exitFailure) +import System.FilePath (pathSeparator) +import System.FilePath.Find +import qualified System.IO.UTF8 as U + +docGen :: [FilePath] -> Maybe FilePath -> IO () +docGen inputFiles outputFile = do + tds <- fmap concat $ mapM U.readFile inputFiles + case convertDeclarationsToHtml tds of + Left err -> do + U.putStrLn err + exitFailure + Right html -> do + case outputFile of + Just path -> U.writeFile path html + Nothing -> U.putStrLn html + exitSuccess + +inputFiles :: Term [FilePath] +inputFiles = nonEmpty $ posAny [] $ posInfo + { posDoc = "The input .d.ts file" } + +outputFile :: Term (Maybe FilePath) +outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ]) + { optDoc = "The output .html file" } + +term :: Term (IO ()) +term = docGen <$> inputFiles <*> outputFile + +termInfo :: TermInfo +termInfo = defTI + { termName = "typescript-docs" + , version = "0.0.1" + , termDoc = "Converts TypeScript Declaration files into HTML format" + } + +main = run (term, termInfo) diff --git a/typescript-docs.cabal b/typescript-docs.cabal new file mode 100644 --- /dev/null +++ b/typescript-docs.cabal @@ -0,0 +1,26 @@ +name: typescript-docs +version: 0.0.1 +cabal-version: >=1.4 +build-type: Simple +license: MIT +license-file: LICENSE +copyright: (c) DICOM Grid Inc. 2013 +maintainer: Phillip Freeman +stability: experimental +homepage: http://github.com/paf31/typescript-docs +synopsis: A documentation generator for TypeScript Definition files +description: A documentation generator for TypeScript Definition files +category: Language +author: Phillip Freeman +data-dir: "" + +executable typescript-docs + build-depends: utf8-string -any, syb -any, split -any, + filepath -any, filemanip -any, cmdtheline -any, containers -any, + blaze-html -any, parsec -any, base >= 3 && <= 5, language-typescript -any + main-is: Main.hs + buildable: True + hs-source-dirs: src + other-modules: Language.TypeScript.Docs + Language.TypeScript.Docs.Html Language.TypeScript.Docs.Comments +