diff --git a/app/Documents.hs b/app/Documents.hs --- a/app/Documents.hs +++ b/app/Documents.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} + module Documents (documents) where import Control.Exception (SomeException, catch) @@ -17,12 +19,16 @@ import Desktop.Portal.FileChooser (OpenFileResults) import Monomer import Monomer.Hagrid -import System.Directory (doesDirectoryExist, getDirectoryContents) -import Util (getXdgDataDir) +import System.Directory.OsPath (doesDirectoryExist, getDirectoryContents) +import System.File.OsPath (writeFile) +import System.OsPath (OsPath, osp, ()) +import System.OsPath qualified as OsPath +import Util (getXdgDataDir, osPathToText) +import Prelude hiding (writeFile) data DocumentsModel = DocumentsModel { portalClient :: Client, - mountPoint :: FilePath, + mountPoint :: OsPath, documents :: Seq Document } deriving (Eq, Show) @@ -36,7 +42,7 @@ data DocumentsEvent = RefreshDocuments - | RefreshDocumentsFinish FilePath (Seq Document) + | RefreshDocumentsFinish OsPath (Seq Document) | SetDocumentSelected DocumentId Bool | DeleteSelectedDocuments | OpenFile @@ -52,7 +58,7 @@ initialModel = DocumentsModel { portalClient, - mountPoint = "...", + mountPoint = [osp|...|], documents = mempty } @@ -127,7 +133,7 @@ ] AddFile -> [ Producer $ \emit -> do - filePath <- (<> "/hello.txt") <$> getXdgDataDir + filePath <- ( [osp|/hello.txt|]) <$> getXdgDataDir writeFile filePath "Hello!" catchErrors "Add File Failed" emit $ do void (Documents.add model.portalClient (FileSpecPath filePath) True True) @@ -146,44 +152,46 @@ openFileResponseAlert results = "Request successful.\n\n" <> "Selected Files: " - <> intercalate ", " (pack <$> results.uris) + <> intercalate ", " (osPathToText <$> results.uris) <> "\n" <> "Selected Choices: " <> pack (show results.choices) -getDocuments :: FilePath -> IO (Seq Document) +getDocuments :: OsPath -> IO (Seq Document) getDocuments storePath = do paths <- getDirectoryContents storePath flip foldMap paths $ \path -> do - let fullPath = storePath <> "/" <> path + let fullPath = storePath path isDir <- doesDirectoryExist fullPath - if isDir && path /= "by-app" && path /= "." && path /= ".." + if isDir && path /= [osp|by-app|] && path /= [osp|.|] && path /= [osp|..|] then do ls <- lsRecursive fullPath - pure (Seq.singleton Document {id = DocumentId (pack path), ls, selected = False}) + docId <- pack <$> OsPath.decodeUtf path + pure (Seq.singleton Document {id = DocumentId docId, ls, selected = False}) else pure mempty -lsRecursive :: FilePath -> IO Text +lsRecursive :: OsPath -> IO Text lsRecursive path = do displayPath <- withSlashIfDir path path - childOutputs <- lsRecursive' "" path "" + childOutputs <- lsRecursive' "" path mempty pure . toStrict . Builder.toLazyText $ displayPath <> "\n" <> childOutputs where - lsRecursive' :: Builder -> FilePath -> FilePath -> IO Builder + lsRecursive' :: Builder -> OsPath -> OsPath -> IO Builder lsRecursive' indent dirPath fileName = do - let fullPath = dirPath <> "/" <> fileName + let fullPath = dirPath fileName childPaths <- doesDirectoryExist fullPath >>= bool (pure []) (getDirectoryContents fullPath) childOutputs <- forM childPaths $ \childPath -> do - if childPath == "." || childPath == ".." + if childPath == [osp|.|] || childPath == [osp|..|] then pure "" else lsRecursive' (indent <> " ") fullPath childPath displayPath <- withSlashIfDir fullPath fileName - case fileName of - "" -> pure (mconcat childOutputs) - _ -> pure (indent <> displayPath <> "\n" <> mconcat childOutputs) + if fileName == mempty + then pure (mconcat childOutputs) + else pure (indent <> displayPath <> "\n" <> mconcat childOutputs) -withSlashIfDir :: FilePath -> FilePath -> IO Builder +withSlashIfDir :: OsPath -> OsPath -> IO Builder withSlashIfDir fullPath displayPath = do slash <- bool "" "/" <$> doesDirectoryExist fullPath - pure (Builder.fromString displayPath <> slash) + filePath <- OsPath.decodeUtf displayPath + pure (Builder.fromString filePath <> slash) diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -24,6 +24,7 @@ import Paths_monomer_flatpak_example (getDataFileName) import System.Directory (getCurrentDirectory, getHomeDirectory, listDirectory) import System.Environment (getEnvironment) +import Util (osPathToText) data AppModel = AppModel { portalClient :: Client, @@ -193,10 +194,10 @@ [ label "Request successful.", label ("User Id: " <> results.id), label ("User Name: " <> results.name), - label ("User Image: " <> maybe "[none]" pack results.image) + label ("User Image: " <> maybe "[none]" osPathToText results.image) ] - settingsAlertContents :: ReadAllResults -> WidgetNode () AppEvent + settingsAlertContents :: ReadAllResults -> WidgetNode AppModel AppEvent settingsAlertContents results = hagrid [ (textColumn "Namespace" (.namespace)) {initialWidth = 200}, diff --git a/app/OpenURI.hs b/app/OpenURI.hs --- a/app/OpenURI.hs +++ b/app/OpenURI.hs @@ -10,10 +10,13 @@ import Desktop.Portal.OpenURI (openURIOptions) import Desktop.Portal.OpenURI qualified as OpenURI import Monomer -import System.Directory (createDirectoryIfMissing) +import System.Directory.OsPath (createDirectoryIfMissing) +import System.File.OsPath (writeFile) +import System.OsPath (osp, ()) import Text.URI (URI, render) import Text.URI.QQ (uri) import Util (getXdgDataDir) +import Prelude hiding (writeFile) newtype OpenURIModel = OpenURIModel { portalClient :: Client @@ -59,15 +62,15 @@ OpenFile -> [ Producer $ \emit -> do catchErrors "Open File Failed" emit $ do - filePath <- (<> "/hello.txt") <$> getXdgDataDir + filePath <- ( [osp|/hello.txt|]) <$> getXdgDataDir writeFile filePath "Hello!" void $ OpenURI.openFile model.portalClient (OpenURI.openFileOptions (FileSpecPath filePath)) ] OpenDirectory -> [ Producer $ \emit -> do catchErrors "Open Directory Failed" emit $ do - dirPath <- (<> "/hello-directory") <$> getXdgDataDir - let filePath = dirPath <> "/hello.txt" + dirPath <- ( [osp|hello-directory|]) <$> getXdgDataDir + let filePath = dirPath [osp|hello.txt|] createDirectoryIfMissing True dirPath writeFile filePath "Hello!" void $ OpenURI.openDirectory model.portalClient (OpenURI.openDirectoryOptions (FileSpecPath dirPath)) diff --git a/app/Util.hs b/app/Util.hs --- a/app/Util.hs +++ b/app/Util.hs @@ -1,9 +1,24 @@ -module Util (getXdgDataDir) where +{-# LANGUAGE QuasiQuotes #-} -import System.Directory (XdgDirectory (..), createDirectoryIfMissing, getXdgDirectory) +module Util + ( getXdgDataDir, + osPathToText, + ) +where -getXdgDataDir :: IO FilePath +import Data.Text (Text, pack) +import GHC.IO.Encoding (utf8) +import System.Directory.OsPath (XdgDirectory (..), createDirectoryIfMissing, getXdgDirectory) +import System.OsPath (OsPath, decodeWith, osp) + +getXdgDataDir :: IO OsPath getXdgDataDir = do - dir <- getXdgDirectory XdgData "monomer-flatpak-example" + dir <- getXdgDirectory XdgData [osp|monomer-flatpak-example|] createDirectoryIfMissing True dir pure dir + +osPathToText :: OsPath -> Text +osPathToText path = + case decodeWith utf8 utf8 path of + Left err -> pack (show err) + Right fp -> pack fp diff --git a/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml b/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml --- a/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml +++ b/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml @@ -23,6 +23,16 @@ + + + More internal library updates. + + + + + Internal library updates. + + Add a basic demo of the Camera API. Update to v23.08 of the Flatpak platform. diff --git a/monomer-flatpak-example.cabal b/monomer-flatpak-example.cabal --- a/monomer-flatpak-example.cabal +++ b/monomer-flatpak-example.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: monomer-flatpak-example -version: 0.0.14.0 +version: 0.0.15.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com @@ -55,16 +55,18 @@ -Wredundant-constraints build-depends: - async >=2.2.4 && <2.3, + async >=2.2.5 && <2.3, base >=4.7 && <5, bytestring >=0.11.5.2 && <0.12, containers >=0.6.7 && <0.7, data-default-class >=0.1.2.0 && <0.2, dbus >=1.3.1 && <1.4, - desktop-portal >=0.4 && <0.5, - directory >=1.3.7.1 && <1.4, + desktop-portal >=0.6 && <0.7, + directory >=1.3.8.1 && <1.4, + file-io >=0.1.0.2 && <0.2, + filepath >=1.4.100.4 && <1.5, modern-uri >=0.3.6.1 && <0.4, - monomer >=1.5.1.0 && <1.6, - monomer-hagrid >=0.3.1.1 && <0.4, + monomer >=1.6.0.0 && <1.7, + monomer-hagrid >=0.3.1.2 && <0.4, random >=1.2.1.1 && <1.3, text >=2.0.2 && <2.1