packages feed

hsforce (empty) → 0.1.0.0

raw patch · 10 files changed

+846/−0 lines, 10 filesdep +HaXmldep +aesondep +basesetup-changed

Dependencies added: HaXml, aeson, base, bytestring, fast-tagsoup, hsforce, http-conduit, network-uri, regex-posix, tagsoup, template-haskell, text, unordered-containers, uri-encode

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for hsforce++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Makoto Tajitsu (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,87 @@+# hsforce++## Usage+++Login and create Salesforce client.+```haskell+main :: IO ()+main = do+  username <- getEnv "SALESFORCE_USERNAME"+  password <- getEnv "SALESFORCE_PASSWORD"+  endpoint <- getEnv "SALESFORCE_ENDPOINT"+  version <- getEnv "SALESFORCE_VERSION"+  client <- login username password endpoint version+```++create data type that is SObject class.+```haskell+import Data.Aeson as JSON+import Data.Maybe++data Account = Account{+  sfid :: Maybe String,+  name :: Maybe String,+  ex :: Maybe String+} deriving Show++instance SObject Account where+  typeName a = "Account"+  getSfid = fromJust . sfid++instance FromJSON Account where+  parseJSON = withObject "Account" $ \v -> do+    sfid <- v .: "Id"+    name <- v .:? "Name"+    ex <- v .:? "Ex__c"+    return Account{..}++instance ToJSON Account where+  toJSON (Account{sfid, name, ex}) =+    object ["Name" .= name]+```++CRUD API+```haskell+-- insert object+insert client Account{sfid = Nothing, name = Just "hogehoge", ex = Nothing}++-- update object+update client Account{sfid = Just "xxxx", name = Just "foobar"}++-- upsert object+upsert client Account{sfid = Nothing, name = Just "foobar", ex = Just "aaa"} "Ex__c" "aaa"++-- delete object+delete client Account{sfid = Just "xxxx"}++-- query+query client "SELECT Id, Name FROM Account WHERE Name = 'foobar'" (Proxy :: Proxy Account)++-- queryMore+queryMore client "/services/data/v20.0/query/01gD0000002HU6KIAW-2000" (Proxy :: Proxy Account)++-- queryAll+queryAll client "SELECT Id, Name FROM Account WHERE Name = 'foobar'" (Proxy :: Proxy Account)++-- queryAllMore+queryAllMore client "/services/data/v20.0/queryMore/01gD0000002HU6KIAW-2000" (Proxy :: Proxy Account)++-- explain+explain client "SELECT Id FROM Account"++-- describe+describe client "Account" (Proxy :: Proxy Account)++-- describeDetail+describeDetail client "Account"++-- describeGlobal+describeGlobal client++-- recordCount+recordCount client ["Account", "Contact", "Opportunity"]++-- versions+versions client+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsforce.cabal view
@@ -0,0 +1,79 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 6764d99a784870da8c00196566658baa3bc1aedb33d2719c647a89080a667cd5++name:           hsforce+version:        0.1.0.0+synopsis:       Salesforce API Client+description:    This package provides bindings to Salesforce API <https://github.com/githubuser/hsforce#readme>+category:       Web+homepage:       https://github.com/tzmfreedom/hsforce#readme+bug-reports:    https://github.com/tzmfreedom/hsforce/issues+author:         Makoto Tajitsu+maintainer:     makoto_tajitsu@hotmail.co.jp+copyright:      2019 Makoto Tajitsu+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/tzmfreedom/hsforce++library+  exposed-modules:+      HSForce+      HSForce.Client+      HSForce.Types+      HSForce.Util+  other-modules:+      Paths_hsforce+  hs-source-dirs:+      src+  build-depends:+      HaXml >=1.25.4 && <1.26+    , aeson >=1.4.2 && <1.5+    , base >=4.7 && <5+    , bytestring >=0.10.8 && <0.11+    , fast-tagsoup >=1.0.14 && <1.1+    , http-conduit >=2.3.4 && <2.4+    , network-uri >=2.6.1 && <2.7+    , regex-posix >=0.95.2 && <0.96+    , tagsoup >=0.14.7 && <0.15+    , template-haskell >=2.14.0 && <2.15+    , text >=1.2.2 && <1.3+    , unordered-containers >=0.2.7 && <0.3+    , uri-encode >=1.5.0 && <1.6+  default-language: Haskell2010++test-suite hsforce-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hsforce+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      HaXml >=1.25.4 && <1.26+    , aeson >=1.4.2 && <1.5+    , base >=4.7 && <5+    , bytestring >=0.10.8 && <0.11+    , fast-tagsoup >=1.0.14 && <1.1+    , hsforce+    , http-conduit >=2.3.4 && <2.4+    , network-uri >=2.6.1 && <2.7+    , regex-posix >=0.95.2 && <0.96+    , tagsoup >=0.14.7 && <0.15+    , template-haskell >=2.14.0 && <2.15+    , text >=1.2.2 && <1.3+    , unordered-containers >=0.2.7 && <0.3+    , uri-encode >=1.5.0 && <1.6+  default-language: Haskell2010
+ src/HSForce.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module HSForce+    ( login,+      soapLogin,+      restLogin,+      defaultLoginRequest,+      HSForce.versions,+      HSForce.query,+      HSForce.queryAll,+      HSForce.queryMore,+      HSForce.queryAllMore,+      HSForce.recordCount,+      HSForce.insert,+      HSForce.update,+      HSForce.upsert,+      HSForce.delete,+      HSForce.describe,+      HSForce.describeDetail,+      HSForce.describeGlobal,+      HSForce.explain,+      HSForce.Types.SObject(..),+      HSForce.Client.SFClient(..),+    ) where++import Network.HTTP.Conduit+import Network.URI+import Network.URI.Encode as URI+import System.IO+import System.Environment+import Data.Aeson as JSON+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..))+import Data.ByteString.Char8 as B8+import Data.ByteString.Lazy.Char8 as BL8+import Data.Proxy as DP+import Data.Maybe+import Data.List as L+import Text.HTML.TagSoup.Entity+import Text.XML.HaXml+import Text.XML.HaXml.Posn+import Text.XML.HaXml.Util+import Text.XML.HaXml.Xtract.Parse+import Text.Regex.Posix+import GHC.Generics+import HSForce.Util+import HSForce.Client+import HSForce.Types++query :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (QueryResponse a)+query client q _ = do+  let path = dataPath client ++ "/query/?q=" ++ URI.encode q+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (QueryResponse a)+  return (fromJust res)++queryMore :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (QueryResponse a)+queryMore client qpath _ = do+  response <- requestGet client qpath+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (QueryResponse a)+  return (fromJust res)++queryAll :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (QueryResponse a)+queryAll client q _ = do+  let path = dataPath client ++ "/queryAll/?q=" ++ URI.encode q+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (QueryResponse a)+  return (fromJust res)++queryAllMore :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (QueryResponse a)+queryAllMore client qpath _ = do+  response <- requestGet client qpath+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (QueryResponse a)+  return (fromJust res)++explain :: SFClient -> String -> IO (Explain)+explain client q = do+  let path = dataPath client ++ "/query/?explain=" ++ URI.encode q+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: Maybe Explain+  return (fromJust res)++search :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (QueryResponse a)+search client q _ = do+  let path = dataPath client ++ "/search/?q=" ++ URI.encode q+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (QueryResponse a)+  return (fromJust res)++recordCount :: SFClient -> [String] -> IO (RecordCount)+recordCount client objects = do+  let path = dataPath client ++ "/limits/recordCount?sObjects=" ++ L.intercalate "," objects+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: Maybe RecordCount+  return (fromJust res)++versions :: SFClient -> IO ([Version])+versions client = do+  response <- requestGet client "/services/data"+  let res = (JSON.decode $ responseBody response) :: Maybe [Version]+  return (fromJust res)++batchRequest :: (ToJSON a) => SFClient -> [BatchRequest a] -> IO ()+batchRequest client requests = do+  let path = dataPath client ++ "/composite/batch"+  response <- requestPost client path $ BL8.unpack $ JSON.encode requests -- TODO: impl+  return ()++tree :: (ToJSON a, SObject a) => SFClient -> [a] -> IO ()+tree client objects = do+  let path = dataPath client ++ "/composite/tree/" ++ typeName (objects !! 0)+  response <- requestPost client path $ BL8.unpack $ JSON.encode objects+  return ()++insert :: (SObject a, ToJSON a) => SFClient -> a -> IO ()+insert client object = do+  let path = dataPath client ++ "/sobjects/" ++ typeName object+  response <- requestPost client path $ BL8.unpack $ JSON.encode object+  return ()++update :: (SObject a, ToJSON a) => SFClient -> a -> IO ()+update client object = do+  let path = dataPath client ++ "/sobjects/" ++ typeName object ++ '/':getSfid object+  response <- requestPatch client path $ BL8.unpack $ JSON.encode object+  return ()++upsert :: (SObject a, ToJSON a) => SFClient -> a -> String -> String -> IO ()+upsert client object upsertKey upsertKeyValue = do+  let path = dataPath client ++ "/sobjects/" ++ typeName object ++ '/':upsertKey ++ '/':upsertKeyValue+  response <- requestPatch client path $ BL8.unpack $ JSON.encode object+  return ()++delete :: (SObject a, ToJSON a) => SFClient -> a -> IO ()+delete client object = do+  let path = dataPath client ++ "/sobjects/" ++ typeName object ++ '/':getSfid object+  response <- requestDelete client path+  return ()++describe :: (FromJSON a) => SFClient -> String -> DP.Proxy a -> IO (DescribeResponse a)+describe client objectName _ = do+  let path = dataPath client ++ "/sobjects/" ++ objectName+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: (FromJSON a) => Maybe (DescribeResponse a)+  return (fromJust res)++describeDetail :: SFClient -> String -> IO (DescribeDetail)+describeDetail client objectName = do+  let path = dataPath client ++ "/sobjects/" ++ objectName ++ "/describe"+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: Maybe DescribeDetail+  return (fromJust res)++describeGlobal :: SFClient -> IO GlobalDescribeResponse+describeGlobal client = do+  let path = dataPath client ++ "/sobjects"+  response <- requestGet client path+  let res = (JSON.decode $ responseBody response) :: Maybe GlobalDescribeResponse+  return (fromJust res)
+ src/HSForce/Client.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module HSForce.Client where++import Network.HTTP.Conduit+import Network.URI+import Network.URI.Encode as URI+import System.IO+import System.Environment+import Data.Aeson as JSON+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..))+import Data.ByteString.Char8 as B8+import Data.ByteString.Lazy.Char8 as BL8+import Data.Proxy as DP+import Data.Maybe+import Data.Text as T+import Data.HashMap.Strict as M+import Data.List as L+import Text.HTML.TagSoup.Entity+import Text.XML.HaXml+import Text.XML.HaXml.Posn+import Text.XML.HaXml.Util+import Text.XML.HaXml.Xtract.Parse+import Text.Regex.Posix+import GHC.Generics+import HSForce.Util+import Control.Applicative++data SFClient = SFClient {+  clientAccessToken :: String,+  clientInstanceUrl :: String,+  clientApiVersion:: String,+  clientDebug :: Bool+} deriving Show++data LoginRequest = LoginRequest{+  sfUsername :: Maybe String,+  sfPassword :: Maybe String,+  sfEndpoint :: Maybe String,+  sfVersion :: Maybe String,+  sfClientID :: Maybe String,+  sfClientSecret :: Maybe String+} deriving Show++defaultLoginRequest :: IO LoginRequest+defaultLoginRequest = do+  sfUsername <- lookupEnv "SALESFORCE_USERNAME"+  sfPassword <- lookupEnv "SALESFORCE_PASSWORD"+  endpoint <- lookupEnv "SALESFORCE_ENDPOINT"+  version <- lookupEnv "SALESFORCE_VERSION"+  sfClientID <- lookupEnv "SALESFORCE_CLINET_ID"+  sfClientSecret <- lookupEnv "SALESFORCE_CLIENT_SECRET"+  return (LoginRequest{+    sfUsername,+    sfPassword,+    sfEndpoint = endpoint <|> Just "login.salesforce.com",+    sfVersion = version <|> Just "v44.0",+    sfClientID,+    sfClientSecret+  })++login :: LoginRequest -> IO (SFClient)+login lr = do+  if isOAuth lr then restLogin lr else soapLogin lr++soapLogin :: LoginRequest -> IO (SFClient)+soapLogin LoginRequest{sfUsername, sfPassword, sfEndpoint, sfVersion} = do+  let username = fromJust sfUsername+      password = fromJust sfPassword+      endpoint = fromJust sfEndpoint+      clientApiVersion = fromJust sfVersion+  let body = "<?xml version=\"1.0\" encoding=\"utf-8\"?> \+  \<env:Envelope xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:env=\"http://schemas.xmlsoap.org/soap/envelope/\"> \+    \<env:Body> \+      \<n1:login xmlns:n1=\"urn:partner.soap.sforce.com\"> \+        \<n1:username>{username}</n1:username> \+       \<n1:password>{password}</n1:password> \+     \</n1:login> \+   \</env:Body> \+  \</env:Envelope>" :: String+  initReq <- parseRequest $ "https://" ++ endpoint ++ "/services/Soap/u/" ++ clientApiVersion+  manager <- newManager tlsManagerSettings+  let requestBody = L.foldl (\body (bind,value) -> HSForce.Util.replace bind (escapeXML value) body) body [("{username}", username), ("{password}", password)]+  let req = initReq {+    method = "POST",+    requestHeaders = [("Content-Type", "text/xml"), ("SOAPAction", "''")],+    requestBody = RequestBodyBS $ B8.pack requestBody+  }+  response <- httpLbs req manager+  let Document _ _ root _ = xmlParse "" $ (BL8.unpack (responseBody response))+      cont = CElem root noPos+      result = xtract id "/soapenv:Envelope/soapenv:Body/loginResponse/result" cont !! 0+      clientAccessToken = tagText result "/result/sessionId"+      clientServerUrl = tagText result "/result/serverUrl"+      matches = clientServerUrl =~ ("^(https://[^/]*)/.*" :: String) :: [[String]]+  return SFClient{clientAccessToken, clientApiVersion, clientInstanceUrl = matches !! 0 !! 1, clientDebug = False}++restLogin :: LoginRequest -> IO (SFClient)+restLogin LoginRequest{sfUsername, sfPassword, sfEndpoint, sfVersion, sfClientID, sfClientSecret} = do+  let username = fromJust sfUsername+      password = fromJust sfPassword+      endpoint = fromJust sfEndpoint+      clientApiVersion = fromJust sfVersion+      clientId = fromJust sfClientID+      clientSecret = fromJust sfClientSecret+  initReq <- parseRequest $ "https://" ++ endpoint ++ "/services/oauth2/token"+  manager <- newManager tlsManagerSettings+  let params = [+        ("grant_type", "password"),+        ("client_id", clientId),+        ("client_secret", clientSecret),+        ("username", username),+        ("password", password)+        ]+      requestBody = L.tail $ L.foldl (\body (k,v) -> body ++ "&" ++ k ++ "=" ++ URI.encode v) "" params+      req = initReq {+        method = "POST",+        requestHeaders = [("Content-Type", "application/x-www-form-urlencoded")],+        requestBody = RequestBodyBS $ B8.pack requestBody+      }+  response <- httpLbs req manager+  let tokenObject = fromJust (JSON.decode $ responseBody response :: Maybe Object)+      clientAccessToken = T.unpack . getText . fromJust $ M.lookup "access_token" tokenObject+      clientInstanceUrl = T.unpack . getText . fromJust $ M.lookup "instance_url" tokenObject+  return SFClient{clientAccessToken, clientApiVersion, clientInstanceUrl, clientDebug = False}++isOAuth :: LoginRequest -> Bool+isOAuth LoginRequest{sfClientID = Just _, sfClientSecret = Just _} = True+isOAuth _ = False++requestGet :: SFClient -> String -> IO (Response BL8.ByteString)+requestGet = requestWithoutBody "GET"++requestDelete :: SFClient -> String -> IO (Response BL8.ByteString)+requestDelete = requestWithoutBody "DELETE"++requestWithoutBody :: B8.ByteString -> SFClient -> String -> IO (Response BL8.ByteString)+requestWithoutBody method client path = do+  initReq <- parseRequest $ clientInstanceUrl client ++ path+  manager <- newManager tlsManagerSettings+  let req = initReq {+    method = method,+    requestHeaders = [("Authorization", B8.pack $ "Bearer " ++ (clientAccessToken client))]+  }+  printDebug client req+  response <- httpLbs req manager+  printDebug client response+  return (response)++requestWithBody :: B8.ByteString -> SFClient -> String -> String -> IO (Response BL8.ByteString)+requestWithBody method client path body = do+  initReq <- parseRequest $ clientInstanceUrl client ++ path+  manager <- newManager tlsManagerSettings+  let req = initReq {+    method = method,+    requestHeaders = [+      ("Content-Type", "application/json"),+      ("Authorization", B8.pack $ "Bearer " ++ (clientAccessToken client))+    ],+    requestBody = RequestBodyBS $ B8.pack body+  }+  printDebug client req+  response <- httpLbs req manager+  printDebug client response+  return (response)++requestPost :: SFClient -> String -> String -> IO (Response BL8.ByteString)+requestPost = requestWithBody "POST"++requestPatch :: SFClient -> String -> String -> IO (Response BL8.ByteString)+requestPatch = requestWithBody "PATCH"++printDebug :: (Show a) => SFClient -> a -> IO ()+printDebug client var = do+  if clientDebug client then print var else pure ()++dataPath :: SFClient -> String+dataPath client = do+  "/services/data/" ++ (clientApiVersion client)++getText :: Value -> Text+getText (String a) = a++deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "client" } ''SFClient
+ src/HSForce/Types.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module HSForce.Types where++import Data.Aeson as JSON+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..))+import Data.Proxy as DP+import Data.Maybe+import Data.List as L+import GHC.Generics+import HSForce.Util++data QueryResponse a = QueryResponse{+  qrRecords :: [a],+  qrTotalSize :: Int,+  qrDone :: Bool+} deriving Show++class SObject a where+  typeName :: a -> String+  getSfid :: a -> String++data DescribeResponse a = DescribeResponse{+  drObjectDescribe :: ObjectDescribe,+  drRecentItems :: [a]+} deriving Show++data ObjectDescribe = ObjectDescribe {+  odActivateable :: Bool,+  odCreateable :: Bool,+  odCustom :: Bool,+  odCustomSetting :: Bool,+  odDeletable :: Bool,+  odDeprecatedAndHidden :: Bool,+  odFeedEnabled :: Bool,+  odHasSubtypes :: Bool,+  odIsSubtype :: Bool,+  odKeyPrefix :: Maybe String,+  odLabel :: String,+  odLabelPlural :: String,+  odLayoutable :: Bool,+  odMergeable :: Bool,+  odMruEnabled :: Bool,+  odName :: String,+  odQueryable :: Bool,+  odReplicateable :: Bool,+  odRetrieveable :: Bool,+  odSearchable :: Bool,+  odTriggerable :: Bool,+  odUndeletable :: Bool,+  odUpdateable :: Bool,+  odUrls :: Object+} deriving Show++data GlobalDescribeResponse = GlobalDescribeResponse{+  gdEncoding :: String,+  gdMaxBatchSize :: Int,+  gdSobjects :: [ObjectDescribe]+} deriving Show++data DescribeDetail = DescribeDetail{+  ddActionOverrides :: Maybe [ActionOverride],+  ddActivateable :: Maybe Bool,+  ddChildRelationships :: Maybe [ChildRelationship],+  ddCompactLayoutable :: Maybe Bool,+  ddCreateable :: Maybe Bool,+  ddCustom :: Maybe Bool,+  ddCustomSetting :: Maybe Bool,+  ddDeletable :: Maybe Bool,+  ddDeprecatedAndHidden :: Maybe Bool,+  ddFeedEnabled :: Maybe Bool,+  ddFields :: Maybe [Field],+  ddHasSubtypes :: Maybe Bool,+  ddIsSubtype :: Maybe Bool,+  ddKeyPrefix :: Maybe String,+  ddLabel :: Maybe String,+  ddLabelPlural :: Maybe String,+  ddLayoutable :: Maybe Bool,+  ddListviewable :: Maybe Bool,+  ddLookupLayoutable :: Maybe Bool,+  ddMergeable :: Maybe Bool,+  ddMruEnabled :: Maybe Bool,+  ddName :: Maybe String,+  ddNamedLayoutInfos :: Maybe [String],+  ddNetworkScopeFieldName :: Maybe String,+  ddQueryable :: Maybe Bool,+  ddRecordTypeInfos :: Maybe [RecordTypeInfo],+  ddReplicateable :: Maybe Bool,+  ddRetrieveable :: Maybe Bool,+  ddSearchLayoutable :: Maybe Bool,+  ddSearchable :: Maybe Bool,+  ddSupportedScopes :: Maybe [Scope],+  ddTriggerable :: Maybe Bool,+  ddUndeletable :: Maybe Bool,+  ddUpdateable :: Maybe Bool,+  ddUrls :: Maybe Object+} deriving Show++data ActionOverride = ActionOverride{+  aoFormFactor :: Maybe String,+  aoIsAvailableInTouch :: Maybe Bool,+  aoName :: Maybe String,+  aoPageId :: Maybe String,+  aoUrl :: Maybe String+} deriving Show++data ChildRelationship = ChildRelationship{+  crCascadeDelete :: Maybe Bool,+  crChildSObject :: Maybe String,+  crDeprecatedAndHidden :: Maybe Bool,+  crField :: Maybe String,+  crJunctionIdListNames :: Maybe [String],+  crJunctionReferenceTo :: Maybe [String],+  crRelationshipName :: Maybe String,+  crRestrictedDelte :: Maybe Bool+} deriving Show++data Field = Field{+  fAggregatable :: Maybe Bool,+  fAiPredictionField :: Maybe Bool,+  fAutoNumber :: Maybe Bool,+  fByteLength :: Maybe Int,+  fCalculated :: Maybe Bool,+  fCalculatedFormula :: Maybe String,+  fCascadeDelete :: Maybe Bool,+  fCaseSensitive :: Maybe Bool,+  fCompoundFieldName :: Maybe String,+  fControllerName :: Maybe String,+  fCreateable :: Maybe Bool,+  fCustom :: Maybe Bool,+  fDefaultValue :: Maybe Bool,+  fDefaultValueFormula :: Maybe String,+  fDefaultedOnCreate :: Maybe Bool,+  fDependentPicklist :: Maybe Bool,+  fDeprecatedAndHidden :: Maybe Bool,+  fDigits :: Maybe Int,+  fDisplayLocationInDecimal :: Maybe Bool,+  fEncrypted :: Maybe Bool,+  fExternalId :: Maybe Bool,+  fExtraTypeInfo :: Maybe String,+  fFilterable :: Maybe Bool,+  fFilteredLookupInfo :: Maybe String,+  fFormulaTreatNullNumberAsZero :: Maybe Bool,+  fGroupable :: Maybe Bool,+  fHighScaleNumber :: Maybe Bool,+  fHtmlFormatted :: Maybe Bool,+  fIdLookup :: Maybe Bool,+  fInlineHelpText :: Maybe String,+  fLabel :: Maybe String,+  fLength :: Maybe Int,+  fMask :: Maybe String,+  fMaskType :: Maybe String,+  fName :: Maybe String,+  fNameField :: Maybe Bool,+  fNamePointing :: Maybe Bool,+  fNillable :: Maybe Bool,+  fPermissionable :: Maybe Bool,+  fPicklistValues :: Maybe [PicklistEntry],+  fPolymorphicForeignKey :: Maybe Bool,+  fPrecision :: Maybe Int,+  fQueryByDistance :: Maybe Bool,+  fReferenceTargetField :: Maybe String,+  fReferenceTo :: Maybe [String],+  fRelationshipName :: Maybe String,+  fRelationshipOrder :: Maybe Int,+  fRestrictedDelete :: Maybe Bool,+  fRestrictedPicklist :: Maybe Bool,+  fScale :: Maybe Int,+  fSearchPrefilterable :: Maybe Bool,+  fSoapType :: Maybe String,+  fSortable :: Maybe Bool,+  fType :: Maybe String,+  fUnique :: Maybe Bool,+  fUpdateable :: Maybe Bool,+  fWriteRequiresMasterRead :: Maybe Bool+} deriving Show++data PicklistEntry = PicklistEntry{+  peValidFor :: Maybe String,+  peActive :: Maybe Bool,+  peDefaultValue :: Maybe Bool,+  peLabel :: Maybe String,+  peValue :: Maybe String+} deriving Show++data RecordTypeInfo = RecordTypeInfo{+  rtAvailable :: Maybe Bool,+  rtDefaultRecordTypeMapping :: Maybe Bool,+  rtDeveloperName :: Maybe String,+  rtMaster :: Maybe Bool,+  rtName :: Maybe String,+  rtRecordTypeId :: Maybe String+} deriving Show++data Scope = Scope{+  scopeName :: Maybe String,+  scopeValue :: Maybe String+} deriving Show++data RecordCount = RecordCount{+  rcsObjects :: [SObjectCount]+} deriving Show++data SObjectCount = SObjectCount{+  scCount :: Int,+  scName :: String+} deriving Show++data Version = Version{+  vVersion :: String,+  vLabel :: String,+  vUrl :: String+} deriving Show++data BatchRequest a = BatchRequest{+  brBinaryPartName :: String,+  brMethod :: String,+  brRichInput :: a,+  brUrl :: String,+  brBinaryPartNameAlias :: String+} deriving Show++data Explain = Explain{+  ePlans :: [Plan],+  actionOverrides :: [String],+  activateable :: Bool+} deriving Show++data Plan = Plan{+  pCardinality :: Int,+  pFields :: [String],+  pNotes :: [Note],+  pRelativeCost :: Float,+  pSobjectCardinality :: Int,+  pSobjectType :: String+} deriving Show++data Note = Note{+  nDescription :: String,+  nFields :: [String],+  nTableEnumOrId :: String+} deriving Show++deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "qr" } ''QueryResponse+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "dr" } ''DescribeResponse+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "od" } ''ObjectDescribe+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "dd" } ''DescribeDetail+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "gd" } ''GlobalDescribeResponse+deriveJSON defaultOptions { fieldLabelModifier = drop 2 } ''RecordCount+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "sc" } ''SObjectCount+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "v" } ''Version+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "br" } ''BatchRequest+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "e" } ''Explain+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "p" } ''Plan+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "n" } ''Note+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "f" } ''Field+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "pe" } ''PicklistEntry+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "cr" } ''ChildRelationship+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "rt" } ''RecordTypeInfo+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "scope" } ''Scope+deriveJSON defaultOptions { fieldLabelModifier = defaultJsonLabelFilter "ao" } ''ActionOverride
+ src/HSForce/Util.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module HSForce.Util+    ( defaultJsonLabelFilter,+      tagText,+      replace,+    ) where++import Data.List+import Data.Char+import Text.XML.HaXml+import Text.XML.HaXml.Util+import Text.XML.HaXml.Xtract.Parse++defaultJsonLabelFilter :: String -> String -> String+defaultJsonLabelFilter name = firstLower . drop (length name)++firstLower :: String -> String+firstLower (x:xs) = toLower x : xs+firstLower [] = error "Empty"++tagText :: Content a -> String -> String+tagText result xpath = do+  tagTextContent $ xtract id xpath result !! 0++replace :: String -> String -> String -> String+replace old new src = inner src where+  inner [] = []+  inner str@(x:xs)+    | isPrefixOf old str = new ++ inner (drop (length old) str)+    | otherwise = x:inner xs
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"