servant-typescript (empty) → 0.1.0.0

raw patch · 11 files changed

+596/−0 lines, 11 filesdep +aesondep +aeson-typescriptdep +basesetup-changed

Dependencies added: aeson, aeson-typescript, base, containers, directory, filepath, lens, mtl, servant, servant-foreign, servant-typescript, string-interpolate, text

Files

• ChangeLog.md +3/−0
• LICENSE +30/−0
• README.md +59/−0
• Setup.hs +2/−0
• app/Main.hs +27/−0
• servant-typescript.cabal +135/−0
• src/Servant/TypeScript.hs +155/−0
• src/Servant/TypeScript/GetFunctions.hs +90/−0
• src/Servant/TypeScript/Types.hs +74/−0
• src/Servant/TypeScript/Util.hs +19/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,3 @@+# Changelog for servant-typescript++## Unreleased changes

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,59 @@+# Welcome to `servant-typescript` [![Hackage](https://img.shields.io/hackage/v/servant-typescript.svg)](https://hackage.haskell.org/package/servant-typescript) ![servant-typescript](https://github.com/codedownio/servant-typescript/workflows/servant-typescript/badge.svg)+++This library generates TypeScript client libraries for Servant.++First, make sure you have [TypeScript](https://hackage.haskell.org/package/aeson-typescript) instances defined for all of the types used in the API.++```haskell+data User = User {+  name :: String+  , age :: Int+  , email :: String+  } deriving (Eq, Show)+deriveJSONAndTypeScript A.defaultOptions ''User+```++If you need to generate lots of boilerplate instances, the functions in `aeson-typescript`'s [Recursive](https://hackage.haskell.org/package/aeson-typescript-0.4.0.0/docs/Data-Aeson-TypeScript-Recursive.html) module can be your friend.+I've used [recursivelyDeriveMissingTypeScriptInstancesFor](https://hackage.haskell.org/package/aeson-typescript-0.4.0.0/docs/Data-Aeson-TypeScript-Recursive.html#v:recursivelyDeriveMissingTypeScriptInstancesFor) to derive instances for the Kubernetes API.++Next, you'll need some Servant API:++```haskell+type UserAPI = "users" :> Get '[JSON] [User]+          :<|> "albert" :> Get '[JSON] User+          :<|> "isaac" :> Get '[JSON] User+```++Generating the library is as simple as this:++```haskell+main = writeTypeScriptLibrary (Proxy :: Proxy UserAPI) "/my/destination/folder/"+```+## Caveats++* This library doesn't yet support generating generic TypeScript functions to match generic TypeScript instances. You can hack around this by writing your own `getFunctions` and hardcoding them manually for the necessary types.++## Supporting additional combinators++If you use unusual Servant combinators in your API, you may need to define additional `HasForeign` instances to explain how to convert them to TypeScript. For example, when I work with the [servant-websockets](https://hackage.haskell.org/package/servant-websockets) package, I add instances like the following.++The same applies to custom `AuthProtect` combinators from [Servant.API.Experimental.Auth](https://hackage.haskell.org/package/servant-0.19/docs/Servant-API-Experimental-Auth.html), etc.++```haskell+instance HasForeign LangTS Text WebSocket where+    type Foreign Text WebSocket = Text+    foreignFor _lang _pf _ _req = "void"++instance HasForeign LangTS Text WebSocketPending where+    type Foreign Text WebSocketPending = Text+    foreignFor _lang _pf _ _req = "void"++instance HasForeign LangTSDecls [TSDeclaration] WebSocketPending where+    type Foreign [TSDeclaration] WebSocketPending = [TSDeclaration]+    foreignFor _lang _pf _ _req = []++instance HasForeign LangTSDecls [TSDeclaration] WebSocket where+    type Foreign [TSDeclaration] WebSocket = [TSDeclaration]+    foreignFor _lang _pf _ _req = []+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,27 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Data.Aeson as A+import Data.Aeson.TH as A hiding (Options)+import Data.Aeson.TypeScript.TH+import Data.Proxy+import Servant.API+import Servant.TypeScript+++data User = User {+  name :: String+  , age :: Int+  , email :: String+  } deriving (Eq, Show)+deriveJSONAndTypeScript A.defaultOptions ''User++type UserAPI = "users" :> Get '[JSON] [User]+          :<|> "albert" :> Get '[JSON] User+          :<|> "isaac" :> Get '[JSON] User++main = writeTypeScriptLibrary (Proxy @UserAPI) "/tmp/test"

