From 7d7adbc1708d538c187a016eb3f8756e6c38bcba Mon Sep 17 00:00:00 2001
From: Marco Zocca <marco.zocca@unfoldml.com>
Date: Sun, 25 Jun 2023 16:18:28 +0200
Subject: [PATCH] add listDirectoriesAndFilesC

---
 ms-azure-api/CHANGELOG.md                     | 10 +++++--
 ms-azure-api/ms-azure-api.cabal               |  1 +
 .../MSAzureAPI/StorageServices/FileService.hs | 29 +++++++++++++++++--
 3 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/ms-azure-api/CHANGELOG.md b/ms-azure-api/CHANGELOG.md
index f5d4049..22c5291 100644
--- a/ms-azure-api/CHANGELOG.md
+++ b/ms-azure-api/CHANGELOG.md
@@ -10,16 +10,22 @@ and this project adheres to the
 
 ## 0.3.0.0
 
+add 'conduit' as a dependency
+
+add listDirectoriesAndFilesC
+
 MSAzureAPI.MachineLearning.Compute
 MSAzureAPI.MachineLearning.Jobs
 MSAzureAPI.MachineLearning.Usages
 
 * breaking changes:
-MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles now has an extra parameter to support paginated results
+MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles now has an extra parameter to support paginated results, as well as a more informative return type.
 
 ## 0.2.0.0
 
-MSAzureAPI.StorageServices.FileService. listDirectoriesAndFiles
+* MSAzureAPI.StorageServices.FileService
+
+add listDirectoriesAndFiles
 
 Add XML support via `xeno` and `xmlbf` to parse `listDirectoriesAndFiles` response bodies
 
diff --git a/ms-azure-api/ms-azure-api.cabal b/ms-azure-api/ms-azure-api.cabal
index 15db4dc..d3a174a 100644
--- a/ms-azure-api/ms-azure-api.cabal
+++ b/ms-azure-api/ms-azure-api.cabal
@@ -28,6 +28,7 @@ library
   build-depends:       base >= 4.7 && < 5
                      , aeson
                      , bytestring
+                     , conduit
                      , containers
                      , hoauth2 == 2.6.0
                      , http-types
diff --git a/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs b/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs
index 0f83c60..59fe4c5 100644
--- a/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs
+++ b/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs
@@ -8,26 +8,31 @@ module MSAzureAPI.StorageServices.FileService (
   getFile
   -- * Directories
   , listDirectoriesAndFiles
+  , listDirectoriesAndFilesC
   , DirItems(..)
   , DirItem(..)
   ) where
 
 import Control.Applicative (Alternative(..), optional)
+import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Foldable (asum)
 import Data.Functor (void)
-import Data.Maybe (listToMaybe)
+import Data.Maybe (listToMaybe, isJust)
 import qualified Text.ParserCombinators.ReadP as RP (ReadP, readP_to_S, choice, many, between, char, string, satisfy)
 
 -- bytestring
 import qualified Data.ByteString as BS (ByteString)
 import qualified Data.ByteString.Char8 as BS8 (pack, unpack)
 import qualified Data.ByteString.Lazy as LBS (ByteString)
+-- conduit
+import qualified Data.Conduit as C (ConduitT, yield, runConduitRes)
+import Data.Conduit ((.|))
 -- hoauth2
 -- import Network.OAuth.OAuth2 (OAuth2Token(..))
 import Network.OAuth.OAuth2.Internal (AccessToken(..))
 -- req
-import Network.HTTP.Req (Req, Url, Option, Scheme(..), header, (=:))
+import Network.HTTP.Req (HttpException, runReq, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))
 -- text
 import Data.Text (Text, pack, unpack)
 import qualified Data.Text.Lazy as TL (Text, pack, unpack, toStrict)
@@ -42,7 +47,7 @@ import qualified Xmlbf.Xeno as XB (fromRawXml)
 -- xmlbf
 import qualified Xmlbf as XB (Parser, runParser, pElement, pText)
 
-import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs)
+import MSAzureAPI.Internal.Common (APIPlane(..), (==:), get, getBs, post, getLbs, tryReq)
 
 
 
@@ -142,6 +147,24 @@ listDirectoriesAndFiles acct fshare fpath mm atok = do
       Just m -> ("marker" ==: m)
       _ -> mempty
 
+-- | Repeated call of 'listDirectoriesAndFiles' supporting multi-page results
+listDirectoriesAndFilesC :: MonadIO m =>
+                              Text -- ^ storage account
+                           -> Text -- ^ file share
+                           -> Text -- ^ directory path, including directories
+                           -> AccessToken -> C.ConduitT i [DirItem] m ()
+listDirectoriesAndFilesC acct fshare fpath atok = go Nothing
+  where
+    go mm = do
+      eres <- runReq defaultHttpConfig $ tryReq $ listDirectoriesAndFiles acct fshare fpath mm atok
+      case eres of
+        Left _ -> undefined -- FIXME http exception
+        Right xe -> case xe of
+          Left _ -> undefined -- FIXME xml parsing error
+          Right (DirItems xs nMarker) -> do
+            C.yield xs
+            when (isJust nMarker) (go nMarker)
+
 -- | Directory item, as returned by 'listDirectoriesAndFiles'
 data DirItem = DIFile {diId :: Text, diName :: Text} -- ^ file
              | DIDirectory {diId :: Text, diName :: Text} -- ^ directory