packages feed

desktop-portal 0.4.0.0 → 0.5.0.0

raw patch · 7 files changed

+37/−21 lines, 7 filesdep +filepathdep ~unix

Dependencies added: filepath

Dependency ranges changed: unix

Files

ChangeLog.md view
@@ -1,3 +1,7 @@+## 0.5.0.0+### Changed+- Switch from `FilePath` to the new `OsPath`.+ ## 0.4.0.0 ### Removed - Remove `Desktop.Portal.Directories`. Use the directory package instead.
README.md view
@@ -29,10 +29,10 @@ - API methods that take or return a variable set of values via a vardict should be translated into Haskell functions that take records called `...Options` and return records called `...Results`. - `...Options` records should have a `Default` instance where all fields have a reasonable empty value. - Record fields should not have unique prefixes.-- API methods that return URIs that are known to always be `file:` URIs should be wrapped with functions returning [`Prelude.FilePath`](https://hackage.haskell.org/package/base-4.18.0.0/docs/Prelude.html#t:FilePath) (at some point this can be replaced with [`System.OsPath`](https://hackage.haskell.org/package/filepath-1.4.100.3/docs/System-OsPath.html#t:OsPath)). If they are not known to be file URIs, then [`Text.URI.URI`](https://hackage.haskell.org/package/modern-uri-0.3.6.0/docs/Text-URI.html#t:URI) should be returned.+- API methods that return URIs that are known to always be `file:` URIs should be wrapped with functions returning [`System.OsPath`](https://hackage.haskell.org/package/filepath-1.4.100.3/docs/System-OsPath.html#t:OsPath). If they are not known to be file URIs, then [`Text.URI.URI`](https://hackage.haskell.org/package/modern-uri-0.3.6.0/docs/Text-URI.html#t:URI) should be returned.  ### To format the source code ```bash-# Should use Ormolu 0.7.1.0+# Should use Ormolu 0.7.3.0 ormolu --mode inplace $(find . -name '*.hs') ```
desktop-portal.cabal view
@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               desktop-portal-version:            0.4.0.0+version:            0.5.0.0 license:            MIT license-file:       LICENSE maintainer:         garethdanielsmith@gmail.com@@ -56,11 +56,12 @@         data-default-class <0.2,         dbus >=1.3.0 && <2,         directory <1.4,+        filepath <1.5,         modern-uri <0.4,         network <3.2,         random <1.3,         text <2.1,-        unix <2.8+        unix <2.9  test-suite spec     type:               exitcode-stdio-1.0@@ -101,6 +102,7 @@         dbus >=1.3.0 && <2,         desktop-portal,         directory <1.4,+        filepath <1.5,         hspec >=2 && <3,         hspec-expectations <0.9,         modern-uri <0.4,@@ -109,4 +111,4 @@         random <1.3,         temporary <1.4,         text <2.1,-        unix <2.8+        unix <2.9
src/Desktop/Portal/Documents.hs view
@@ -24,13 +24,17 @@ import DBus qualified import DBus.Client qualified as DBus import Data.Bits (Ior (..))+import Data.ByteString.Lazy qualified as Bytes import Data.Map (Map) import Data.Map qualified as Map import Data.String (IsString)-import Data.Text (Text, unpack)+import Data.Text (Text) import Data.Word (Word32) import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds)-import Desktop.Portal.Util (decodeNullTerminatedUtf8, encodeNullTerminatedUtf8)+import Desktop.Portal.Util (encodeNullTerminatedUtf8)+import System.OsPath (OsPath)+import System.OsPath.Data.ByteString.Short qualified as ShortByteString+import System.OsString.Internal.Types (OsString (..), PosixString (..))  newtype ApplicationId = ApplicationId Text   deriving newtype (Eq, Ord, Show, IsString)@@ -52,7 +56,7 @@   | GrantDelete   deriving (Eq, Show) -newtype ExtraResults = ExtraResults {mountpoint :: FilePath}+newtype ExtraResults = ExtraResults {mountpoint :: OsPath}   deriving (Eq, Show)  documentsInterface :: InterfaceName@@ -64,10 +68,10 @@ documentsObject :: ObjectPath documentsObject = "/org/freedesktop/portal/documents" -getMountPoint :: Client -> IO FilePath+getMountPoint :: Client -> IO OsPath getMountPoint client = do   callDocumentsMethod client "GetMountPoint" [] >>= \case-    [toFilePath -> Just path] ->+    [toOsPath -> Just path] ->       pure path     res ->       throwIO . DBus.clientError $ "getMountPoint: could not parse response: " <> show res@@ -233,11 +237,13 @@ toExtraResults :: Variant -> Maybe ExtraResults toExtraResults v = case DBus.fromVariant v of   Just (extraMap :: Map Text Variant)-    | Just mountpoint <- toFilePath =<< Map.lookup "mountpoint" extraMap ->+    | Just mountpoint <- toOsPath =<< Map.lookup "mountpoint" extraMap ->         Just ExtraResults {mountpoint}   _ ->     Nothing -toFilePath :: Variant -> Maybe FilePath-toFilePath v =-  unpack <$> (decodeNullTerminatedUtf8 =<< DBus.fromVariant v)+toOsPath :: Variant -> Maybe OsPath+toOsPath v = bytesToOsPath <$> DBus.fromVariant v+  where+    bytesToOsPath =+      OsString . PosixString . ShortByteString.toShort . Bytes.toStrict . Bytes.dropWhileEnd (== 0)
src/Desktop/Portal/Internal.hs view
@@ -287,7 +287,7 @@   FileSpecFd fd ->     ($ fd)   FileSpecPath path ->-    bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd+    bracket (openFd path ReadOnly defaultFileFlags) closeFd  withFds :: forall a. [FileSpec] -> ([Fd] -> IO a) -> IO a withFds files cmd = withFdsRec [] files
test/Desktop/Portal/DocumentsSpec.hs view
@@ -10,6 +10,7 @@ import Desktop.Portal.Documents qualified as Documents import Desktop.Portal.TestUtil import Desktop.Portal.TestUtil qualified as DBus+import System.OsPath qualified as OsPath import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldSatisfy)  documentsInterface :: InterfaceName@@ -34,7 +35,8 @@       it "should decode response" $ \handle -> do         let responseBody = [toVariant ("/a/b/c\0" :: ByteString)]         withDocumentsMethodResponse handle "GetMountPoint" responseBody $ do-          Documents.getMountPoint (client handle) `shouldReturn` "/a/b/c"+          path <- OsPath.encodeUtf "/a/b/c"+          Documents.getMountPoint (client handle) `shouldReturn` path      describe "add" $ do       it "should encode request with file descriptor" $ \handle -> do@@ -101,8 +103,9 @@                 toVariantMap [("mountpoint", DBus.toVariant ("/a/b/c\0" :: ByteString))]               ]         withDocumentsMethodResponse handle "AddFull" responseBody $ do+          path <- OsPath.encodeUtf "/a/b/c"           Documents.addFull (client handle) [] [] Nothing []-            `shouldReturn` (["docId"], ExtraResults "/a/b/c")+            `shouldReturn` (["docId"], ExtraResults path)      describe "addNamed" $ do       it "should encode request with file descriptor" $ \handle -> do@@ -184,8 +187,9 @@                   toVariantMap [("mountpoint", DBus.toVariant ("/a/b/c\0" :: ByteString))]                 ]           withDocumentsMethodResponse handle "AddNamedFull" responseBody $ do+            path <- OsPath.encodeUtf "/a/b/c"             Documents.addNamedFull (client handle) (FileSpecFd fd) "filename\0" [] Nothing []-              `shouldReturn` ("docId", ExtraResults "/a/b/c")+              `shouldReturn` ("docId", ExtraResults path)      describe "grantPermissions" $ do       it "should encode request" $ \handle -> do
test/Desktop/Portal/TestUtil.hs view
@@ -35,8 +35,8 @@ import Control.Exception (bracket, finally, throwIO) import Control.Monad (unless, void) import Control.Monad.IO.Class (MonadIO (..))-import DBus (BusName, InterfaceName, IsValue, IsVariant (fromVariant), MemberName, MethodCall (..), ObjectPath, Type (..), Variant, formatBusName, getSessionAddress, memberName_, objectPath_, toVariant, variantType)-import DBus.Client (Client, ClientError, ClientOptions (..), Interface (..), Property, Reply (..), RequestNameReply (..), clientError, connectWith, defaultClientOptions, defaultInterface, disconnect, emit, export, makeMethod, nameDoNotQueue, readOnlyProperty, requestName, unexport)+import DBus (BusName, InterfaceName, IsValue, IsVariant (fromVariant), MemberName, MethodCall (..), ObjectPath, Type (..), Variant, formatBusName, getSessionAddress, objectPath_, toVariant, variantType)+import DBus.Client (Client, ClientError, ClientOptions (..), Interface (..), Reply (..), RequestNameReply (..), clientError, connectWith, defaultClientOptions, defaultInterface, disconnect, emit, export, makeMethod, nameDoNotQueue, readOnlyProperty, requestName, unexport) import DBus.Internal.Message (Signal (..)) import DBus.Internal.Types (Atom (AtomText), Signature (..), Value (ValueMap), Variant (Variant)) import DBus.Socket (SocketOptions (..), authenticatorWithUnixFds, defaultSocketOptions)@@ -303,7 +303,7 @@ withTempDirectoryFd :: (Fd -> IO ()) -> IO () withTempDirectoryFd cmd =   withSystemTempDirectory "haskell-desktop-portal" $ \path -> do-    bracket (openFd path ReadOnly Nothing defaultFileFlags) closeFd cmd+    bracket (openFd path ReadOnly defaultFileFlags) closeFd cmd  withTempDirectoryFilePath :: (FilePath -> IO ()) -> IO () withTempDirectoryFilePath =