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 :: (Req Text -> Text) -> [Req Text] -> Text
getFunctions Req Text -> Text
getFunctionName [Req Text]
reqs =
  [i|import queryString from "query-string";\n\n|]
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"\n" ((Req Text -> Text) -> [Req Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Req Text -> Text) -> Req Text -> Text
reqToFunction Req Text -> Text
getFunctionName) [Req Text]
reqs)

reqToFunction :: (Req Text -> Text) -> Req Text -> Text
reqToFunction :: (Req Text -> Text) -> Req Text -> Text
reqToFunction Req Text -> Text
getFunctionName Req Text
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 Text -> Bool
hasReturn Req Text
req = case Req Text
req Req Text
-> Getting (Maybe Text) (Req Text) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Req Text) (Maybe Text)
forall ftype. Lens' (Req ftype) (Maybe ftype)
reqReturnType of
  Maybe Text
Nothing -> Bool
False
  Just Text
"void" -> Bool
False
  Just Text
_ -> Bool
True

getQueryParamNames :: Req Text -> [Text]
getQueryParamNames :: Req Text -> [Text]
getQueryParamNames Req Text
req = [QueryArg Text
x QueryArg Text -> Getting Text (QueryArg Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. ((Arg Text -> Const Text (Arg Text))
-> QueryArg Text -> Const Text (QueryArg Text)
forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
queryArgName ((Arg Text -> Const Text (Arg Text))
 -> QueryArg Text -> Const Text (QueryArg Text))
-> ((Text -> Const Text Text) -> Arg Text -> Const Text (Arg Text))
-> Getting Text (QueryArg Text) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathSegment -> Const Text PathSegment)
-> Arg Text -> Const Text (Arg Text)
forall ftype. Lens' (Arg ftype) PathSegment
argName ((PathSegment -> Const Text PathSegment)
 -> Arg Text -> Const Text (Arg Text))
-> ((Text -> Const Text Text)
    -> PathSegment -> Const Text PathSegment)
-> (Text -> Const Text Text)
-> Arg Text
-> Const Text (Arg Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> PathSegment -> Const Text PathSegment
Iso' PathSegment Text
_PathSegment)
                         | QueryArg Text
x <- Req Text
req Req Text
-> Getting [QueryArg Text] (Req Text) [QueryArg Text]
-> [QueryArg Text]
forall s a. s -> Getting a s a -> a
^. ((Url Text -> Const [QueryArg Text] (Url Text))
-> Req Text -> Const [QueryArg Text] (Req Text)
forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl ((Url Text -> Const [QueryArg Text] (Url Text))
 -> Req Text -> Const [QueryArg Text] (Req Text))
-> (([QueryArg Text] -> Const [QueryArg Text] [QueryArg Text])
    -> Url Text -> Const [QueryArg Text] (Url Text))
-> Getting [QueryArg Text] (Req Text) [QueryArg Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QueryArg Text] -> Const [QueryArg Text] [QueryArg Text])
-> Url Text -> Const [QueryArg Text] (Url Text)
forall ftype. Lens' (Url ftype) [QueryArg ftype]
queryStr)]

getFunctionArgs :: Req Text -> Text
getFunctionArgs :: Req Text -> Text
getFunctionArgs Req Text
req = Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Text] -> [Text]) -> [Maybe Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
  Maybe Text
maybeBodyArg
  Maybe Text -> [Maybe Text] -> [Maybe Text]
forall a. a -> [a] -> [a]
: (Segment Text -> Maybe Text) -> [Segment Text] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment Text -> Maybe Text
formatCaptureArg (Req Text
req Req Text
-> Getting [Segment Text] (Req Text) [Segment Text]
-> [Segment Text]
forall s a. s -> Getting a s a -> a
^. ((Url Text -> Const [Segment Text] (Url Text))
-> Req Text -> Const [Segment Text] (Req Text)
forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl ((Url Text -> Const [Segment Text] (Url Text))
 -> Req Text -> Const [Segment Text] (Req Text))
-> (([Segment Text] -> Const [Segment Text] [Segment Text])
    -> Url Text -> Const [Segment Text] (Url Text))
-> Getting [Segment Text] (Req Text) [Segment Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Segment Text] -> Const [Segment Text] [Segment Text])
-> Url Text -> Const [Segment Text] (Url Text)
forall ftype. Lens' (Url ftype) (Path ftype)
path))
  [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. Semigroup a => a -> a -> a
<> (QueryArg Text -> Maybe Text) -> [QueryArg Text] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (QueryArg Text -> Text) -> QueryArg Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryArg Text -> Text
formatQueryArg) (Req Text
req Req Text
-> Getting [QueryArg Text] (Req Text) [QueryArg Text]
-> [QueryArg Text]
forall s a. s -> Getting a s a -> a
^. ((Url Text -> Const [QueryArg Text] (Url Text))
-> Req Text -> Const [QueryArg Text] (Req Text)
forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl ((Url Text -> Const [QueryArg Text] (Url Text))
 -> Req Text -> Const [QueryArg Text] (Req Text))
-> (([QueryArg Text] -> Const [QueryArg Text] [QueryArg Text])
    -> Url Text -> Const [QueryArg Text] (Url Text))
-> Getting [QueryArg Text] (Req Text) [QueryArg Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([QueryArg Text] -> Const [QueryArg Text] [QueryArg Text])
-> Url Text -> Const [QueryArg Text] (Url Text)
forall ftype. Lens' (Url ftype) [QueryArg ftype]
queryStr))
  [Maybe Text] -> [Maybe Text] -> [Maybe Text]
forall a. Semigroup a => a -> a -> a
<> [Text -> Maybe Text
forall a. a -> Maybe a
Just [i|fetchFn?: (input: RequestInfo, init?: RequestInit) => Promise<Response>|]]

  where
    maybeBodyArg :: Maybe Text
maybeBodyArg = case Req Text
req Req Text
-> Getting (Maybe Text) (Req Text) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Req Text) (Maybe Text)
forall ftype. Lens' (Req ftype) (Maybe ftype)
reqBody of
      Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
      Just Text
