monomer-flatpak-example 0.0.14.0 → 0.0.15.0
raw patch · 6 files changed
+76/−37 lines, 6 filesdep +file-iodep +filepathdep ~asyncdep ~desktop-portaldep ~directory
Dependencies added: file-io, filepath
Dependency ranges changed: async, desktop-portal, directory, monomer, monomer-hagrid
Files
- app/Documents.hs +29/−21
- app/Main.hs +3/−2
- app/OpenURI.hs +7/−4
- app/Util.hs +19/−4
- assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml +10/−0
- monomer-flatpak-example.cabal +8/−6
app/Documents.hs view
@@ -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)
app/Main.hs view
@@ -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},
app/OpenURI.hs view
@@ -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))
app/Util.hs view
@@ -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
assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml view
@@ -23,6 +23,16 @@ </screenshots> <releases>+ <release version="0.0.15.0" date="2023-12-29">+ <description>+ More internal library updates.+ </description>+ </release>+ <release version="0.0.14.0" date="2023-11-11">+ <description>+ Internal library updates.+ </description>+ </release> <release version="0.0.13.0" date="2023-10-07"> <description> Add a basic demo of the Camera API. Update to v23.08 of the Flatpak platform.
monomer-flatpak-example.cabal view
@@ -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