diff --git a/obelisk/frontend/android-src/FrontendPaths.hs b/obelisk/frontend/android-src/FrontendPaths.hs index 9e34fc7d78b35ad6f52975ad044f3a6f9accbf05..1ab4b96dfa694fb6bad7c8fd54e2e091ebc19ee7 100644 --- a/obelisk/frontend/android-src/FrontendPaths.hs +++ b/obelisk/frontend/android-src/FrontendPaths.hs @@ -1,6 +1,6 @@ -- | Implement platform-specific path-related operations for the Android -- platform. -module FrontendPaths (getFilesDir, runWithRef) where +module FrontendPaths (getFilesDir, getCacheDir, runWithRef, viewFile) where import Control.Concurrent (threadDelay) import Control.Monad (forever) @@ -13,6 +13,16 @@ import System.IO (hSetBuffering, stdout, stderr, BufferMode(LineBuffering)) import qualified Android.HaskellActivity as Android import PlatformEvents (PlatformEventCallbacks(..)) +-- | Get the path to a directory that is private to the application where +-- internal application cache data may be written (and read back). +-- +-- The application requires no special permissions to use this directory. If +-- the app is uninstalled the directory and its children will be deleted. +-- +-- https://developer.android.com/reference/android/content/Context#getCacheDir() +getCacheDir :: IO (Maybe FilePath) +getCacheDir = Android.getHaskellActivity >>= Android.getCacheDir + -- | Get the path to a directory that is private to the application where -- internal application data may be written (and read back). -- @@ -52,3 +62,11 @@ runWithRef makeJSM = do onBackPressed f } forever $ threadDelay 1000000000 + + +-- | Allow the operator of the device to view the contents of the file at the +-- given path. +-- +-- TODO: Make it work. +viewFile :: FilePath -> IO () +viewFile p = print $ "I viewed " <> p diff --git a/obelisk/frontend/frontend.cabal b/obelisk/frontend/frontend.cabal index de477685deecc700c76ec873aaf38b0e9999a777..14838df9b7c47656cd34fc4ab3600bc58eb28bdf 100644 --- a/obelisk/frontend/frontend.cabal +++ b/obelisk/frontend/frontend.cabal @@ -47,6 +47,7 @@ library , tahoe-great-black-swamp , tahoe-ssk , text + , unix , yaml if os(android) diff --git a/obelisk/frontend/linux-src/FrontendPaths.hs b/obelisk/frontend/linux-src/FrontendPaths.hs index d97a45562271799181bdb8c305cd3e8cf15b05b3..d6c09121bad1febd50680ad4cca08073bceaed68 100644 --- a/obelisk/frontend/linux-src/FrontendPaths.hs +++ b/obelisk/frontend/linux-src/FrontendPaths.hs @@ -1,15 +1,24 @@ -- | Implement platform-specific path-related operations for the Linux -- platform. -module FrontendPaths (getFilesDir, runWithRef) where +module FrontendPaths (getFilesDir, getCacheDir, runWithRef, viewFile) where import Data.IORef (IORef, newIORef) -import System.Environment.XDG.BaseDir (getUserDataDir) +import System.Environment.XDG.BaseDir (getUserCacheDir, getUserDataDir) import System.Directory (createDirectoryIfMissing) import Reflex.Dom (run) import PlatformEvents (PlatformEventCallbacks) import Language.Javascript.JSaddle (JSM) import Data.Default.Class (def) +-- | Get a dedicated directory for this application beneath the XDG standard +-- cache directory. +getCacheDir :: IO (Maybe FilePath) +getCacheDir = do + dataPath <- getUserCacheDir "privatestoragemobile" + + createDirectoryIfMissing True dataPath + pure $ Just dataPath + -- | Get the path to a directory that is specific to the application where -- internal application data may be written (and read back). getFilesDir :: IO (Maybe FilePath) @@ -27,3 +36,7 @@ runWithRef makeJSM = -- Off Android, we have no platform integration or event handlers so just -- supply a no-op callback to fill the slot and then proceed. newIORef def >>= run . makeJSM . Just + +-- | Show a file to the user. +viewFile :: FilePath -> IO () +viewFile p = print $ "I viewed " <> p diff --git a/obelisk/frontend/src/Controller.hs b/obelisk/frontend/src/Controller.hs index 407b014dd58c15fb66405e2cea47c759ef7330c8..5698384b9d9af88aac9b49808770f04e39cff925 100644 --- a/obelisk/frontend/src/Controller.hs +++ b/obelisk/frontend/src/Controller.hs @@ -105,10 +105,10 @@ fileBrowser' -> FolderEntry -- ^ The root of the magic-folder to browser. -> m () -fileBrowser' App{appUpdateFolder} folder path rootEntry = do +fileBrowser' app@App{appUpdateFolder} folder path rootEntry = do goEv <- getPostBuild performEvent_ $ ffor goEv $ \() -> liftIO $ appUpdateFolder folder - fileBrowser (listWhichDir path rootEntry) + fileBrowser app (listWhichDir path rootEntry) -- | List the contents of a directory arbitrarily deeply nested beneath some -- root. diff --git a/obelisk/frontend/src/Pages/FileBrowser.hs b/obelisk/frontend/src/Pages/FileBrowser.hs index 1192af2967ce24937e9718105671f2267e096c8d..bc40af6da7d4ee4357d2dcdbe2fdd78d39d0bb45 100644 --- a/obelisk/frontend/src/Pages/FileBrowser.hs +++ b/obelisk/frontend/src/Pages/FileBrowser.hs @@ -3,12 +3,23 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} module Pages.FileBrowser (fileBrowser) where +import Data.Tuple.Extra (uncurry3) +import System.IO.Extra (newTempFileWithin) import Data.List.Extra import Reflex.Dom.Core - +import Control.Monad (void) +import Tahoe.Announcement (Announcements(..)) +import App (App(App, appGrid)) +import System.Posix.Files (rename) +import FrontendPaths (getCacheDir, viewFile) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as LB +import Control.Monad.IO.Class (MonadIO, liftIO) +import Tahoe.Download (download, announcementToImmutableStorageServer) import qualified Data.Text as T import Obelisk.Route.Frontend import Common.Route @@ -69,11 +80,13 @@ leaveActionIcon Up = "arrow_back" -- | Define the entire view for looking at a single folder and its direct -- contents. fileBrowser :: ( DomBuilder t m + , PerformEvent t m + , MonadIO (Performable m) , PostBuild t m , SetRoute t (R FrontendRoute) m , Routed t FolderLocation m - ) => [(EntryName, FolderEntry)] -> m () -fileBrowser entries = do + ) => App t -> [(EntryName, FolderEntry)] -> m () +fileBrowser App{appGrid} entries = do routeDyn <- askRoute elAttr "header" ("class" =: "mdc-top-app-bar mdc-top-app-bar--fixed" <> "data-mdc-auto-init" =: "MDCTopAppBar") $ divClass "mdc-top-app-bar__row" $ do @@ -99,7 +112,7 @@ fileBrowser entries = do elClass "main" "mdc-top-app-bar--fixed-adjust" $ do elAttr "ul" ("class" =: "mdc-deprecated-list mdc-deprecated-list--two-line mdc-deprecated-list--avatar-list mdc-deprecated-list--dense" <> "data-mdc-auto-init" =: "MDCList") $ - mapM_ (uncurry fileBrowserEntryWidget) entries + mapM_ (uncurry $ fileBrowserEntryWidget appGrid) entries el "script" $ text "mdc.autoInit();" @@ -107,8 +120,18 @@ fileBrowser entries = do -- | Define the view for a single item in a file browser, including an icon, -- the item name, and some metadata. -fileBrowserEntryWidget :: (DomBuilder t m, SetRoute t (R FrontendRoute) m, Routed t FolderLocation m) => EntryName -> FolderEntry -> m () -fileBrowserEntryWidget (EntryName name) entry = do +fileBrowserEntryWidget + :: ( DomBuilder t m + , PerformEvent t m + , MonadIO (Performable m) + , SetRoute t (R FrontendRoute) m + , Routed t FolderLocation m + ) + => Dynamic t (Either T.Text Announcements) + -> EntryName + -> FolderEntry + -> m () +fileBrowserEntryWidget gridDyn (EntryName name) entry = do (theEl, _) <- elClass' "li" "mdc-deprecated-list-item" $ do elAttr "span" ("class" =: "mdc-deprecated-list-item__graphic material-icons") $ text $ iconForEntry entry @@ -127,4 +150,34 @@ fileBrowserEntryWidget (EntryName name) entry = do setRoute $ ffor navigateEv $ \(folder, path) -> FrontendRoute_FileBrowser :/ (folder, Data.List.Extra.snoc path name) + File { fileContent } -> + void $ performEvent $ ffor ((,name,fileContent) <$> canDownloadEv) $ liftIO . uncurry3 viewContent + where + downloadEv = tag (current gridDyn) (domEvent Click theEl) + -- XXX If we don't have a grid right now we can't even try to + -- download. It would be great if something took care of this + -- before we got here. For the moment, we do nothing with this + -- information - we just silently don't act. + (_cantDownloadEv, canDownloadEv) = fanEither downloadEv + _ -> pure () + +-- | Use the given capability to download some content and attempt to display +-- it to the user of the device. +viewContent :: Announcements -> T.Text -> CHK.Reader -> IO () +viewContent (Announcements grid) name fileContent = do + p <- getCacheDir + case p of + Nothing -> print ("Could not find cache directory for download." :: String) + Just cacheDir -> do + result <- download grid fileContent announcementToImmutableStorageServer + case result of + Left err -> print $ "Could not download " <> T.unpack name <> ": " <> show err + Right content -> do + (tempName, _) <- newTempFileWithin cacheDir + -- XXX Ideally we could do _some_ laziness here. + B.writeFile tempName (LB.toStrict content) + rename tempName finalName + viewFile finalName + where + finalName = cacheDir <> "/" <> T.unpack name