v 0.3.1

unfoldml · Jun 26, 2023 · ad94588 · ad94588
1 parent 05038a6
commit ad94588
Show file tree

Hide file tree

Showing 3 changed files with 39 additions and 21 deletions.
diff --git a/ms-azure-api/CHANGELOG.md b/ms-azure-api/CHANGELOG.md
@@ -8,6 +8,8 @@ and this project adheres to the
 
 ## Unreleased
 
+## 0.3.1.0
+
 MSAzureAPI.StorageServices.FileService : add listDirectoriesAndFilesC (stream all response pages from listDirectoriesAndFiles)
 
 ## 0.3.0.0

diff --git a/ms-azure-api/ms-azure-api.cabal b/ms-azure-api/ms-azure-api.cabal
@@ -1,5 +1,5 @@
 name:                ms-azure-api
-version:             0.3.0.0
+version:             0.3.1.0
 synopsis:            Microsoft Azure API
 description:         Bindings to the Microsoft Azure API
 homepage:            https://github.com/unfoldml/ms-graph-api
@@ -25,11 +25,12 @@ library
                        MSAzureAPI.StorageServices
                        MSAzureAPI.StorageServices.FileService
   other-modules:       MSAzureAPI.Internal.Common
-  build-depends:       base >= 4.7 && < 5
-                     , aeson
+  build-depends:       aeson
+                     , base >= 4.7 && < 5
                      , bytestring
                      , conduit
                      , containers
+                     , exceptions >= 0.10.4
                      , hoauth2 == 2.6.0
                      , http-types
                      , modern-uri

diff --git a/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs b/ms-azure-api/src/MSAzureAPI/StorageServices/FileService.hs
@@ -8,17 +8,22 @@ module MSAzureAPI.StorageServices.FileService (
   getFile
   -- * Directories
   , listDirectoriesAndFiles
-  -- , listDirectoriesAndFilesC
+  , listDirectoriesAndFilesC
   , DirItems(..)
   , DirItem(..)
+  -- * Common types
+  , FSException(..)
   ) where
 
 import Control.Applicative (Alternative(..), optional)
+import Control.Exception (Exception(..))
+import Control.Monad.Catch (MonadThrow(..))
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Foldable (asum)
 import Data.Functor (void)
 import Data.Maybe (listToMaybe, isJust)
+import Data.Typeable (Typeable)
 import qualified Text.ParserCombinators.ReadP as RP (ReadP, readP_to_S, choice, many, between, char, string, satisfy)
 
 -- bytestring
@@ -147,23 +152,33 @@ 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)
+-- | Repeated call of 'listDirectoriesAndFiles' supporting multi-page results
+--
+-- throws 'FSException' if something goes wrong
+listDirectoriesAndFilesC :: (MonadIO m, MonadThrow 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 e -> throwM $ FSHttpE e
+        Right xe -> case xe of
+          Left e -> throwM $ FSXMLParsingE e
+          Right (DirItems xs nMarker) -> do
+            C.yield xs
+            when (isJust nMarker) (go nMarker)
+
+data FSException = FSXMLParsingE String
+                 | FSHttpE HttpException deriving (Typeable)
+instance Show FSException where
+  show = \case
+    FSXMLParsingE es -> unwords ["XML parsing error:", es]
+    FSHttpE e -> unwords ["HTTP exception:", show e]
+instance Exception FSException
 
 -- | Directory item, as returned by 'listDirectoriesAndFiles'
 data DirItem = DIFile {diId :: Text, diName :: Text} -- ^ file