diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 0.8.0.0 +### Changed +- Move to os-string 2+ and filepath 1.5+ + ## 0.7.0.0 ### Changed - Switch from data-default-class to data-default. This is recommended by https://github.com/mauke/data-default/blob/ba1596728252c8f640d21225e728f508f2f3233c/Changes.pod#user-content-pod0.8.0.0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -31,8 +31,8 @@ - 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 [`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 +### Scripts ```bash -# Should use Ormolu 0.7.3.0 -ormolu --mode inplace $(find . -name '*.hs') +./scripts/format.sh # format the source code +./scripts/publish.sh # publish to hackage ``` diff --git a/desktop-portal.cabal b/desktop-portal.cabal --- a/desktop-portal.cabal +++ b/desktop-portal.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: desktop-portal -version: 0.7.0.0 +version: 0.8.0.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com @@ -42,7 +42,8 @@ DuplicateRecordFields FlexibleContexts GeneralizedNewtypeDeriving ImportQualifiedPost LambdaCase NamedFieldPuns NoFieldSelectors NumericUnderscores OverloadedRecordDot OverloadedStrings - RecordWildCards ScopedTypeVariables TupleSections ViewPatterns + PackageImports RecordWildCards ScopedTypeVariables TupleSections + ViewPatterns ghc-options: -Wall -Wcompat -Wincomplete-record-updates @@ -51,17 +52,18 @@ build-depends: base >=4.7 && <5, binary >=0.8.9.1 && <0.9, - bytestring >=0.11.5.3 && <0.12, - containers >=0.6.7 && <0.7, - data-default >=0.7.1.1 && <0.8, - dbus >=1.3.0 && <2, - directory >=1.3.8.5 && <1.4, - filepath >=1.4.300.1 && <1.5, + bytestring >=0.12.1.0 && <0.13, + containers >=0.6.8 && <0.7, + data-default >=0.7.1.3 && <0.8, + dbus >=1.3.9 && <1.4, + directory >=1.3.9.0 && <1.4, + filepath >=1.5.0.0 && <1.6, modern-uri >=0.3.6.1 && <0.4, - network >=3.1.4.0 && <3.3, - random >=1.2.1.2 && <1.3, - text >=2.0.2 && <2.1, - unix >=2.8.4.0 && <2.9 + network >=3.2.7.0 && <3.3, + os-string >=2.0.0 && <2.1, + random >=1.2.1.3 && <1.3, + text >=2.1.1 && <2.2, + unix >=2.8.6.0 && <2.9 test-suite spec type: exitcode-stdio-1.0 @@ -86,7 +88,8 @@ DuplicateRecordFields FlexibleContexts GeneralizedNewtypeDeriving ImportQualifiedPost LambdaCase NamedFieldPuns NoFieldSelectors NumericUnderscores OverloadedRecordDot OverloadedStrings - RecordWildCards ScopedTypeVariables TupleSections ViewPatterns + PackageImports RecordWildCards ScopedTypeVariables TupleSections + ViewPatterns ghc-options: -Wall -Wcompat -Wincomplete-record-updates @@ -96,19 +99,20 @@ build-depends: base >=4.7 && <5, binary >=0.8.9.1 && <0.9, - bytestring >=0.11.5.3 && <0.12, - containers >=0.6.7 && <0.7, - data-default >=0.7.1.1 && <0.8, - dbus >=1.3.0 && <2, + bytestring >=0.12.1.0 && <0.13, + containers >=0.6.8 && <0.7, + data-default >=0.7.1.3 && <0.8, + dbus >=1.3.9 && <1.4, desktop-portal, - directory >=1.3.8.5 && <1.4, - filepath >=1.4.300.1 && <1.5, + directory >=1.3.9.0 && <1.4, + filepath >=1.5.0.0 && <1.6, hspec >=2 && <3, hspec-expectations >=0.8.4 && <0.9, modern-uri >=0.3.6.1 && <0.4, - network >=3.1.4.0 && <3.3, - process >=1.6.20.0 && <1.7, - random >=1.2.1.2 && <1.3, + network >=3.2.7.0 && <3.3, + os-string >=2.0.0 && <2.1, + process >=1.6.25.0 && <1.7, + random >=1.2.1.3 && <1.3, temporary >=1.3 && <1.4, - text >=2.0.2 && <2.1, - unix >=2.8.4.0 && <2.9 + text >=2.1.1 && <2.2, + unix >=2.8.6.0 && <2.9 diff --git a/src/Desktop/Portal/Documents.hs b/src/Desktop/Portal/Documents.hs --- a/src/Desktop/Portal/Documents.hs +++ b/src/Desktop/Portal/Documents.hs @@ -33,8 +33,8 @@ import Desktop.Portal.Internal (Client, FileSpec, callMethod_, withFd, withFds) import Desktop.Portal.Util (encodeNullTerminated) import System.OsPath (OsPath) -import System.OsPath.Data.ByteString.Short qualified as ShortByteString -import System.OsString.Internal.Types (OsString (..), PosixString (..)) +import "os-string" System.OsString.Data.ByteString.Short qualified as ShortByteString +import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..)) newtype ApplicationId = ApplicationId Text deriving newtype (Eq, Ord, Show, IsString) diff --git a/src/Desktop/Portal/Util.hs b/src/Desktop/Portal/Util.hs --- a/src/Desktop/Portal/Util.hs +++ b/src/Desktop/Portal/Util.hs @@ -17,12 +17,12 @@ import Data.Map (Map) import Data.Map qualified as Map import Data.Text (Text, unpack) -import System.OsPath (OsPath, OsString) +import System.OsPath (OsPath) import System.OsPath qualified as OsPath -import System.OsPath.Data.ByteString.Short qualified as ShortByteString -import System.OsString.Internal.Types (OsString (..), PosixString (..)) +import System.OsString.Data.ByteString.Short qualified as ShortByteString import Text.URI (Authority (..), URI (..)) import Text.URI qualified as URI +import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..)) -- | Returns @Just Nothing@ if the field does not exist, @Just (Just x)@ if it does exist and -- can be turned into the expected type, or @Nothing@ if the field exists with the wrong type. diff --git a/test/Desktop/Portal/DocumentsSpec.hs b/test/Desktop/Portal/DocumentsSpec.hs --- a/test/Desktop/Portal/DocumentsSpec.hs +++ b/test/Desktop/Portal/DocumentsSpec.hs @@ -13,7 +13,7 @@ import Desktop.Portal.TestUtil import Desktop.Portal.TestUtil qualified as DBus import System.OsPath (osp) -import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn, shouldSatisfy) +import Test.Hspec (Spec, around, describe, it, shouldBe, shouldReturn) documentsInterface :: InterfaceName documentsInterface = "org.freedesktop.portal.Documents" @@ -45,16 +45,22 @@ withTempFd $ \fd -> do body <- savingDocumentsMethodArguments handle "Add" responseBody $ do void $ Documents.add (client handle) (FileSpecFd fd) False True - head body `shouldSatisfy` isDifferentUnixFd fd - tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True] + body + `shouldSatisfyList` [ isDifferentUnixFd fd, + (== DBus.toVariant False), + (== DBus.toVariant True) + ] it "should encode request with file path" $ \handle -> do let responseBody = [toVariantText "docId"] withTempFilePath $ \path -> do body <- savingDocumentsMethodArguments handle "Add" responseBody $ do void $ Documents.add (client handle) (FileSpecPath path) False True - head body `shouldSatisfy` isUnixFd - tail body `shouldBe` [DBus.toVariant False, DBus.toVariant True] + body + `shouldSatisfyList` [ isUnixFd, + (== DBus.toVariant False), + (== DBus.toVariant True) + ] it "should decode response" $ \handle -> do let responseBody = [toVariantText "docId"] @@ -78,12 +84,12 @@ [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory] (Just "appId") [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete] - head body `shouldSatisfy` isDifferentUnixFds fds - tail body - `shouldBe` [ DBus.toVariant (0b1111 :: Word32), - toVariantText "appId", - DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"] - ] + body + `shouldSatisfyList` [ isDifferentUnixFds fds, + (== DBus.toVariant (0b1111 :: Word32)), + (== toVariantText "appId"), + (== DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"]) + ] it "should encode request with file paths" $ \handle -> do withTempFilePaths 8 $ \paths -> do @@ -94,9 +100,12 @@ body <- savingDocumentsMethodArguments handle "AddFull" responseBody $ do void $ Documents.addFull (client handle) (FileSpecPath <$> paths) [] Nothing [] - head body `shouldSatisfy` isUnixFds 8 - tail body - `shouldBe` [DBus.toVariant (0 :: Word32), toVariantText "", DBus.toVariant ([] :: [Text])] + body + `shouldSatisfyList` [ isUnixFds 8, + (== DBus.toVariant (0 :: Word32)), + (== toVariantText ""), + (== DBus.toVariant ([] :: [Text])) + ] it "should decode response" $ \handle -> do let responseBody = @@ -113,24 +122,24 @@ let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do void $ Documents.addNamed (client handle) (FileSpecFd fd) [osp|filename|] False True - head body `shouldSatisfy` isDifferentUnixFd fd - tail body - `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString), - DBus.toVariant False, - DBus.toVariant True - ] + body + `shouldSatisfyList` [ isDifferentUnixFd fd, + (== DBus.toVariant ("filename\0" :: ByteString)), + (== DBus.toVariant False), + (== DBus.toVariant True) + ] it "should encode request with file path" $ \handle -> do withTempDirectoryFilePath $ \path -> do let responseBody = [toVariantText "docId"] body <- savingDocumentsMethodArguments handle "AddNamed" responseBody $ do void $ Documents.addNamed (client handle) (FileSpecPath path) [osp|filename|] False True - head body `shouldSatisfy` isUnixFd - tail body - `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString), - DBus.toVariant False, - DBus.toVariant True - ] + body + `shouldSatisfyList` [ isUnixFd, + (== DBus.toVariant ("filename\0" :: ByteString)), + (== DBus.toVariant False), + (== DBus.toVariant True) + ] it "should decode response" $ \handle -> do withTempDirectoryFd $ \fd -> do @@ -155,13 +164,13 @@ [AddReuseExisting, AddPersistent, AddAsNeededByApp, AddExportDirectory] (Just "appId") [GrantRead, GrantWrite, GrantGrantPermissions, GrantDelete] - head body `shouldSatisfy` isDifferentUnixFd fd - tail body - `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString), - DBus.toVariant (0b1111 :: Word32), - toVariantText "appId", - DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"] - ] + body + `shouldSatisfyList` [ isDifferentUnixFd fd, + (== DBus.toVariant ("filename\0" :: ByteString)), + (== DBus.toVariant (0b1111 :: Word32)), + (== toVariantText "appId"), + (== DBus.toVariant ["read" :: Text, "write", "grant-permissions", "delete"]) + ] it "should encode request with file path" $ \handle -> do withTempDirectoryFilePath $ \path -> do @@ -172,13 +181,13 @@ body <- savingDocumentsMethodArguments handle "AddNamedFull" responseBody $ do void $ Documents.addNamedFull (client handle) (FileSpecPath path) [osp|filename|] [] Nothing [] - head body `shouldSatisfy` isUnixFd - tail body - `shouldBe` [ DBus.toVariant ("filename\0" :: ByteString), - DBus.toVariant (0 :: Word32), - toVariantText "", - DBus.toVariant ([] :: [Text]) - ] + body + `shouldSatisfyList` [ isUnixFd, + (== DBus.toVariant ("filename\0" :: ByteString)), + (== DBus.toVariant (0 :: Word32)), + (== toVariantText ""), + (== DBus.toVariant ([] :: [Text])) + ] it "should decode response" $ \handle -> do withTempDirectoryFd $ \fd -> do diff --git a/test/Desktop/Portal/TestUtil.hs b/test/Desktop/Portal/TestUtil.hs --- a/test/Desktop/Portal/TestUtil.hs +++ b/test/Desktop/Portal/TestUtil.hs @@ -42,6 +42,7 @@ import DBus.Socket (SocketOptions (..), authenticatorWithUnixFds, defaultSocketOptions) import Data.Map (Map) import Data.Map qualified as Map +import Data.Maybe (fromJust) import Data.Text (Text) import Data.Word (Word32) import Desktop.Portal qualified as Portal @@ -234,9 +235,10 @@ <> handleToken where args = methodCallBody methodCall - Just (optionsArg :: Map Text Variant) = fromVariant (args !! (length args - 1)) - Just (handleToken :: String) = Map.lookup "handle_token" optionsArg >>= fromVariant - Just senderClientName = methodCall.methodCallSender + handleToken = fromJust $ do + (optionsArg :: Map Text Variant) <- fromVariant (args !! (length args - 1)) + Map.lookup "handle_token" optionsArg >>= fromVariant + senderClientName = fromJust methodCall.methodCallSender escapeClientName = map (\case '.' -> '_'; c -> c) . drop 1 . formatBusName