{-# LANGUAGE ScopedTypeVariables #-}
module Rest.Gen.JavaScript (mkJsApi) where

import Prelude hiding ((.))

import Control.Category ((.))
import Data.Maybe
import Text.StringTemplate
import qualified Data.Label.Total   as L
import qualified Data.List.NonEmpty as NList

import Code.Build
import Code.Build.JavaScript
import Rest.Api (Router, Version)
import Rest.Gen.Base
import Rest.Gen.Types
import Rest.Gen.Utils
import qualified Rest.Gen.NoAnnotation as N

mkJsApi :: N.ModuleName -> Bool -> Version -> Router m s -> IO String
mkJsApi ns priv ver r =
  do prelude <- render . setManyAttrib attrs . newSTMP <$> readContent "Javascript/prelude.js"
     epilogue <- render . setManyAttrib attrs . newSTMP <$> readContent "Javascript/epilogue.js"
     let cod = showCode $ mkStack
                [ unModuleName ns ++ ".prototype.version" .=. string (show ver)
                , mkJsCode (unModuleName ns) priv r
                ]
     return $ mkJsModule (prelude ++ cod ++ epilogue)
  where attrs = [("apinamespace", unModuleName ns), ("dollar", "$")]

mkJsModule :: String -> String
mkJsModule content = "(function (window) {\n\n" ++ content ++ "\n\n})(this);"

mkJsCode :: String -> Bool -> Router m s -> Code
mkJsCode ns priv = mkJs ns . sortTree . (if priv then id else noPrivate) . apiSubtrees

mkJs :: String -> ApiResource -> Code
mkJs ns = foldTreeChildren mkStack (\i ls -> mkStack $ mkRes ns i : ls)

mkRes :: String -> ApiResource -> Code
mkRes ns node = mkStack
  [ if hasAccessor node
      then resourceLoc ns node .=. mkAccessorConstructor ns node
      else resourceLoc ns node .=. jsObject []
  , resourceLoc ns node ++ ".apiObjectType" .=. string "resourceDir"
  , mkAccessFuncs ns node
  , mkPreFuncs ns node
  , mkPostFuncs ns node
  ]

mkAccessorConstructor :: String -> ApiResource -> Code
mkAccessorConstructor ns resource =
  let constrName = jsDir (cleanName (resName resource))
  in functionDecl constrName ["url", "secureUrl", "modifyRequest"] $
       jsIf (code $ "this instanceof " ++ constrName)
            (proc (ns ++ ".setContext") (code "this, url, secureUrl, modifyRequest"))
         <-> jsElse (ret $ call (constrName ++ ".access") (code "url, secureUrl, modifyRequest"))

mkPreFuncs :: String -> ApiResource -> Code
mkPreFuncs ns node =
  let items = filter ((\i -> not $ postAction i || isAccessor i) . itemInfo) $ resItems node
  in mkFunctions (resourceLoc ns node ++ ".") (mkFunction ns) items

mkAccessFuncs :: String -> ApiResource -> Code
mkAccessFuncs ns node =
  let items = filter ((\i -> not (postAction i) && isAccessor i) . itemInfo) $ resItems node
  in mkFunctions (resourceLoc ns node ++ ".") (mkAccessor ns) items

mkPostFuncs :: String -> ApiResource -> Code
mkPostFuncs ns node =
  let items = filter (postAction . itemInfo) $ resItems node
  in mkFunctions (resourceLoc ns node ++ ".prototype.") (mkFunction ns) items

mkFunctions :: String -> (ApiAction -> Code) -> [ApiAction] -> Code
mkFunctions loc maker = mkStack . map (\item -> loc ++ mkJsName item .=. maker item)

mkAccessor :: String -> ApiAction -> Code
mkAccessor ns node@(ApiAction _ _ ai) =
  let fParams  = maybeToList mIdent
      urlPart  = (if resDir ai == "" then "" else resDir ai ++ "/")
              ++ maybe "" (\i -> "' + encodeURIComponent(" ++ i ++ ") + '/") mIdent
      mIdent   = jsId . cleanName . description <$> ident ai
  in function fParams
      [ var "postfix" $ "'" ++ urlPart ++ "'"
      , var "accessor" $ new "this" . code $  "this.contextUrl + postfix, "
                                           ++ "this.secureContextUrl + postfix, "
                                           ++ "this.modifyRequest"
      , "accessor.get" .=. mkFunction ns node
      , ret "accessor"
      ]

mkFunction :: String -> ApiAction -> Code
mkFunction ns (ApiAction _ _ ai) =
  let fParams  = maybeToList mIdent
              ++ maybeToList (fmap fst3 mInp)
              ++ ["success", "error", "params", "callOpts"]
      mInp     = fmap (mkType . L.get (dataType . desc) . chooseType) . NList.nonEmpty . inputs $ ai
      mOut     = dataTypesToAcceptHeader JSON . responseAcceptType . chooseResponseType $ ai
      urlPart  = (if isAccessor ai then const "" else id) $
                 (if resDir ai == "" then "" else resDir ai ++ "/")
              ++ maybe "" (\i -> "' + encodeURIComponent(" ++ i ++ ") + '/") mIdent
      mIdent   = (if isAccessor ai then const Nothing else id) $ jsId . cleanName . description <$> ident ai
  in function fParams $ ret $
        call (ns ++ "." ++ "ajaxCall")
          [ string (method ai)
          , code $ (if https ai then "this.secureContextUrl" else "this.contextUrl") ++ " + '" ++ urlPart ++ "'"
          , code "params"
          , code "success"
          , code "error"
          , string $ maybe "text/plain" snd3 mInp
          , string mOut
          , maybe (code "undefined") (\(p, _, f) -> f (code p)) mInp
          , code "callOpts"
          , code "this.modifyRequest"
          ]

resourceLoc :: String -> ApiResource -> String
resourceLoc ns = ((ns ++ ".prototype.") ++) . locFromLink . resLink
  where locFromLink (LResource i1 : LAccess [] : LResource i2 : xs) = jsDir (cleanName i1) ++ "." ++ locFromLink (LResource i2 : xs)
        locFromLink (LResource i : xs) = case locFromLink xs of
                                          [] -> jsDir $ cleanName i
                                          ls -> jsDir (cleanName i) ++ ".prototype." ++ ls
        locFromLink (_ : xs) = locFromLink xs
        locFromLink [] = ""

mkJsName :: ApiAction -> String
mkJsName item =
  case mkFuncParts item of
    []       -> ""
    (x : xs) ->
      let res = x ++ concatMap upFirst xs
      in if res `elem` reservedWords
         then res ++ "_"
         else res

jsDir :: [String] -> String
jsDir = concatMap upFirst

jsId :: [String] -> String
jsId []       = ""
jsId (x : xs) =
  let res = x ++ concatMap upFirst xs
  in if res `elem` reservedWords
     then res ++ "_"
     else res

-- | Javascript reserved words in the broadest sense.
-- Taken from https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Lexical_grammar#Keywords

reservedWords :: [String]
reservedWords = es6Reserved ++ futureReserved ++ futureReservedStrict ++ oldFutureReserved
             ++ reservedLiterals
  where
    es6Reserved =
      [ "break", "case", "class", "catch", "const", "continue", "debugger", "default", "delete"
      , "do", "else", "export", "extends", "finally", "for", "function", "if", "import", "in"
      , "instanceof", "let", "new", "return", "super", "switch", "this", "throw", "try", "typeof"
      , "var", "void", "while", "with", "yield"
      ]
    futureReserved = ["enum", "await"]
    futureReservedStrict =
      [ "implements", "package", "protected", "static", "interface", "private", "public" ]
    oldFutureReserved =
      [ "abstract", "boolean", "byte", "char", "double", "final", "float", "goto", "int", "long"
      , "native", "short", "synchronized", "transient", "volatile"
      ]
    reservedLiterals = ["null", "false", "true"]

mkType :: DataType -> (String, String, Code -> Code)
mkType dt =
  case dt of
    String -> ("text", "text/plain", id)
    XML    -> ("xml" , "text/xml", id)
    JSON   -> ("json", "text/json", call "JSON.stringify")
    File   -> ("file", "application/octet-stream", id)
    Other  -> ("text", "text/plain", id)