@@ -0,0 +1,135 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           servant-typescript+version:        0.1.0.0+synopsis:       TypeScript client generation for Servant+description:    Please see the README on GitHub at <https://github.com/codedownio/servant-typescript>+category:       Web+homepage:       https://github.com/github.com/codedownio#readme+bug-reports:    https://github.com/github.com/codedownio/issues+author:         Tom McLaughlin+maintainer:     tom@codedown.io+copyright:      2022 Tom McLaughlin+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/github.com/codedownio+  subdir: servant-typescript++library+  exposed-modules:+      Servant.TypeScript+      Servant.TypeScript.GetFunctions+  other-modules:+      Servant.TypeScript.Types+      Servant.TypeScript.Util+      Paths_servant_typescript+  hs-source-dirs:+      src+  default-extensions:+      OverloadedStrings+      QuasiQuotes+      NamedFieldPuns+      RecordWildCards+      ScopedTypeVariables+      FlexibleContexts+      FlexibleInstances+      MultiParamTypeClasses+      LambdaCase+      MultiWayIf+      ViewPatterns+  build-depends:+      aeson+    , aeson-typescript+    , base >=4.7 && <5+    , containers+    , directory+    , filepath+    , lens+    , mtl+    , servant+    , servant-foreign+    , string-interpolate+    , text+  default-language: Haskell2010++executable servant-typescript-exe+  main-is: Main.hs+  other-modules:+      Paths_servant_typescript+  hs-source-dirs:+      app+  default-extensions:+      OverloadedStrings+      QuasiQuotes+      NamedFieldPuns+      RecordWildCards+      ScopedTypeVariables+      FlexibleContexts+      FlexibleInstances+      MultiParamTypeClasses+      LambdaCase+      MultiWayIf+      ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , aeson-typescript+    , base >=4.7 && <5+    , containers+    , directory+    , filepath+    , lens+    , mtl+    , servant+    , servant-foreign+    , servant-typescript+    , string-interpolate+    , text+  default-language: Haskell2010++test-suite servant-typescript-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_servant_typescript+  hs-source-dirs:+      test+  default-extensions:+      OverloadedStrings+      QuasiQuotes+      NamedFieldPuns+      RecordWildCards+      ScopedTypeVariables+      FlexibleContexts+      FlexibleInstances+      MultiParamTypeClasses+      LambdaCase+      MultiWayIf+      ViewPatterns+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , aeson-typescript+    , base >=4.7 && <5+    , containers+    , directory+    , filepath+    , lens+    , mtl+    , servant+    , servant-foreign+    , servant-typescript+    , string-interpolate+    , text+  default-language: Haskell2010

@@ -0,0 +1,155 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ConstraintKinds #-}++{-|+Module:      Servant.TypeScript.Types+Copyright:   (c) 2022 Tom McLaughlin+License:     BSD3+Stability:   experimental+Portability: portable++This library generates TypeScript client libraries for Servant.++First, make sure you have 'TypeScript' instances defined for all of the types used in the API.++@+data User = User {+  name :: String+  , age :: Int+  , email :: String+  } deriving (Eq, Show)+deriveJSONAndTypeScript A.defaultOptions ''User+@++If you need to generate lots of boilerplate instances, the functions in @aeson-typescript@'s 'Data.Aeson.TypeScript.Recursive' module can be your friend.+I've used 'Data.Aeson.TypeScript.Recursive.recursivelyDeriveMissingTypeScriptInstancesFor' to derive instances for the Kubernetes API.++Next, you'll need some Servant API:++@+type UserAPI = "users" :> Get '[JSON] [User]+          :\<|\> "albert" :> Get '[JSON] User+          :\<|\> "isaac" :> Get '[JSON] User+@++Generating the library is as simple as this:++@+main = writeTypeScriptLibrary (Proxy :: Proxy UserAPI) "\/my\/destination\/folder\/"+@++-}+++module Servant.TypeScript (+  writeTypeScriptLibrary+  , writeTypeScriptLibrary'++  -- * Options+  , ServantTypeScriptOptions+  , defaultServantTypeScriptOptions+  , extraTypes+  , getFileKey+  , getFunctionName+  , getFunctions++  -- * Misc+  , MainConstraints+  ) where++import Control.Lens+import Control.Monad.Reader+import Data.Aeson.TypeScript.TH+import qualified Data.List as L+import qualified Data.Map as M+import Data.Maybe+import Data.Proxy+import qualified Data.Set as S+import Data.String.Interpolate+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Servant.Foreign+import Servant.TypeScript.Types+import Servant.TypeScript.Util+import System.Directory+import System.FilePath+++type MainConstraints api = (+  HasForeign LangTSDecls [TSDeclaration] api+  , GenerateList [TSDeclaration] (Foreign [TSDeclaration] api)+  , HasForeign LangTS T.Text api+  , GenerateList T.Text (Foreign T.Text api)+  )++-- | Write the TypeScript client library for the given API to the given folder using default options.+writeTypeScriptLibrary :: MainConstraints api => Proxy api -> FilePath -> IO ()+writeTypeScriptLibrary = writeTypeScriptLibrary' defaultServantTypeScriptOptions++-- | Write the TypeScript client library for the given API to the given folder.+writeTypeScriptLibrary' :: forall api. MainConstraints api => ServantTypeScriptOptions -> Proxy api -> FilePath -> IO ()+writeTypeScriptLibrary' opts _ rootDir = flip runReaderT opts $ do+  writeClientTypes (Proxy @api) "/tmp/test"+  writeClientLibraries (Proxy @api) "/tmp/test"++writeClientTypes :: forall api. (+  HasForeign LangTSDecls [TSDeclaration] api+  , GenerateList [TSDeclaration] (Foreign [TSDeclaration] api)+  ) => Proxy api -> FilePath -> ReaderT ServantTypeScriptOptions IO ()+writeClientTypes _ folder = do+  -- Types from API+  let decls = S.toList $ S.fromList $ getAllTypesFromReqs (getReqsWithDecls (Proxy :: Proxy api))++  -- Extra types not mentioned in the API (used in websocket protocols)+  extra <- asks extraTypes+  let decls' = mconcat [getTypeScriptDeclarations x | TSType x <- extra]++  liftIO $ writeFile (folder </> "client.d.ts") (formatTSDeclarations (L.nub (decls <> decls')))++writeClientLibraries :: forall api. (+  HasForeign LangTS T.Text api+  , GenerateList T.Text (Foreign T.Text api)+  ) => Proxy api -> FilePath -> ReaderT ServantTypeScriptOptions IO ()+writeClientLibraries _ folder = do+  -- Write the functions+  let allEndpoints = getEndpoints (Proxy :: Proxy api)+  ServantTypeScriptOptions {..} <- ask+  let groupedMap = groupBy getFileKey allEndpoints+  forM_ (M.toList groupedMap) $ \(fileKey, reqs) -> do+    let (dir, _) = splitFileName fileKey+    liftIO $ createDirectoryIfMissing True (folder </> dir)++    let path' = folder </> fileKey+    let functionNames = fmap getFunctionName reqs+    when (L.length functionNames /= S.size (S.fromList functionNames)) $ do+      let duplicates = L.foldl' (flip (M.alter (\case Nothing -> Just (1 :: Integer); Just x -> Just (x + 1)))) mempty functionNames+      error [i|Duplicate function names found when trying to generate '#{path'}': #{M.filter (>= 2) duplicates}|]++    liftIO $ T.writeFile path' (getFunctions getFunctionName reqs)+  where+    groupBy :: Ord k => (v -> k) -> [v] -> M.Map k [v]+    groupBy key as = M.fromListWith (++) as'+      where as' = map ((,) <$> key <*> (:[])) as++getReqsWithDecls :: (HasForeign LangTSDecls [TSDeclaration] api, GenerateList [TSDeclaration] (Foreign [TSDeclaration] api))+  => Proxy api -> [Req [TSDeclaration]]+getReqsWithDecls = listFromAPI (Proxy :: Proxy LangTSDecls) (Proxy :: Proxy [TSDeclaration])++getAllTypesFromReqs :: forall a. (Eq a, Ord a) => [Req [a]] -> [a]+getAllTypesFromReqs reqs = S.toList $ S.fromList vals+  where vals :: [a] = mconcat $ mconcat [catMaybes [req ^. reqReturnType, req ^. reqBody]+                                          <> getTypesFromUrl (req ^. reqUrl)+                                          <> concatMap getTypesFromHeaderArg (req ^. reqHeaders)+                                        | req <- reqs]+        getTypesFromUrl (Url path' queryArgs _) = concatMap getTypesFromSegment path' <> concatMap getTypesFromQueryArg queryArgs+        getTypesFromSegment (Segment (Static {})) = []+        getTypesFromSegment (Segment (Cap arg)) = [arg ^. argType]++        getTypesFromQueryArg queryArg = [queryArg ^. (queryArgName . argType)]++        getTypesFromHeaderArg ha = [ha ^. (headerArg . argType)]++getEndpoints :: (HasForeign LangTS T.Text api, GenerateList T.Text (Foreign T.Text api)) => Proxy api -> [Req T.Text]+getEndpoints = listFromAPI (Proxy :: Proxy LangTS) (Proxy :: Proxy T.Text)

