mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-02 18:06:10 +00:00
* core: remove mtl typeclasses to reduce overhead * strict data, optimization * update simplexmq, clean up * un-unlift attachRevHTTP2Client * remote --------- Co-authored-by: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com>
27 lines
982 B
Haskell
27 lines
982 B
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module Simplex.Chat.Files where
|
|
|
|
import Simplex.Chat.Controller
|
|
import Simplex.Messaging.Util (ifM)
|
|
import System.FilePath (combine, splitExtensions)
|
|
import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getHomeDirectory, getTemporaryDirectory)
|
|
|
|
uniqueCombine :: FilePath -> String -> IO FilePath
|
|
uniqueCombine fPath fName = tryCombine (0 :: Int)
|
|
where
|
|
tryCombine n =
|
|
let (name, ext) = splitExtensions fName
|
|
suffix = if n == 0 then "" else "_" <> show n
|
|
f = fPath `combine` (name <> suffix <> ext)
|
|
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
|
|
|
|
getChatTempDirectory :: CM' FilePath
|
|
getChatTempDirectory = chatReadVar' tempDirectory >>= maybe getTemporaryDirectory pure
|
|
|
|
getDefaultFilesFolder :: CM' FilePath
|
|
getDefaultFilesFolder = do
|
|
dir <- (`combine` "Downloads") <$> getHomeDirectory
|
|
ifM (doesDirectoryExist dir) (pure dir) getChatTempDirectory
|