erpnext-api-client 0.2.0.0 → 0.3.0.0

raw patch · 12 files changed

+1025/−328 lines, 12 filesdep +aeson-prettydep +scientificPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson-pretty, scientific

API changes (from Hackage documentation)

Files

• CHANGELOG.md +48/−0
• README.md +273/−29
• erpnext-api-client.cabal +14/−6
• src/ERPNext/Client.hs +162/−128
• src/ERPNext/Client/Filter.hs +102/−0
• src/ERPNext/Client/Filters.hs +0/−92
• src/ERPNext/Client/Helper.hs +45/−3
• src/ERPNext/Client/QueryStringParam.hs +68/−0
• src/ERPNext/Client/QueryStringParams.hs +0/−68
• src/ERPNext/Client/Simple.hs +242/−0
• src/ERPNext/Client/Types.hs +65/−0
• test/Main.hs +6/−2

@@ -4,6 +4,54 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.3.0.0] - 2026-06-25+### Fixed++- `getDocList`: When the list of requested fields was not exhaustive+  to parse into the specified record type, `getDocList` ended up to+  parse the response into `Ok _ _ []` instead of `Err _ _`. With this+  bug the response looked like we got no results but in reality it was+  just wrong API use.+- Fix parsing bug in transformation script `gen-openapi-yaml.sh`+  related with comments.++### Changed++- Fix names in public API because these functions actually don't+  operate on DocTypes but on documents:+  - `getDocTypeList` -> `getDocList`+  - `getDocType` -> `getDoc`+  - `postDocType` -> `postDoc`+  - `putDocType` -> `putDoc`+  - `deleteDocType` -> `deleteDoc`+- Renamed modules `QueryStringParams` and `Filters` to singular.++### Added++- `getAllFieldnames` to fetch names of all fields for a given DocType.+- `getDocListAllFields` to fetch list of documents with all their+  fields without explicitly naming them.+- `systemFieldnames` to define some fixed fieldnames like `_user_tags` and `_assign`.+- `IsString` instance for `FilterValue` so that `"my value"` is+  automatically converted to `FilterText "my value"`.+- `showJsonPretty`, `showJsonResponsePretty`, and `showApiResponseDebug`+  for debugging and pretty-printing JSON API responses (adds dependency `aeson-pretty`).+- `andThen` and `andThenWith` to concatenate two API calls passing the+  result of A directly to B.+- Module `ERPNext.Client.Simple` for simple versions of the CRUD+  functions to work JSON `Value` objects instead of strict record types.+- Module `ERPNext.Client.Types` for helpers and types dealing with+  DocType status and booleans.+- Helper functions `isNotFound` and `isForbidden` for easy error+  response interpretation.++## [0.2.1.0] - 2026-03-13++### Added++- Added `docName` method to `IsDocType` class to get the document ID.+- Add doc for `getDocTypeList` about default number of rows.+ ## [0.2.0.0] - 2025-04-12  ### Changed