@@ -0,0 +1,90 @@++module Servant.TypeScript.GetFunctions (+  getFunctions+  ) where++import Control.Lens+import Data.Maybe+import Data.String.Interpolate+import Data.Text (Text)+import qualified Data.Text as T+import Servant.Foreign.Internal as FI+++-- | Default implementation of @getFunctions@.+getFunctions :: (Req Text -> Text) -> [Req Text] -> Text+getFunctions getFunctionName reqs =+  [i|import queryString from "query-string";\n\n|]+  <> T.intercalate "\n" (fmap (reqToFunction getFunctionName) reqs)++reqToFunction :: (Req Text -> Text) -> Req Text -> Text+reqToFunction getFunctionName req = [i|+export function #{getFunctionName req}#{getGenericBrackets req}(#{getFunctionArgs req}): Promise<#{getReturnType req}> {+  let options: RequestInit = {+    credentials: "same-origin" as RequestCredentials,+    method: "#{req ^. reqMethod}",+    headers: {"Content-Type": "application/json;charset=utf-8"}+  };+  #{case (req ^. reqBody) of Nothing -> ("" :: Text); Just _ -> "\n  options.body = JSON.stringify(body);\n" }+  let params = {#{T.intercalate ", " (getQueryParamNames req)}};+  return (fetchFn || window.fetch)(`#{getPath req}` + "?" + queryString.stringify(params), options).then((response) => {+    return new Promise((resolve, reject) => {+      if (response.status !== 200) {+        return response.text().then((text) => reject({text, status: response.status}));+      } else {+        #{if hasReturn req+          then ("return response.json().then((json) => resolve(json));" :: Text)+          else "resolve();"}+      }+    });+  });+}|]++hasReturn :: Req Text -> Bool+hasReturn req = case req ^. reqReturnType of+  Nothing -> False+  Just "void" -> False+  Just _ -> True++getQueryParamNames :: Req Text -> [Text]+getQueryParamNames req = [x ^. (queryArgName . argName . _PathSegment)+                         | x <- req ^. (reqUrl . queryStr)]++getFunctionArgs :: Req Text -> Text+getFunctionArgs req = T.intercalate ", " $ catMaybes $+  maybeBodyArg+  : fmap formatCaptureArg (req ^. (reqUrl . path))+  <> fmap (Just . formatQueryArg) (req ^. (reqUrl . queryStr))+  <> [Just [i|fetchFn?: (input: RequestInfo, init?: RequestInit) => Promise<Response>|]]++  where+    maybeBodyArg = case req ^. reqBody of+      Nothing -> Nothing+      Just x -> Just [i|body: #{x}|]++formatCaptureArg :: Segment Text -> Maybe Text+formatCaptureArg (Segment (Static {})) = Nothing+formatCaptureArg (Segment (Cap arg)) = Just [i|#{arg ^. (argName . _PathSegment)}: #{arg ^. argType}|]++formatQueryArg :: QueryArg Text -> Text+formatQueryArg arg = case arg ^. queryArgType of+  Normal -> [i|#{name}?: #{typ}|]+  Flag -> [i|#{name}?: boolean|]+  FI.List -> [i|#{name}?: [#{typ}]|]+  where+    qaName = arg ^. queryArgName+    name = qaName ^. (argName . _PathSegment)+    typ = qaName ^. argType++getReturnType :: Req Text -> Text+getReturnType req = fromMaybe "void" (req ^. reqReturnType)++getGenericBrackets :: Req Text -> Text+getGenericBrackets _req = ""++getPath :: Req Text -> Text+getPath req = "/" <> T.intercalate "/" (fmap formatPathSegment (req ^. (reqUrl . path)))+  where+    formatPathSegment :: Segment Text -> Text+    formatPathSegment (Segment (Static (PathSegment t))) = t+    formatPathSegment (Segment (Cap ((^. argName) -> (PathSegment t)))) = [i|${#{t}}|]

@@ -0,0 +1,74 @@++module Servant.TypeScript.Types where++import Control.Lens+import Data.Aeson.TypeScript.Recursive+import Data.Aeson.TypeScript.TH+import Data.String.Interpolate+import qualified Data.Text as T+import Servant.Foreign.Internal as FI+import qualified Servant.TypeScript.GetFunctions as GetFunctions+import Servant.TypeScript.Util+++-- | Foreign type for getting TS types+data LangTS+instance (TypeScript a) => HasForeignType LangTS T.Text a where+  typeFor _proxyLang _proxyFtype proxyA = T.pack $ getTypeScriptType proxyA++-- | Foreign type for getting TS declarations+data LangTSDecls+instance (TypeScript a) => HasForeignType LangTSDecls [TSDeclaration] a where+  typeFor _proxyLang _proxyFtype proxyA = getTypeScriptDeclarationsRecursively proxyA++data ServantTypeScriptOptions = ServantTypeScriptOptions {+  -- | Extra TypeScript types to include in the @d.ts@ file.+  --+  -- Useful if you want to expose types that don't appear in your API, for whatever reason.+  extraTypes :: [TSType]++  -- | Determine to which output file the client function for the given request is mapped.+  --+  -- Useful to break up larger APIs into separate files based on criteria like route prefixes.+  --+  -- It's fine if the file key contains sub-directories; they will be created as needed.+  --+  -- A good approach is to split on @case req ^. (reqFuncName . _FunctionName) of ...@.+  --+  -- Default implementation is @const "client.ts"@.+  , getFileKey :: Req T.Text -> FilePath++  -- | Mangle a given request into a corresponding client function name.+  -- By default, just prepends the HTTP method to the camel-cased route.+  , getFunctionName :: Req T.Text -> T.Text++  -- | Given a list of requests, output a complete TypeScript module with the (exported) client functions,+  -- ready to be consumed by your TypeScript app.+  --+  -- For example, you can import dependencies at the top+  -- to use in your functions. The default version relies on the NPM "query-string" package to construct+  -- URLs. It uses the built-in @window.fetch@ by default, but allows you to pass your own @fetch@ function+  -- instead (useful for server-side rendering etc.). The default client functions return @Promise@s with+  -- the given return value, and on failure they reject the promise with a value of interface+  -- @{ status: number; text: string;  }@.+  --+  -- If you want to write your own 'getFunctions', check out the 'Servant.TypeScript.GetFunctions' module for+  -- inspiration.+  --+  -- The first argument passed to 'getFunctions' is the 'getFunctionName' function.+  , getFunctions :: (Req T.Text -> T.Text) -> [Req T.Text] -> T.Text+  }++-- | Reasonable default options.+defaultServantTypeScriptOptions :: ServantTypeScriptOptions+defaultServantTypeScriptOptions = ServantTypeScriptOptions {+  extraTypes = []++  , getFileKey = const "client.ts"++  , getFunctionName = \req -> case req ^. (reqFuncName . _FunctionName) of+      (method:xs) -> toCamelList $ fmap snakeToCamel (method:xs)+      _ -> error [i|Case not handled in getFunctionName: '#{req}'|]++  , getFunctions = GetFunctions.getFunctions+  }

@@ -0,0 +1,19 @@++module Servant.TypeScript.Util where++import Data.Char+import Data.Text (Text)+import qualified Data.Text as T+++snakeToCamel :: Text -> Text+snakeToCamel t = toCamelList $ T.splitOn "_" t++toCamelList :: [Text] -> Text+toCamelList [] = ""+toCamelList [x] = T.toLower x+toCamelList (x:xs) = mconcat (T.toLower x : fmap capitalize xs)++capitalize :: Text -> Text+capitalize t | T.length t == 1 = T.toUpper t+capitalize t = toUpper (T.head t) `T.cons` T.tail t

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"