Environment.purs

module Environment where 

import Prelude 

foreign import kind SFEnvironment
foreign import data Production :: SFEnvironment
foreign import data Sandbox :: SFEnvironment

data EnvProxy (env :: SFEnvironment) = EnvProxy

class SFEnv (env :: SFEnvironment) where
    envUrl' :: EnvProxy env -> String

instance sfenvironmentProduction :: SFEnv Production where 
    envUrl' =  const productionUrl'

instance sfenvironmentSandbox :: SFEnv Sandbox where 
    envUrl' =  const sandboxUrl'

productionUrl' :: String 
productionUrl' = "https://login.salesforce.com"

sandboxUrl' :: String 
sandboxUrl' = "https://test.salesforce.com/"

Internal.purs

module Monad.Internal where

import Prelude

import Connection (Connection)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Except.Trans (ExceptT(..), runExceptT)
import Data.Either (Either(..))
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff)
import Effect.Class (class MonadEffect, liftEffect)
import Environment (class SFEnv, kind SFEnvironment)
import Foreign (MultipleErrors)

newtype SalesforceM a = SalesforceM (Connection -> Aff a)

type Salesforce (env :: SFEnvironment) e a = ExceptT e SalesforceM a

instance functorSalesforceM :: Functor SalesforceM where
  map f s = SalesforceM \c -> runSalesforce s c >>= f >>> pure 

instance applySalesforceM:: Apply SalesforceM where
  apply (SalesforceM f) s = SalesforceM \c -> f c <*> runSalesforce s c 

instance applicativeSalesforceM :: Applicative SalesforceM where 
  pure x = SalesforceM \c -> pure x

instance bindSalesforceM :: Bind SalesforceM where
  bind (SalesforceM s) f = SalesforceM \c -> do 
    a <- s c
    let (SalesforceM g) = f a
    g c

instance monadSalesforceM :: Monad SalesforceM  

instance monadEffectSalesforceM :: MonadEffect SalesforceM where
  liftEffect a = SalesforceM \_ -> liftEffect a

instance monadAffectSalesforceM :: MonadAff SalesforceM where
  liftAff a = SalesforceM \_ -> a

runSalesforce :: forall a. SalesforceM a -> Connection -> Aff a
runSalesforce (SalesforceM f) conn =
  f conn

salesforce :: forall env e a. SFEnv env => (Connection -> Aff (Either e a)) -> Salesforce env e a
salesforce = ExceptT <<< SalesforceM

runSalesforceT :: forall env e a. SFEnv env => Salesforce env e a -> Connection -> Aff (Either e a)
runSalesforceT s conn = do
  let (SalesforceM f) = runExceptT s
  f conn

decodeErrorParser :: forall a error. (MultipleErrors -> error) -> Either MultipleErrors a -> Either error a
decodeErrorParser error (Left x) = throwError $ error x
decodeErrorParser _ (Right x) = pure x

Query.purs

import Data.String.Common
import Environment
import Query.Types

import Affjax as AX
import Affjax.RequestBody (formURLEncoded, string)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Connection (Connection(..))
import Control.Monad.Except (runExcept)
import Data.Argonaut.Core (Json, stringify)
import Data.Bifunctor (lmap)
import Data.Either (Either(..), either)
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String.Pattern (Pattern(..), Replacement(..))
import Data.Traversable (traverse_)
import Effect.Class (liftEffect)
import Effect.Console (logShow, log)
import Environtment (kind SFEnvironment)
import Foreign.Class (class Decode, decode)
import Foreign.JSON (decodeJSONWith)
import Monad.Internal 
import Prelude ((<<<), (>>=), (<>), show, ($), (#), flip, bind, pure, identity, discard)
import Unsafe.Coerce (unsafeCoerce)

queryUrl :: Maybe Number -> String 
queryUrl Nothing  = "services/data/v42.0/query/"
queryUrl (Just v) = "services/data/v" <> show v <> "/query/"    


queryRequest :: forall env r. SFEnv env => QueryEndpoint r -> Salesforce env QueryError Json 
queryRequest (Query (SOQL soql) sep) = salesforce \(Connection conn) -> do
    liftEffect $ log $ "Get " <> url' (EnvProxy :: EnvProxy env)
    res  <- AX.request (AX.defaultRequest { url = url' (EnvProxy :: EnvProxy env)
                                          , method = Left GET
                                          , responseFormat = ResponseFormat.json
                                          , headers = [RequestHeader "Authorization" (authHeader $ fromMaybe "" conn.token_type) ]
                                          })  
    pure $ res.body # handleResponseError
    where 
        url' env = (envUrl' env) <> (queryUrl Nothing) <> sep <> replaceQuerySpace soql
        authHeader = flip (<>) " token"
        replaceQuerySpace = \query -> replaceAll (Pattern " ") (Replacement "+") query
queryRequest _ = unsafeCoerce "?"

handleResponseError = lmap (\err -> QueryError $ AX.printResponseFormatError err)
handleDecodeError = lmap (\err -> QueryParseError $ show err)

runDecoder = decodeJSONWith decode