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 :: Proxy LangTS -> Proxy Text -> Proxy a -> Text
typeFor Proxy LangTS
_proxyLang Proxy Text
_proxyFtype Proxy a
proxyA = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> String
forall k (a :: k). TypeScript a => Proxy a -> String
getTypeScriptType Proxy a
proxyA

-- | Foreign type for getting TS declarations
data LangTSDecls
instance (TypeScript a) => HasForeignType LangTSDecls [TSDeclaration] a where
  typeFor :: Proxy LangTSDecls
-> Proxy [TSDeclaration] -> Proxy a -> [TSDeclaration]
typeFor Proxy LangTSDecls
_proxyLang Proxy [TSDeclaration]
_proxyFtype Proxy a
proxyA = Proxy a -> [TSDeclaration]
forall k (a :: k). TypeScript a => Proxy a -> [TSDeclaration]
getTypeScriptDeclarationsRecursively Proxy a
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.
  ServantTypeScriptOptions -> [TSType]
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"@.
  , ServantTypeScriptOptions -> Req Text -> String
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.
  , ServantTypeScriptOptions -> Req Text -> Text
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.
  , ServantTypeScriptOptions
-> (Req Text -> Text) -> [Req Text] -> Text
getFunctions :: (Req T.Text -> T.Text) -> [Req T.Text] -> T.Text
  }

-- | Reasonable default options.
defaultServantTypeScriptOptions :: ServantTypeScriptOptions
defaultServantTypeScriptOptions :: ServantTypeScriptOptions
defaultServantTypeScriptOptions = ServantTypeScriptOptions :: [TSType]
-> (Req Text -> String)
-> (Req Text -> Text)
-> ((Req Text -> Text) -> [Req Text] -> Text)
-> ServantTypeScriptOptions
ServantTypeScriptOptions {
  extraTypes :: [TSType]
extraTypes = []

  , getFileKey :: Req Text -> String
getFileKey = String -> Req Text -> String
forall a b. a -> b -> a
const String
"client.ts"

  , getFunctionName :: Req Text -> Text
getFunctionName = \Req Text
req -> case Req Text
req Req Text -> Getting [Text] (Req Text) [Text] -> [Text]
forall s a. s -> Getting a s a -> a
^. ((FunctionName -> Const [Text] FunctionName)
-> Req Text -> Const [Text] (Req Text)
forall ftype. Lens' (Req ftype) FunctionName
reqFuncName ((FunctionName -> Const [Text] FunctionName)
 -> Req Text -> Const [Text] (Req Text))
-> (([Text] -> Const [Text] [Text])
    -> FunctionName -> Const [Text] FunctionName)
-> Getting [Text] (Req Text) [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const [Text] [Text])
-> FunctionName -> Const [Text] FunctionName
Iso' FunctionName [Text]
_FunctionName) of
      (Text
method:[Text]
xs) -> [Text] -> Text
toCamelList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
snakeToCamel (Text
methodText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
      [Text]
_ -> String -> Text
forall a. HasCallStack => String -> a
error [i|Case not handled in getFunctionName: '#{req}'|]

  , getFunctions :: (Req Text -> Text) -> [Req Text] -> Text
getFunctions = (Req Text -> Text) -> [Req Text] -> Text
GetFunctions.getFunctions
  }