{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}

-- TODO: This module duplicates quite a lot of code from MakeRequests.hs.
module Servant.PureScript.Subscriber where

import           Control.Lens                       hiding (List)
import           Data.Map                           (Map)
import           Data.Maybe                         (mapMaybe, maybeToList)
import qualified Data.Set                           as Set
import           Data.Text                          (Text)
import qualified Data.Text                          as T
import qualified Data.Text.Encoding                 as T
import           Language.PureScript.Bridge
import           Language.PureScript.Bridge.PSTypes (psString, psUnit)
import           Network.HTTP.Types.URI             (urlEncode)
import           Servant.Foreign
import           Servant.PureScript.CodeGen         (docIntercalate, genFnHead,
                                                     genModuleHeader,
                                                     genSignatureBuilder,
                                                     getReaderParams, psVar,
                                                     reqToParams,
                                                     reqsToImportLines)
import           Servant.PureScript.Internal
import           Servant.PureScript.MakeRequests    hiding (genFnBody,
                                                     genFunction, genModule,
                                                     genSignature)
import           Text.PrettyPrint.Mainland

genModule :: Settings -> [Req PSType] -> Doc
genModule opts allReqs = let
    isSubscribable :: Req PSType -> Bool
    isSubscribable req = T.empty `elem`  req ^.reqFuncName . to unFunctionName
    reqs       = filter isSubscribable allReqs
    allParams  = concatMap reqToParams allReqs
    rParams    = getReaderParams opts allParams
    apiImports = reqsToImportLines reqs
    webAPIImports = importsFromList [
        ImportLine (opts ^. apiModuleName) (Set.fromList ["SPParams_(..)"])
      ]
    imports    = _standardImports opts
                  `mergeImportLines` apiImports
                  `mergeImportLines` subscriberImportLines
                  `mergeImportLines` webAPIImports
    moduleName = _apiModuleName opts <> ".Subscriber"
  in
    genModuleHeader moduleName imports
    </> "import" <+> opts ^. apiModuleName . to strictText <> ".MakeRequests as MakeRequests"
    </> ""
    </> (docIntercalate line . map (genFunction rParams)) reqs

genFunction :: [PSParam] -> Req PSType -> Doc
genFunction allRParams req = let
    rParamsSet = Set.fromList allRParams
    fnName = req ^. reqFuncName ^. jsCamelCaseL
    responseType = case req ^. reqReturnType of
                     Nothing -> psUnit
                     Just t  -> t
    allParamsList = makeTypedToUserParam responseType : baseURLParam : reqToParams req
    fnParams = filter (not . flip Set.member rParamsSet) allParamsList -- Use list not set, as we don't want to change order of parameters

    pTypes = map _pType fnParams
    pNames = map _pName fnParams
    signature = genSignature fnName pTypes (Just psSubscriptions)
    -- | Well - if you really want to put the ToUserType parameter into the Reader monad - this will crash:
    body = genFnHead fnName pNames <+> genFnBody fnName (tail pNames)
  in signature </> body


genSignature :: Text -> [PSType] -> Maybe PSType -> Doc
genSignature = genSignatureBuilder $ "forall m a." <+/> "MonadAsk (SPSettings_ SPParams_) m" <+/> "=>"

genFnBody :: Text -> [Text] -> Doc
genFnBody fName params = "do"
  </> indent 2 (
        "spReq <- MakeRequests." <> genFnCall fName params
    </> "pure $ makeSubscriptions spReq (toUserType " <> strictText subscriberToUserId <> ")"
    ) <> "\n"

genFnCall :: Text -> [Text] -> Doc
genFnCall fnName params = fName <+> align (docIntercalate softline docParams)
  where
    docParams = map psVar params
    fName = strictText fnName