x -> Text -> Maybe Text
forall a. a -> Maybe a
Just [i|body: #{x}|]

formatCaptureArg :: Segment Text -> Maybe Text
formatCaptureArg :: Segment Text -> Maybe Text
formatCaptureArg (Segment (Static {})) = Maybe Text
forall a. Maybe a
Nothing
formatCaptureArg (Segment (Cap Arg Text
arg)) = Text -> Maybe Text
forall a. a -> Maybe a
Just [i|#{arg ^. (argName . _PathSegment)}: #{arg ^. argType}|]

formatQueryArg :: QueryArg Text -> Text
formatQueryArg :: QueryArg Text -> Text
formatQueryArg QueryArg Text
arg = case QueryArg Text
arg QueryArg Text -> Getting ArgType (QueryArg Text) ArgType -> ArgType
forall s a. s -> Getting a s a -> a
^. Getting ArgType (QueryArg Text) ArgType
forall ftype. Lens' (QueryArg ftype) ArgType
queryArgType of
  ArgType
Normal -> [i|#{name}?: #{typ}|]
  ArgType
Flag -> [i|#{name}?: boolean|]
  ArgType
FI.List -> [i|#{name}?: [#{typ}]|]
  where
    qaName :: Arg Text
qaName = QueryArg Text
arg QueryArg Text
-> Getting (Arg Text) (QueryArg Text) (Arg Text) -> Arg Text
forall s a. s -> Getting a s a -> a
^. Getting (Arg Text) (QueryArg Text) (Arg Text)
forall ftype1 ftype2.
Lens (QueryArg ftype1) (QueryArg ftype2) (Arg ftype1) (Arg ftype2)
queryArgName
    name :: Text
name = Arg Text
qaName Arg Text
-> ((Text -> Const Text Text) -> Arg Text -> Const Text (Arg Text))
-> Text
forall s a. s -> Getting a s a -> a
^. ((PathSegment -> Const Text PathSegment)
-> Arg Text -> Const Text (Arg Text)
forall ftype. Lens' (Arg ftype) PathSegment
argName ((PathSegment -> Const Text PathSegment)
 -> Arg Text -> Const Text (Arg Text))
-> ((Text -> Const Text Text)
    -> PathSegment -> Const Text PathSegment)
-> (Text -> Const Text Text)
-> Arg Text
-> Const Text (Arg Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> PathSegment -> Const Text PathSegment
Iso' PathSegment Text
_PathSegment)
    typ :: Text
typ = Arg Text
qaName Arg Text
-> ((Text -> Const Text Text) -> Arg Text -> Const Text (Arg Text))
-> Text
forall s a. s -> Getting a s a -> a
^. (Text -> Const Text Text) -> Arg Text -> Const Text (Arg Text)
forall ftype1 ftype2. Lens (Arg ftype1) (Arg ftype2) ftype1 ftype2
argType

getReturnType :: Req Text -> Text
getReturnType :: Req Text -> Text
getReturnType Req Text
req = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"void" (Req Text
req Req Text
-> Getting (Maybe Text) (Req Text) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Req Text) (Maybe Text)
forall ftype. Lens' (Req ftype) (Maybe ftype)
reqReturnType)

getGenericBrackets :: Req Text -> Text
getGenericBrackets :: Req Text -> Text
getGenericBrackets Req Text
_req = Text
""

getPath :: Req Text -> Text
getPath :: Req Text -> Text
getPath Req Text
req = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" ((Segment Text -> Text) -> [Segment Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Segment Text -> Text
formatPathSegment (Req Text
req Req Text
-> Getting [Segment Text] (Req Text) [Segment Text]
-> [Segment Text]
forall s a. s -> Getting a s a -> a
^. ((Url Text -> Const [Segment Text] (Url Text))
-> Req Text -> Const [Segment Text] (Req Text)
forall ftype. Lens' (Req ftype) (Url ftype)
reqUrl ((Url Text -> Const [Segment Text] (Url Text))
 -> Req Text -> Const [Segment Text] (Req Text))
-> (([Segment Text] -> Const [Segment Text] [Segment Text])
    -> Url Text -> Const [Segment Text] (Url Text))
-> Getting [Segment Text] (Req Text) [Segment Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Segment Text] -> Const [Segment Text] [Segment Text])
-> Url Text -> Const [Segment Text] (Url Text)
forall ftype. Lens' (Url ftype) (Path ftype)
path)))
  where
    formatPathSegment :: Segment Text -> Text
    formatPathSegment :: Segment Text -> Text
formatPathSegment (Segment (Static (PathSegment Text
t))) = Text
t
    formatPathSegment (Segment (Cap ((Arg Text
-> Getting PathSegment (Arg Text) PathSegment -> PathSegment
forall s a. s -> Getting a s a -> a
^. Getting PathSegment (Arg Text) PathSegment
forall ftype. Lens' (Arg ftype) PathSegment
argName) -> (PathSegment Text
t)))) = [i|${#{t}}|]