@@ -17,15 +17,15 @@  CRUD operations on a given DocType are: --   `GET` list of all documents of a DocType (`getDocTypeList`)--   `POST` to create a new document (`postDocType`)--   `GET` a document by name (`getDocType`)--   `PUT` to update a document by name (`putDocType`)--   `DELETE` a document by name (`deleteDocType`)+- `GET` list of all documents of a DocType (`getDocList`)+- `POST` to create a new document (`postDoc`)+- `GET` a document by name (`getDoc`)+- `PUT` to update a document by name (`putDoc`)+- `DELETE` a document by name (`deleteDoc`)  Note: Remote method calls and file uploads are not yet supported. -DocTypes in ERPNext can be extended and newly created by users. This is+In ERPNext, DocTypes can be extended and newly created by users. This is why this library does not come with any predefined types for DocTypes. Instead, users can provide their own types with only the fields they need.@@ -42,7 +42,9 @@ {-# LANGUAGE OverloadedStrings #-}  import ERPNext.Client-import Network.HTTP.Client+import System.Environment+import Data.Text (pack)+import Network.HTTP.Client.TLS import Data.Aeson import GHC.Generics @@ -51,40 +53,175 @@   } deriving Generic  instance FromJSON Customer-instance ToJSON Customer instance IsDocType Customer where   docTypeName = "Customer"+  docName = error "not implemented"  main :: IO () main = do-  let config = mkConfig "https://erpnext.example.com" "api-key" (mkSecret "api-secret")-  manager <- newManager defaultManagerSettings-  response <- getDocType manager config "Company A" :: IO (ApiResponse Customer)+  url <- pack <$> getEnv "ERPNEXT_BASE_URL" -- e.g. "https://my-erpnext.frappe.cloud/api"+  apiKey <- pack <$> getEnv "ERPNEXT_API_KEY"+  apiSecret <- mkSecret . pack <$> getEnv "ERPNEXT_API_SECRET"++  let config = mkConfig url apiKey apiSecret+  manager <- newTlsManager+  response <- ERPNext.Client.getDoc manager config "Company A" :: IO (ApiResponse Customer)   case response of     Ok _ _ c -> putStrLn $ name c-    Err r _ -> print r+    Err r _  -> putStrLn $ show r ``` +For running the example, define these variables in a `.env` file:+ ``` bash-stack runhaskell example1.hs+export ERPNEXT_BASE_URL=https://my-test.frappe.cloud/api+export ERPNEXT_API_KEY=xxxxxx+export ERPNEXT_API_SECRET=yyyyyy ``` +Then, inside this repository directory you can run:++``` bash+. .env+stack runhaskell --package http-client-tls example1.hs+```++## Interactive testing in GHCi++``` example+. .env+stack ghci --package http-client-tls+```++``` haskell+{-# LANGUAGE OverloadedStrings #-}+import ERPNext.Client qualified as Client+import ERPNext.Client.Simple qualified as Simple+import ERPNext.Client.QueryStringParam+import ERPNext.Client.Filter+import Network.HTTP.Client.TLS+import System.Environment+import Data.Aeson+import GHC.Generics++url <- pack <$> getEnv "ERPNEXT_BASE_URL"+apiKey <- pack <$> getEnv "ERPNEXT_API_KEY"+apiSecret <- mkSecret . pack <$> getEnv "ERPNEXT_API_SECRET"++let config = mkConfig url apiKey apiSecret+manager <- newTlsManager++-- Explicitly name the doctype to fetch, "DocType" in this example:+Ok _ jsonResponse _ <- Simple.getDoc manager config "DocType" "Task"+putStrLn $ showJsonPretty jsonResponse++-- Define a DocType. Use :{ and :} in GHCi to paste multi-line Haskell code.+data Customer = Customer+  { name :: Text+  , customer_name :: Text+  } deriving (Show, Generic)+instance FromJSON Customer+instance IsDocType Customer where+  docTypeName = "Customer"+  docName = name++-- Get a customer, infer doctype via type system:+Ok _ jsonResponse parsedCustomer <- Client.getDoc @Customer manager config "Company A"+print parsedCustomer+print $ docName parsedCustomer++-- Get a filtered list of customers, infer doctype via type system:+Ok _ jsonResponse parsedCustomerList <- Client.getDocList @Customer manager config [Fields ["name", "customer_name"], AndFilter [Like "name" "%Test%"]]+print parsedCustomerList++```++## Advanced example use++``` haskell+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE DuplicateRecordFields #-}++import ERPNext.Client+import ERPNext.Client.Filter as Filter+import ERPNext.Client.QueryStringParam+import System.Environment+import Data.Text (Text, pack, unpack, intercalate)+import Network.HTTP.Client.TLS+import Data.Aeson+import GHC.Generics++data Customer = Customer+  { name :: Text+  , customer_name :: Text+  } deriving Generic++instance FromJSON Customer+instance IsDocType Customer where+  docTypeName = "Customer"+  docName = error "not implemented"++data SalesOrder = SalesOrder+  { name :: Text+  , customer :: Text+  } deriving Generic++instance FromJSON SalesOrder+instance IsDocType SalesOrder where+  docTypeName = "Sales Order"+  docName = error "not implemented"++main :: IO ()+main = do+  url <- pack <$> getEnv "ERPNEXT_BASE_URL" -- e.g. "https://my-erpnext.frappe.cloud/api"+  apiKey <- pack <$> getEnv "ERPNEXT_API_KEY"+  apiSecret <- mkSecret . pack <$> getEnv "ERPNEXT_API_SECRET"++  let cfg = mkConfig url apiKey apiSecret+  mgr <- newTlsManager++  -- Get all customers with given customer name:+  customersRes <- getDocList @Customer mgr cfg [Fields ["name", "customer_name"], AndFilter [Filter.Eq "customer_name" "Test Customer"]]+  case customersRes of+    Ok _ _ customers -> putStrLn $ show (length customers) ++ " customer(s)"+    err  -> putStrLn $ "error: \n" ++ showJsonResponsePretty err++  -- Get customer linked to sales order:+  let andThenWithCustomer = andThenWith (\o -> o.customer)+  (salesOrderRes, mCustomerRes) <- getDoc @SalesOrder mgr cfg "SAL-ORD-2026-00002"+                              `andThenWithCustomer` getDoc @Customer mgr cfg+  case (salesOrderRes, mCustomerRes) of+    (Ok _ _ salesOrder, Just (Ok _ _ customer)) -> putStrLn $ unpack salesOrder.name ++ ": " ++ unpack customer.customer_name+    (x, my) -> putStrLn $ "error: \n" ++ showJsonResponsePretty x ++ "\n" ++ maybe "" showJsonResponsePretty my++  res <- getAllFieldnames @Customer mgr cfg+  case res of+    Ok _ _ fieldnames -> putStrLn $ unpack $ intercalate ", " (take 5 fieldnames) <> ", ..."+    err -> putStrLn $ "error: \n" ++ showJsonResponsePretty res+```++``` bash+. .env+stack runhaskell --package http-client-tls example2.hs+```+ ## Scope and Limits --   Only [token-based-    authentication](https://docs.frappe.io/framework/user/en/api/rest#1-token-based-authentication)-    is supported.--   [Remote Method-    Calls](https://docs.frappe.io/framework/user/en/api/rest#remote-method-calls)-    are not yet supported.--   [File-    Uploads](https://docs.frappe.io/framework/user/en/api/rest#file-uploads)-    are not yet supported.+- Only [token-based+  authentication](https://docs.frappe.io/framework/user/en/api/rest#1-token-based-authentication)+  is supported.+- [Remote Method+  Calls](https://docs.frappe.io/framework/user/en/api/rest#remote-method-calls)+  are not yet supported.+- [File+  Uploads](https://docs.frappe.io/framework/user/en/api/rest#file-uploads)+  are not yet supported.  ## Data records for DocTypes  Haskell record types for the DocTypes can be coded by hand which-requires some boiler plate like Aeson instances, handling `null` or+requires some boilerplate like Aeson instances, handling `null` or missing values, and writing helper functions like `mkCustomer`.  This library provides tooling to generate Haskell record types from a@@ -93,17 +230,18 @@  1.  A script generates an [OpenAPI     Specification](https://swagger.io/specification/) file in `yaml`-    format.+    format from your models file. 2.  The     [Haskell-OpenAPI-Client-Code-Generator](https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator/)     generates an Haskell API client, from which only the type     definitions can be used.  The resulting files are a separate Haskell package which can be added as-dependency. The resulting record types can be used together with this+a dependency. The resulting record types can be used together with this API client but the `IsDocType` instance must still be defined by hand. -**The API client part generated from the OpenAPI spec can not be used.**+**Note: The API client part generated from the OpenAPI spec can not be+used.**  Example models file: @@ -118,6 +256,19 @@ SalesOrderItem   name Text   Required name++Item+  item_code Text+  item_name Text+  item_group Text+  default_warehouse Text+  country_of_origin Text+  disabled Int+  is_purchase_item Int+  is_sales_item Int+  is_stock_item Int+  stock_uom Text+  Required item_code item_name is_purchase_item is_sales_item is_stock_item ```  ``` example@@ -141,11 +292,104 @@ │   │   ├── Types     <---- here are the generated types │   │   │   ├── SalesOrder.hs │   │   │   ├── SalesOrderItem.hs+│   │   │   ├── Item.hs │   │   └── Types.hs │   └── ERPNextAPI.hs └── stack.yaml ``` +To include the generated model types in your stack project:++Add to your `stack.yaml`:++``` example+extra-deps:+- …+- ./api-client/+```++In your `package.yaml`:++``` example+dependencies:+- …+- erpnext-api-client-models+```++In your Haskell code:++``` haskell+import ERPNext.Client -- the erpnext-api-client+import ERPNextAPI.Types -- the generated types++…++-- And here some orphan instances:++instance IsDocType SalesOrder where+  docTypeName = "Sales Order"++instance IsDocType Customer where+  docTypeName = "Customer"+```++### Notes on `Maybe` and `Nullable`++In the DocType definition model,++- `Maybe` becomes `Nullable` meaning that the field value can be `null`+  (or `Null` in Haskell).++- Fields **not** listed after `Required` become `Maybe` meaning that the+  fields are optional and `Nothing` will be left out in the JSON+  representation.++Type level:++``` example+Project+  name Text+  project_name Text+  status Text+  project_type Text Maybe+  Required name project_name++data Project = Project+  { projectName :: Text+  , projectProject_name :: Text+  , projectStatus :: Maybe Text+  , projectProject_type :: Maybe (Nullable Text)+  } deriving (Show, Eq)++data ProjectPartial = ProjectPartial+  { projectPartialName :: Maybe Text+  , projectPartialProject_name :: Maybe Text+  , projectPartialStatus :: Maybe Text+  , projectPartialProject_type :: Maybe (Nullable Text)+  } deriving (Show, Eq)+```++For each DocType, two types are generated, e.g. `Project` and+`ProjectPartial`. The `*Partial` version has no required fields i.e. all+fields are `Maybe` and are left out when assigned to `Nothing`.++Value level:++``` example+Project                                             {+  { projectName = "PROJ-001"                          "name": "PROJ-001",+  , projectProject_name = "My Project"      =>        "project_name": "My Project",+  , projectStatus = Nothing+  , projectProject_type = Just Null                   "project_type": null+  }                                                 }+```++``` example+mkProjectPartial                                    {+  { projectProject_name = Just "My Project 2"   =>    "project_name": "My Project"+  }                                                 }+```+ ## Note on TLS problems  If you're running ERPNext in your test environment, chances are that@@ -156,7 +400,6 @@ settings like this:  ``` haskell-import Network.HTTP.Client import Network.HTTP.Client.TLS (mkManagerSettings) import Network.Connection (TLSSettings (..)) @@ -166,14 +409,15 @@       mkManagerSettings         ( TLSSettingsSimple             { settingDisableCertificateValidation = True-            , settingDisableSession = False-            , settingUseServerName = False             }         )         Nothing manager <- Network.HTTP.Client.newManager tlsSettings … ```++Edit the example code from the first section accordingly and run it+with:  ``` bash stack runhaskell --package crypton-connection --package http-client-tls example1.hs

@@ -1,7 +1,7 @@ cabal-version:       3.6  name:                erpnext-api-client-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Generic API client library for ERPNext description:         This is a Haskell API client for ERPNext. It aims to be a light-weight library based on http-client and user-provided record types. homepage:            https://github.com/schoettl/erpnext-api-client@@ -12,20 +12,24 @@ copyright:           2025 Intensovet GmbH category:            API build-type:          Simple-extra-source-files:  README.md+extra-doc-files:     README.md                      CHANGELOG.md  library   hs-source-dirs:      src   exposed-modules:     ERPNext.Client+                     , ERPNext.Client.Types+                     , ERPNext.Client.Simple                      , ERPNext.Client.Helper-                     , ERPNext.Client.Filters-                     , ERPNext.Client.QueryStringParams+                     , ERPNext.Client.Filter+                     , ERPNext.Client.QueryStringParam   build-depends:       base >= 4.7 && < 5                      , http-client                      , http-types                      , text                      , aeson+                     , aeson-pretty+                     , scientific                      , time                      , network-uri                      , bytestring@@ -44,9 +48,11 @@   type:                exitcode-stdio-1.0   main-is:             Main.hs   other-modules:       ERPNext.Client+                     , ERPNext.Client.Types+                     , ERPNext.Client.Simple                      , ERPNext.Client.Helper-                     , ERPNext.Client.Filters-                     , ERPNext.Client.QueryStringParams+                     , ERPNext.Client.Filter+                     , ERPNext.Client.QueryStringParam   hs-source-dirs:      test                      , src   build-depends:       base@@ -55,6 +61,8 @@                      , http-types                      , text                      , aeson+                     , aeson-pretty+                     , scientific                      , time                      , network-uri                      , bytestring

@@ -14,58 +14,100 @@ -}  module ERPNext.Client-  ( getDocTypeList-  , getDocType-  , postDocType-  , putDocType-  , deleteDocType+  ( getDocList+  , getDoc+  , postDoc+  , putDoc+  , deleteDoc   , mkSecret   , mkConfig   , IsDocType (..)-  , Config ()-  , Secret ()+  , Config+  , Secret   , QueryStringParam (..)   , ApiResponse (..)+  , Fieldname   , getResponse+  , andThen+  , andThenWith+  , getDocListAllFields+  , getAllFieldnames+  , systemFieldnames+  , showJsonResponsePretty+  , showApiResponseDebug   ) where -import Network.HTTP.Client (Response (..), Request (..), Manager, httpLbs, parseRequest, RequestBody (..))-import Network.HTTP.Types (hAuthorization, hContentType, Header)-import Data.Text hiding (map)-import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client (Manager)+import Data.Text hiding (map, filter, null) import Data.Aeson-import Data.ByteString qualified as BS-import Data.ByteString.Lazy qualified as LBS-import ERPNext.Client.QueryStringParams-import ERPNext.Client.Helper (urlEncode)+import Data.Aeson.Types (parseEither)+import ERPNext.Client.Filter (Fieldname)+import ERPNext.Client.QueryStringParam+import ERPNext.Client.Simple qualified as Simple+import ERPNext.Client.Simple (ApiResponse (..), Config, Secret, mkSecret, mkConfig, showJsonResponsePretty, showApiResponseDebug, getResponse)  -- | Type class for types which represent an ERPNext DocType. -- Each DocType has a unique name but there can still be multiple -- „views“ (i.e. records types) for one DocType. class IsDocType a where+  -- | The DocType name, e.g. „Sales Order“.   docTypeName :: Text+  -- | The document identifier - called @name@ in ERPNext.+  --+  -- Caveat: A type implementing this class may not have the name+  -- field or its value may be 'Nothing', for example when the record+  -- is used with POST to create a new document.+  docName :: a -> Text  {-|   Get a list of all documents of a given DocType.   The 'QueryStringParam's can select fields, filter, order, enable   paging, and more.++  Warning: The resulting list is limited to 20 items by default+  (@limit_page_length=20@, see API documentation <https://docs.frappe.io/framework/user/en/api/rest#listing-documents>).+  Use 'ERPNext.Client.QueryStringParam.LimitPageLength' to set a different limit. -}-getDocTypeList :: forall a. (IsDocType a, FromJSON a)-               => Manager -> Config  -> [QueryStringParam]-> IO (ApiResponse [a])-getDocTypeList manager config qsParams = do-  let path = getResourcePath @a <> "?" <> renderQueryStringParams qsParams-  request <- createRequest config path "GET"-  response <- httpLbs request manager-  return $ parseGetResponse response+getDocList :: forall a. (IsDocType a, FromJSON a)+               => Manager -> Config -> [QueryStringParam] -> IO (ApiResponse [a])+getDocList manager config qsParams = do+  let queryString = if null qsParams then Nothing else Just (renderQueryStringParams qsParams)+  response <- Simple.getDocList manager config (docTypeName @a) queryString+  return $ parseListResponse response+  where+    parseListResponse (Err resp err) = Err resp err+    parseListResponse (Ok resp val values) =+      case traverse fromJSON values of+        Success parsedList -> Ok resp val parsedList+        Error err -> Err resp (Just (val, pack err)) +{-|+  Get a list of all documents of a given DocType including all fields.++  By default, only the @name@ field is fetched. See 'getDocList' for more details.++  System fields like @_assign@ and @_user_tags@ are not+  included, they are not part of the DocType definition.+-}+getDocListAllFields :: forall a. (IsDocType a, FromJSON a)+               => Manager+               -> Config+               -> [QueryStringParam]+               -> IO (ApiResponse [Fieldname], Maybe (ApiResponse [a]))+getDocListAllFields manager config qsParams = do+  getAllFieldnames @a manager config+    `andThen`+    (\fieldnames -> getDocList manager config $ Fields fieldnames : filter noFields qsParams)+  where+    noFields (Fields _) = False+    noFields _ = True+ -- | Get a single document of a given DocType by name.-getDocType :: forall a. (IsDocType a, FromJSON a)+getDoc :: forall a. (IsDocType a, FromJSON a)            => Manager -> Config -> Text -> IO (ApiResponse a)-getDocType manager config name = do-  let path = getResourcePath @a <> "/" <> name-  request <- createRequest config path "GET"-  response <- httpLbs request manager-  return $ parseGetResponse response+getDoc manager config name = do+  response <- Simple.getDoc manager config (docTypeName @a) name+  return $ parseTypedResponse response  {- | Delete a single document of a given DocType by name. @@ -73,127 +115,119 @@ A customer can be deleted like this:  @-res \<- deleteDocType @Customer manager config "customer name"+res \<- deleteDoc @Customer manager config "customer name" @ -}-deleteDocType :: forall a. (IsDocType a)+deleteDoc :: forall a. (IsDocType a)               => Manager -> Config -> Text -> IO (ApiResponse ())-deleteDocType manager config name = do-  let path = getResourcePath @a <> "/" <> name-  request <- createRequest config path "DELETE"-  response <- httpLbs request manager-  return $ parseDeleteResponse response+deleteDoc manager config name =+  Simple.deleteDoc manager config (docTypeName @a) name  -- | Create a new document of a given DocType.-postDocType :: forall a. (IsDocType a, FromJSON a, ToJSON a)+postDoc :: forall a. (IsDocType a, FromJSON a, ToJSON a)             => Manager -> Config -> a -> IO (ApiResponse a)-postDocType manager config doc = do-  let path = getResourcePath @a-  request <- createRequestWithBody config path "POST" doc-  response <- httpLbs request manager-  return $ parseGetResponse response+postDoc manager config doc = do+  response <- Simple.postDoc manager config (docTypeName @a) (toJSON doc)+  return $ parseTypedResponse response  -- | Update a document of a given DocType by name.-putDocType :: forall a. (IsDocType a, FromJSON a, ToJSON a)+putDoc :: forall a. (IsDocType a, FromJSON a, ToJSON a)            => Manager -> Config -> Text -> a -> IO (ApiResponse a)-putDocType manager config name doc = do-  let path = getResourcePath @a <> "/" <> name-  request <- createRequestWithBody config path "PUT" doc-  response <- httpLbs request manager-  return $ parseGetResponse response+putDoc manager config name doc = do+  response <- Simple.putDoc manager config (docTypeName @a) name (toJSON doc)+  return $ parseTypedResponse response --- | Create an API client configuration.-mkConfig :: Text -> Text -> Secret -> Config-mkConfig baseUrl apiKey apiSecret = Config-  { baseUrl = baseUrl-  , apiKey = apiKey-  , apiSecret = apiSecret-  }+-- Helper function to convert ApiResponse Value to ApiResponse a+parseTypedResponse :: FromJSON a => ApiResponse Value -> ApiResponse a+parseTypedResponse (Ok response val jsonVal) =+  case fromJSON jsonVal of+    Success a -> Ok response val a+    Error err -> Err response (Just (val, pack err))+parseTypedResponse (Err response err) = Err response err --- | Create the API secret used together with the API key for authorization.-mkSecret :: Text -> Secret-mkSecret = Secret+{-|+This function helps to sequentially execute two API calls A and B by+passing some part of A's result to B. This can reduce the number of case+expressions to one. +@+  let andThen = andThenWith customer+  (salesOrder', mCustomer') <- getDoc @SalesOrder mgr cfg "SAL-ORD-2025-00031"+                                `andThen` getDoc @Customer mgr cfg+@ --- | Create the API 'Request'.-createRequest :: Config -> Text -> BS.ByteString -> IO Request-createRequest config path method = do-  request <- parseRequest $ unpack (baseUrl config <> path)-  return request-    { method = method-    , requestHeaders = [mkAuthHeader config]-    }+It can easily combine: TODO:untested --- | Create the API 'Request' with a JSON body.-createRequestWithBody :: ToJSON a => Config -> Text -> BS.ByteString -> a -> IO Request-createRequestWithBody config path method doc = do-  request <- parseRequest $ unpack (baseUrl config <> path)-  return request-    { method = method-    , requestHeaders = mkAuthHeader config : [(hContentType, encodeUtf8 "application/json")]-    , requestBody = RequestBodyLBS (encode doc)-    }+- 'getDoc' and 'getDoc'+- 'getDoc' and 'deleteDoc' --- | API client configuration.-data Config = Config-  { baseUrl :: Text-  , apiKey :: Text-  , apiSecret :: Secret-  }+But it can also combine all other API calls with a proper+transformation @f@ and the use of 'mapM' for wrapping B. --- | Opaque type to store the API secret.-data Secret = Secret-  { getSecret :: Text-  }+To use it as infix operator, you need to apply the transformation+function @f@ to 'andThenWith' and bind that to a name like+@andThenWithCustomerField@. --- | Data wrapper type just to parse the JSON returned by ERPNext.-data DataWrapper a = DataWrapper { getData :: a }-  deriving Show+Examples: TODO:untested -instance FromJSON a => FromJSON (DataWrapper a) where-  parseJSON = withObject "DataWrapper" $ \obj -> do-    dataValue <- obj .: "data"-    return (DataWrapper dataValue)+@+  -- delete all Sales Orders of Customer+  getDoc @Customer mgr cfg "Company A" `andThenWithTheirSalesOrders` mapM (deleteDoc @SalesOrder mgr cfg) --- | The API response.-data ApiResponse a-  = Ok -- ^ The OK response.-      (Response LBS.ByteString) -- ^ The server's full response including header information.-      Value -- ^ The returned JSON.-      a -- ^ The result parsed from the returned JSON.-  | Err -- ^ The error response.-      (Response LBS.ByteString) -- ^ The server's full response including header information.-      (Maybe (Value, Text)) -- ^ If the response is valid JSON, 'Just' the returned JSON and-                            -- the parse error message telling why 'Value' couldn't be parsed-                            -- into @a@.-  deriving Show+  -- update all Customer matching query+  getDocList @Customer mgr cfg query `andThenWithCustomerName` mapM_ (\(name, updatedDoc) -> putDoc @Customer mgr cfg name updatedDoc)+@ --- | Get the full response from the API response.-getResponse :: ApiResponse a -> Response LBS.ByteString-getResponse (Ok r _ _) = r-getResponse (Err r _) = r+-}+andThenWith+  :: (a -> c)+  -> IO (ApiResponse a)+  -> (c -> IO (ApiResponse b))+  -> IO (ApiResponse a, Maybe (ApiResponse b))+andThenWith f io1 io2 = do+  res1 <- io1+  case res1 of+    (Err _ _) -> return (res1, Nothing)+    (Ok _ _ x) -> do+      res <- io2 (f x)+      return (res1, Just res) -mkAuthHeader :: Config -> Header-mkAuthHeader config = let authToken = apiKey config <> ":" <> getSecret (apiSecret config)-                          in (hAuthorization, encodeUtf8 $ "token " <> authToken)+andThen+  :: IO (ApiResponse a)+  -> (a -> IO (ApiResponse b))+  -> IO (ApiResponse a, Maybe (ApiResponse b))+andThen = andThenWith id -parseGetResponse :: forall a. FromJSON a => Response LBS.ByteString -> ApiResponse a-parseGetResponse response =-  case decode @Value (responseBody response) of-    Just value -> case fromJSON value :: Result (DataWrapper a) of-      Success result -> Ok response value (getData result)-      Error err -> Err response (Just (value, pack err))-    Nothing -> Err response Nothing+-- | Get all fieldnames for a given DocType. These won't include the+-- fields from 'systemFieldnames'.+getAllFieldnames :: forall a. (IsDocType a)+               => Manager+               -> Config+               -> IO (ApiResponse [Fieldname])+getAllFieldnames manager config = do+  response <- Simple.getDoc manager config "DocType" (docTypeName @a)+  return $ parseResponse response+  where+    parseResponse (Err resp err) = Err resp err+    parseResponse (Ok resp val jsonVal) =+      case parseEither parseFieldnames jsonVal of+        Right fieldnames -> Ok resp val fieldnames+        Left err -> Err resp (Just (val, pack err)) -parseDeleteResponse :: Response LBS.ByteString -> ApiResponse ()-parseDeleteResponse response =-  case decode @Value (responseBody response) of-    Just value -> case fromJSON value :: Result (DataWrapper Text) of-      Success (DataWrapper message)-        | message == "ok" -> Ok response value ()-        | otherwise -> Err response (Just (value, message))-      Error err -> Err response (Just (value, pack err))-    Nothing -> Err response Nothing+    parseFieldnames = withObject "DocType" $ \obj -> do+      fieldsArray <- obj .: "fields"+      mapM extractFieldName fieldsArray+      where+        extractFieldName = withObject "Field" $ \fieldObj ->+          fieldObj .: "fieldname" -getResourcePath :: forall a. IsDocType a => Text-getResourcePath = "/resource/" <> urlEncode (docTypeName @a)+-- | Fixed ERPNext system field names that all DocTypes have in common.+--+-- These are not included in 'getAllFieldnames's response.+systemFieldnames :: [Fieldname]+systemFieldnames =+  [ "_assign"+  , "_user_tags"+  , "_liked_by"+  , "_comments"+  ]

@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module ERPNext.Client.Filter+  ( Filter (..)+  , Fieldname+  , FilterValue (..)+  , renderFilters+  ) where++import Data.Text (Text, intercalate, pack) -- pack is used in doctests!+import Data.Time.Calendar (Day)+import Data.String+import ERPNext.Client.Helper++-- | Filter that can be used as arguments for+-- 'ERPNext.Client.QueryStringParam.AndFilter' or+-- 'ERPNext.Client.QueryStringParam.OrFilter'.+--+-- The filters are case-insensitive on API server side!+-- I verified by testing this with 'Eq', 'Like', and 'In'.+data Filter+  = Eq Fieldname FilterValue+  | NotEq Fieldname FilterValue+  | Greater Fieldname FilterValue+  | GreaterOrEq Fieldname FilterValue+  | Less Fieldname FilterValue+  | LessOrEq Fieldname FilterValue+  | Like Fieldname FilterValue+  | NotLike Fieldname FilterValue+  | In Fieldname [FilterValue]+  | NotIn Fieldname [FilterValue]+  | Between Fieldname FilterValue FilterValue+  | IsNull Fieldname+  | IsNotNull Fieldname+  deriving (Show, Eq)++data FilterValue+  = FilterText Text+  | FilterNumber Double+  | FilterBool Bool+  | FilterDay Day+  deriving (Show, Eq)++instance IsString FilterValue where+  fromString = FilterText . pack++renderFilter :: Filter -> Text+renderFilter f =+  case f of+    Eq field val         -> renderWithValue field "=" val+    NotEq field val      -> renderWithValue field "!=" val+    Greater field val    -> renderWithValue field ">" val+    GreaterOrEq field val-> renderWithValue field ">=" val+    Less field val       -> renderWithValue field "<" val+    LessOrEq field val   -> renderWithValue field "<=" val+    Like field val       -> renderWithValue field "like" val+    NotLike field val    -> renderWithValue field "not like" val+    In field vals        -> renderWithArray field "in" vals+    NotIn field vals     -> renderWithArray field "not in" vals+    Between field val1 val2    -> renderWithArray field "between" [val1, val2]+    IsNull field         -> renderWithText field "is" "not set"+    IsNotNull field      -> renderWithText field "is" "set"++renderWithValue :: Fieldname -> Text -> FilterValue -> Text+renderWithValue field op val =+  renderTextArray [quote field, quote op, renderFilterValue val]++renderWithText :: Fieldname -> Text -> Text -> Text+renderWithText field op txt =+  renderTextArray [quote field, quote op, quote txt]++renderWithArray :: Fieldname -> Text -> [FilterValue] -> Text+renderWithArray field op vals =+  renderTextArray [quote field, quote op, renderTextArray (map renderFilterValue vals)]++renderTextArray :: [Text] -> Text+renderTextArray xs =+  "[" <> intercalate "," xs <> "]"++renderFilterValue :: FilterValue -> Text+renderFilterValue fv =+  case fv of+    FilterText t -> quote t+    FilterNumber n -> tshow n+    FilterBool b -> if b then "1" else "0"+    FilterDay d -> quote (tshow d)++-- | Render the filter terms for the URL query string.+--+-- >>> urlDecode $ renderFilters [Eq (pack "idx") (FilterNumber 99)]+-- "[[\"idx\",\"=\",99.0]]"+--+-- >>> urlDecode $ renderFilters [IsNull (pack "status"), In (pack "name") [FilterText (pack "a"), FilterText (pack "b")]]+-- "[[\"status\",\"is\",\"not set\"],[\"name\",\"in\",[\"a\",\"b\"]]]"+--+renderFilters :: [Filter] -> Text+renderFilters filters =+  let+    encoded = map renderFilter filters+    str = "[" <> intercalate "," encoded <> "]"+  in+    urlEncode str

@@ -1,92 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module ERPNext.Client.Filters-  ( Filter (..)-  , Fieldname-  , FilterValue (..)-  , renderFilters-  ) where--import Data.Text (Text, intercalate, pack) -- pack is used in doctests!-import Data.Time.Calendar (Day)-import ERPNext.Client.Helper--data Filter-  = Eq Fieldname FilterValue-  | NotEq Fieldname FilterValue-  | Greater Fieldname FilterValue-  | GreaterOrEq Fieldname FilterValue-  | Less Fieldname FilterValue-  | LessOrEq Fieldname FilterValue-  | Like Fieldname FilterValue-  | NotLike Fieldname FilterValue-  | In Fieldname [FilterValue]-  | NotIn Fieldname [FilterValue]-  | Between Fieldname FilterValue FilterValue-  | IsNull Fieldname-  | IsNotNull Fieldname-  deriving (Show, Eq)--data FilterValue-  = FilterText Text-  | FilterNumber Double-  | FilterBool Bool-  | FilterDay Day-  deriving (Show, Eq)--renderFilter :: Filter -> Text-renderFilter f =-  case f of-    Eq field val         -> renderWithValue field "=" val-    NotEq field val      -> renderWithValue field "!=" val-    Greater field val    -> renderWithValue field ">" val-    GreaterOrEq field val-> renderWithValue field ">=" val-    Less field val       -> renderWithValue field "<" val-    LessOrEq field val   -> renderWithValue field "<=" val-    Like field val       -> renderWithValue field "like" val-    NotLike field val    -> renderWithValue field "not like" val-    In field vals        -> renderWithArray field "in" vals-    NotIn field vals     -> renderWithArray field "not in" vals-    Between field val1 val2    -> renderWithArray field "between" [val1, val2]-    IsNull field         -> renderWithText field "is" "not set"-    IsNotNull field      -> renderWithText field "is" "set"--renderWithValue :: Fieldname -> Text -> FilterValue -> Text-renderWithValue field op val =-  renderTextArray [quote field, quote op, renderFilterValue val]--renderWithText :: Fieldname -> Text -> Text -> Text-renderWithText field op txt =-  renderTextArray [quote field, quote op, quote txt]--renderWithArray :: Fieldname -> Text -> [FilterValue] -> Text-renderWithArray field op vals =-  renderTextArray [quote field, quote op, renderTextArray (map renderFilterValue vals)]--renderTextArray :: [Text] -> Text-renderTextArray xs =-  "[" <> intercalate "," xs <> "]"--renderFilterValue :: FilterValue -> Text-renderFilterValue fv =-  case fv of-    FilterText t -> quote t-    FilterNumber n -> tshow n-    FilterBool b -> if b then "1" else "0"-    FilterDay d -> quote (tshow d)---- | Render the filter terms for the URL query string.------ >>> urlDecode $ renderFilters [Eq (pack "idx") (FilterNumber 99)]--- "[[\"idx\",\"=\",99.0]]"------ >>> urlDecode $ renderFilters [IsNull (pack "status"), In (pack "name") [FilterText (pack "a"), FilterText (pack "b")]]--- "[[\"status\",\"is\",\"not set\"],[\"name\",\"in\",[\"a\",\"b\"]]]"----renderFilters :: [Filter] -> Text-renderFilters filters =-  let-    encoded = map renderFilter filters-    str = "[" <> intercalate "," encoded <> "]"-  in-    urlEncode str

@@ -2,34 +2,76 @@  module ERPNext.Client.Helper   ( urlEncode+  , urlEncodeQueryString   , urlDecode+  , showJsonPretty   , quote   , tshow+  , isNotFound+  , isForbidden   , Fieldname   ) where -import Data.Text+import Data.Text (Text, pack, unpack, replace) import Network.URI (escapeURIString, isUnreserved, unEscapeString)+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Encoding (decodeUtf8)+import Data.Aeson (ToJSON)+import Data.Aeson.Encode.Pretty (encodePretty)+import Network.HTTP.Client+import Network.HTTP.Types (Status(statusCode))  -- | Type for field names of DocTypes. type Fieldname = Text --- | Percent-encode string for use in a URL.+-- | Percent-encode string for use in a URL including the characters "&=".+--+-- >>> urlEncode $ pack "[&]"+-- "%5B%26%5D" urlEncode :: Text -> Text urlEncode = pack . escapeURIString isUnreserved . unpack +-- | Percent-encode string for use in a URL but not the characters "&=".+--+-- This retains "&" to separate key-value pairs and "=" to separate keys from values.+--+-- >>> urlEncodeQueryString $ pack "fields=[\"project_name\"]&page_limit_length=10"+-- "fields=%5B%22project_name%22%5D&page_limit_length=10"+urlEncodeQueryString :: Text -> Text+urlEncodeQueryString = pack . escapeURIString isUnresveredInQueryString . unpack+  where+    isUnresveredInQueryString c = isUnreserved c || c `elem` ("&=" :: String)+ -- | Opposite of 'urlEncode'.+--+-- >>> urlDecode $ pack "%20"+-- " " urlDecode :: Text -> Text urlDecode = pack . unEscapeString . unpack +-- | Show JSON in pretty-print format.+showJsonPretty :: ToJSON a => a -> String+showJsonPretty = TL.unpack . decodeUtf8 . encodePretty  -- TODO: better use decodeUtf8Lenient?+ sanitizeQuotes :: Text -> Text sanitizeQuotes = replace "\"" "\\\""  -- | Double-quote string after backslash-escaping existing double quotes.+--+-- >>> quote $ pack "text with \""+-- "\"text with \\\"\"" quote :: Text -> Text quote t = "\"" <> sanitizeQuotes t <> "\"" --- | 'show' but return 'Text'.+-- | 'show' but return 'Text'. text-2.1.2 adds a new function 'show'+-- that could make this one redundant. tshow :: Show a => a -> Text tshow = pack . show +-- | Test if response is HTTP 404 Not Found.+isNotFound :: Response a -> Bool+isNotFound = (==404) . statusCode . responseStatus++-- | Test if response is HTTP 403 Forbidden.+isForbidden :: Response a -> Bool+isForbidden = (==403) . statusCode . responseStatus

@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}++module ERPNext.Client.QueryStringParam+  ( QueryStringParam (..)+  , renderQueryStringParams+  ) where++import ERPNext.Client.Filter+import ERPNext.Client.Helper+import Data.Text hiding (map)++-- https://docs.frappe.io/framework/user/en/api/rest++data QueryStringParam+  = Debug Bool -- ^ If 'True', makes API returning query analysis info instead of data+  | AsDict Bool -- ^ If 'False', makes API returning the data records as mixed-type arrays which cannot be parsed by this library (default: 'True')+  | LimitStart Int -- ^ Page offset (starts at 0)+  | LimitPageLength Int -- ^ Page size+  | Asc Fieldname -- ^ Ascending order by given field+  | Desc Fieldname -- ^ Descending order by given field+  | Fields [Fieldname] -- ^ Select fields+  | AndFilter [Filter] -- ^ Filter terms combined with logical AND+  | OrFilter [Filter] -- ^ Filter terms combined with logical OR++renderQueryStringParam :: QueryStringParam -> Text+renderQueryStringParam qsParam =+  case qsParam of+    Debug b -> "debug=" <> tshow b+    AsDict b -> "as_dict=" <> tshow b+    LimitStart offset -> "limit_start=" <> tshow (max 0 offset)+    LimitPageLength n -> "limit=" <> tshow (max 0 n) -- it was named limit_page_length up to v13++    Asc field ->+      "order_by=" <> renderOrderBy field "asc"++    Desc field ->+      "order_by=" <> renderOrderBy field "desc"++    Fields fields ->+      "fields=" <> renderFields fields++    AndFilter filters ->+      "filters=" <> renderFilters filters++    OrFilter filters ->+      "or_filters=" <> renderFilters filters++renderFields :: [Fieldname] -> Text+renderFields fields =+  urlEncode ("[" <> intercalate "," (map quote fields) <> "]")++renderOrderBy :: Fieldname -> Text -> Text+renderOrderBy field order =+  urlEncode (field <> " " <> order)++-- | Render the query string for the URL.+--+-- >>> renderQueryStringParams []+-- ""+--+-- >>> renderQueryStringParams [LimitStart 20, LimitPageLength 10]+-- "limit_start=20&limit=10"+--+-- >>> urlDecode $ renderQueryStringParams [Fields [pack "id", pack "name"], Asc (pack "idx")]+-- "fields=[\"id\",\"name\"]&order_by=idx asc"+--+renderQueryStringParams :: [QueryStringParam] -> Text+renderQueryStringParams params = intercalate "&" (map renderQueryStringParam params)

@@ -1,68 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module ERPNext.Client.QueryStringParams-  ( QueryStringParam (..)-  , renderQueryStringParams-  ) where--import ERPNext.Client.Filters-import ERPNext.Client.Helper-import Data.Text hiding (map)---- https://docs.frappe.io/framework/user/en/api/rest--data QueryStringParam-  = Debug Bool -- ^ If 'True', makes API returning query analysis info instead of data-  | AsDict Bool -- ^ If 'False', makes API returning the data records as mixed-type arrays which cannot be parsed by this library (default: 'True')-  | LimitStart Int -- ^ Page offset (starts at 0)-  | LimitPageLength Int -- ^ Page size-  | Asc Fieldname -- ^ Ascending order by given field-  | Desc Fieldname -- ^ Descending order by given field-  | Fields [Fieldname] -- ^ Select fields-  | AndFilter [Filter] -- ^ Filter terms combined with logical AND-  | OrFilter [Filter] -- ^ Filter terms combined with logical OR--renderQueryStringParam :: QueryStringParam -> Text-renderQueryStringParam qsParam =-  case qsParam of-    Debug b -> "debug=" <> tshow b-    AsDict b -> "as_dict=" <> tshow b-    LimitStart offset -> "limit_start=" <> tshow (max 0 offset)-    LimitPageLength n -> "limit=" <> tshow (max 0 n) -- it was named limit_page_length up to v13--    Asc field ->-      "order_by=" <> renderOrderBy field "asc"--    Desc field ->-      "order_by=" <> renderOrderBy field "desc"--    Fields fields ->-      "fields=" <> renderFields fields--    AndFilter filters ->-      "filters=" <> renderFilters filters--    OrFilter filters ->-      "or_filters=" <> renderFilters filters--renderFields :: [Fieldname] -> Text-renderFields fields =-  urlEncode ("[" <> intercalate "," (map quote fields) <> "]")--renderOrderBy :: Fieldname -> Text -> Text-renderOrderBy field order =-  urlEncode (field <> " " <> order)---- | Render the query string for the URL.------ >>> renderQueryStringParams []--- ""------ >>> renderQueryStringParams [LimitStart 20, LimitPageLength 10]--- "limit_start=20&limit=10"------ >>> urlDecode $ renderQueryStringParams [Fields [pack "id", pack "name"], Asc (pack "idx")]--- "fields=[\"id\",\"name\"]&order_by=idx asc"----renderQueryStringParams :: [QueryStringParam] -> Text-renderQueryStringParams params = intercalate "&" (map renderQueryStringParam params)

@@ -0,0 +1,242 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Description: Simple API client for ERPNext with minimal type requirements++This module provides basic API functions that work with JSON Values directly+and take DocType names as Text arguments, making it easier to use when you+don't want to define custom types.+-}++module ERPNext.Client.Simple+  ( getDocList+  , getDoc+  , postDoc+  , putDoc+  , deleteDoc+  , mkSecret+  , mkConfig+  , getResponse+  , showJsonResponsePretty+  , showApiResponseDebug+  , ApiResponse (..)+  , Config+  , Secret+  ) where++import Network.HTTP.Client (Manager, httpLbs, Response (..), Request (..), parseRequest, RequestBody (..))+import Network.HTTP.Types (hAuthorization, hContentType, Header, statusCode, statusMessage)+import Data.ByteString.Char8 qualified as BS8+import Data.Text hiding (show, length, concatMap, null)+import Data.Text.Encoding (encodeUtf8)+import Data.Aeson (Value (..), FromJSON (..), Result (..), fromJSON, decode, encode, ToJSON, withObject, (.:))+import Data.Aeson.KeyMap qualified as KeyMap+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as LBS+import ERPNext.Client.Helper (urlEncode, showJsonPretty)++-- | API client configuration.+data Config = Config+  { baseUrl :: Text+  , apiKey :: Text+  , apiSecret :: Secret+  }++-- | Opaque type to store the API secret.+data Secret = Secret+  { getSecret :: Text+  }++-- | Create an API client configuration.+mkConfig+  :: Text -- ^ The API base URL, e.g. @https://erpnext.example.com/api"@.+  -> Text -- ^ The API key.+  -> Secret -- ^ The API secret.+  -> Config+mkConfig baseUrl apiKey apiSecret = Config+  { baseUrl = baseUrl+  , apiKey = apiKey+  , apiSecret = apiSecret+  }++-- | Create the API secret used together with the API key for authorization.+mkSecret :: Text -> Secret+mkSecret = Secret++-- | Data wrapper type just to parse the JSON returned by ERPNext.+data DataWrapper a = DataWrapper { getData :: a }+  deriving Show++instance FromJSON a => FromJSON (DataWrapper a) where+  parseJSON = withObject "DataWrapper" $ \obj -> do+    dataValue <- obj .: "data"+    return (DataWrapper dataValue)++-- | The API response.+data ApiResponse a+  = Ok -- ^ The OK response.+      (Response LBS.ByteString) -- ^ The server's full response including header information.+      Value -- ^ The returned JSON.+      a -- ^ The result parsed from the returned JSON.+  | Err -- ^ The error response.+      (Response LBS.ByteString) -- ^ The server's full response including header information.+      (Maybe (Value, Text)) -- ^ If the response is valid JSON, 'Just' the returned JSON and+                            -- the parse error message telling why 'Value' couldn't be parsed+                            -- into @a@.+  deriving Show++instance Functor ApiResponse where+  fmap f (Ok response val x) = Ok response val (f x)+  fmap _ (Err response err)  = Err response err++-- | Pretty-print JSON API response or print HTTP status and message+-- if response is no valid JSON.+showJsonResponsePretty :: ApiResponse a -> String+showJsonResponsePretty (Ok _ val _) = showJsonPretty val+showJsonResponsePretty (Err _ (Just (val, _))) = showJsonPretty val+showJsonResponsePretty (Err _ Nothing) = "{}"++showApiResponseDebug :: ApiResponse a -> String+showApiResponseDebug response =+  "HTTP " ++ show (statusCode status) ++ " "+   ++ BS8.unpack (statusMessage status)+   ++ "\n\n"+   ++ body+  where+    status = responseStatus $ getResponse response+    body = case response of+      (Ok _ val _) -> showJsonPretty val+      (Err _ (Just (val, _))) ->+        let mainOutput = showJsonPretty val+            excOutput = maybe "" ("\n\nParsed \"exc\" field:\n" ++) $ extractExceptionTraceback val+        in mainOutput ++ excOutput+      (Err _ Nothing) -> "No valid JSON response."++-- | Extract and parse the "exc" field content from a JSON object.+extractExceptionTraceback :: Value -> Maybe String+extractExceptionTraceback (Object obj) = do+  String excStr <- KeyMap.lookup "exc" obj+  Array arr <- decode @Value $ LBS.fromStrict $ encodeUtf8 excStr+  let content = concatMap extractStringContent arr+  if null content then Nothing else Just content+  where+    extractStringContent (String s) = unpack s+    extractStringContent _ = ""+extractExceptionTraceback _ = Nothing++-- | Get the full response from the API response.+getResponse :: ApiResponse a -> Response LBS.ByteString+getResponse (Ok r _ _) = r+getResponse (Err r _) = r++-- | Create the API 'Request'.+createRequest :: Config -> Text -> BS.ByteString -> IO Request+createRequest config path method = do+  request <- parseRequest $ unpack (baseUrl config <> path)+  return request+    { method = method+    , requestHeaders = [mkAuthHeader config]+    }++-- | Create the API 'Request' with a JSON body.+createRequestWithBody :: ToJSON a => Config -> Text -> BS.ByteString -> a -> IO Request+createRequestWithBody config path method doc = do+  request <- parseRequest $ unpack (baseUrl config <> path)+  return request+    { method = method+    , requestHeaders = mkAuthHeader config : [(hContentType, encodeUtf8 "application/json")]+    , requestBody = RequestBodyLBS (encode doc)+    }++mkAuthHeader :: Config -> Header+mkAuthHeader config = let authToken = apiKey config <> ":" <> getSecret (apiSecret config)+                          in (hAuthorization, encodeUtf8 $ "token " <> authToken)++parseGetResponse :: forall a. FromJSON a => Response LBS.ByteString -> ApiResponse a+parseGetResponse response =+  case decode @Value (responseBody response) of+    Just value -> case fromJSON value :: Result (DataWrapper a) of+      Success result -> Ok response value (getData result)+      Error err -> Err response (Just (value, pack err))+    Nothing -> Err response Nothing++parseDeleteResponse :: Response LBS.ByteString -> ApiResponse ()+parseDeleteResponse response =+  case decode @Value (responseBody response) of+    Just value -> case fromJSON value :: Result (DataWrapper Text) of+      Success (DataWrapper message)+        | message == "ok" -> Ok response value ()+        | otherwise -> Err response (Just (value, message))+      Error err -> Err response (Just (value, pack err))+    Nothing -> Err response Nothing++-- | Get a list of documents for a given DocType name.+--+-- The passed query string is used as is. To properly encode it, use+-- 'ERPNext.Helper.urlEncodeQueryString'.+-- It's a bit tricky because both, ERPNext and the http-client package+-- have certain expectations on how the query string must be encoded.+--+-- @+-- res <- getDocList manager config "Customer" (Just $ urlEncodeQueryString "fields=[\"customer_name\"]&page_limit_length=10")+-- @+--+getDocList :: Manager+           -> Config+           -> Text -- ^ DocType name+           -> Maybe Text -- ^ Optional query string filter (used in URL as is)+           -> IO (ApiResponse [Value])+getDocList manager config docTypeName mFilter = do+  let path = "/resource/" <> urlEncode docTypeName <> maybe "" ("?" <>) mFilter+  request <- createRequest config path "GET"+  response <- httpLbs request manager+  return $ parseGetResponse response++-- | Get a single document by DocType name and document name.+getDoc :: Manager+       -> Config+       -> Text -- ^ DocType name+       -> Text -- ^ Document name+       -> IO (ApiResponse Value)+getDoc manager config docTypeName docName = do+  let path = "/resource/" <> urlEncode docTypeName <> "/" <> urlEncode docName+  request <- createRequest config path "GET"+  response <- httpLbs request manager+  return $ parseGetResponse response++-- | Create a new document.+postDoc :: Manager+        -> Config+        -> Text -- ^ DocType name+        -> Value -- ^ Document data as JSON+        -> IO (ApiResponse Value)+postDoc manager config docTypeName docData = do+  let path = "/resource/" <> urlEncode docTypeName+  request <- createRequestWithBody config path "POST" docData+  response <- httpLbs request manager+  return $ parseGetResponse response++-- | Update an existing document.+putDoc :: Manager+       -> Config+       -> Text -- ^ DocType name+       -> Text -- ^ Document name+       -> Value -- ^ Updated document data as JSON+       -> IO (ApiResponse Value)+putDoc manager config docTypeName docName docData = do+  let path = "/resource/" <> urlEncode docTypeName <> "/" <> urlEncode docName+  request <- createRequestWithBody config path "PUT" docData+  response <- httpLbs request manager+  return $ parseGetResponse response++-- | Delete a document.+deleteDoc :: Manager+          -> Config+          -> Text -- ^ DocType name+          -> Text -- ^ Document name+          -> IO (ApiResponse ())+deleteDoc manager config docTypeName docName = do+  let path = "/resource/" <> urlEncode docTypeName <> "/" <> urlEncode docName+  request <- createRequest config path "DELETE"+  response <- httpLbs request manager+  return $ parseDeleteResponse response

@@ -0,0 +1,65 @@++module ERPNext.Client.Types+  ( DocStatus (..)+  , EBool (..)+  , toDocStatus+  , fromDocStatus+  , toBool+  , fromBool+  ) where++import Data.Aeson+import Data.Scientific (toBoundedInteger)++-- | ERPNext Bool type for use in your DocType record definition.+--+-- You cannot use 'Bool' there because ERPNext encodes boolean values as integer.+-- Use this 'EBool' if you don't want to use 'Int'.+newtype EBool = EBool { isTrue :: Bool }++instance FromJSON EBool where+  parseJSON (Bool b) = return $ EBool b+  parseJSON (Number n) =+    case toBoundedInteger n of+      Just i -> return $ EBool $ toBool i+      Nothing -> fail $ "expected integer but got non-integer number: " ++ show n+  parseJSON v = fail $ "expected Bool or Number but got " ++ show v++-- | DocType status type for use in your DocType record definition.+--+-- https://docs.frappe.io/framework/user/en/basics/doctypes/frameworktatus+data DocStatus+  = Draft+  | Submitted+  | Cancelled+  | Other Int++instance FromJSON DocStatus where+  parseJSON (Number n) =+    case toBoundedInteger n of+      Just i -> return $ toDocStatus i+      Nothing -> fail $ "expected integer but got non-integer number: " ++ show n+  parseJSON v = fail $ "expected Number but got " ++ show v++fromDocStatus :: DocStatus -> Int+fromDocStatus status = case status of+  Draft -> 0+  Submitted -> 1+  Cancelled -> 2+  Other n -> n++toDocStatus :: Int -> DocStatus+toDocStatus status = case status of+  0 -> Draft+  1 -> Submitted+  2 -> Cancelled+  n -> Other n++-- | Decode from ERPNext bool representation.+toBool :: Int -> Bool+toBool i = i /= 0++-- | Encode to ERPNext bool representation.+fromBool :: Bool -> Int+fromBool False = 0+fromBool True = 1

@@ -3,7 +3,7 @@ module Main (main) where  import ERPNext.Client.Helper-import ERPNext.Client.QueryStringParams+import ERPNext.Client.QueryStringParam import Test.DocTest import Data.Text import Data.Text qualified as T@@ -16,13 +16,17 @@ main = do   doctest ["src/"]   hspec $ do-   describe "ERPNext.Client.QueryStringParams" $ do+   describe "ERPNext.Client.QueryStringParam" $ do     describe "renderQueryStringParams" $ do       it "escapes quote and comma" $ do         renderQueryStringParams [Asc "\","] `shouldBe` "order_by=%22%2C%20asc"       it "escapes even brackets" $ do         renderQueryStringParams [Fields []] `shouldBe` "fields=%5B%5D"    describe "ERPNext.Client.Helper" $ do+    describe "urlEncode/urlDecode" $ do+      it "is reversable" $ hedgehog $ do+        t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode+        (urlDecode . urlEncode) t === t     describe "quote" $ do       it "is always surrounded by double quotes" $ hedgehog $ do         t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode