hasufell/hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

LIB/GTK: use ByteString instead of String for

Browse Source
This commit is contained in:
Julian Ospald
2016-04-05 00:56:36 +02:00
parent af20dcf866
commit bad817d32d
11 changed files with 194 additions and 73 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
src/HSFM/FileSystem/Errors.hs
View File

@@ -16,8 +16,8 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |Provides error handling.
module HSFM.FileSystem.Errors where
@@ -42,17 +42,13 @@ import HPath
, Path
)
import HSFM.Utils.IO
import System.FilePath
(
equalFilePath
)
import System.IO.Error
(
catchIOError
)
import qualified System.Posix.Files as PF
import qualified System.Posix.Directory as PFD
import qualified System.Posix.Files.ByteString as PF
import qualified System.Posix.Directory.ByteString as PFD
data FmIOException = FileDoesNotExist String
@@ -84,22 +80,26 @@ instance Exception FmIOException
throwFileDoesExist :: Path Abs -> IO ()
throwFileDoesExist fp =
whenM (doesFileExist fp) (throw $ FileDoesExist $ P.fromAbs fp)
whenM (doesFileExist fp) (throw . FileDoesExist
. P.fpToString . P.fromAbs $ fp)
throwDirDoesExist :: Path Abs -> IO ()
throwDirDoesExist fp =
whenM (doesDirectoryExist fp) (throw $ DirDoesExist $ P.fromAbs fp)
whenM (doesDirectoryExist fp) (throw . DirDoesExist
. P.fpToString . P.fromAbs $ fp)
throwFileDoesNotExist :: Path Abs -> IO ()
throwFileDoesNotExist fp =
whenM (doesFileExist fp) (throw $ FileDoesExist $ P.fromAbs fp)
whenM (doesFileExist fp) (throw . FileDoesExist
. P.fpToString . P.fromAbs $ fp)
throwDirDoesNotExist :: Path Abs -> IO ()
throwDirDoesNotExist fp =
whenM (doesDirectoryExist fp) (throw $ DirDoesExist $ P.fromAbs fp)
whenM (doesDirectoryExist fp) (throw . DirDoesExist
. P.fpToString . P.fromAbs $ fp)
throwSameFile :: Path Abs -- ^ will be canonicalized
@@ -113,7 +113,8 @@ throwSameFile fp1 fp2 = do
(\_ -> fmap P.fromAbs
$ (P.</> P.basename fp2)
<$> (P.canonicalizePath $ P.dirname fp2))
when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
when (P.equalFilePath fp1' fp2') (throw $ SameFile (P.fpToString fp1')
(P.fpToString fp2'))
-- |Checks whether the destination directory is contained
@@ -133,7 +134,8 @@ throwDestinationInSource source dest = do
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
$ PF.getSymbolicLinkStatus (P.fromAbs source')
when (elem sid dids)
(throw $ DestinationInSource (P.fromAbs dest) (P.fromAbs source))
(throw $ DestinationInSource (P.fpToString $ P.fromAbs dest)
(P.fpToString $ P.fromAbs source))
-- |Checks if the given file exists and is not a directory. This follows
@@ -166,7 +168,8 @@ canOpenDirectory fp =
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
unlessM (canOpenDirectory fp) (throw $ Can'tOpenDirectory $ P.fromAbs fp)
unlessM (canOpenDirectory fp)
(throw . Can'tOpenDirectory . show . P.fromAbs $ fp)

43
src/HSFM/FileSystem/FileOperations.hs
View File

@@ -16,8 +16,9 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |This module provides all the atomic IO related file operations like
-- copy, delete, move and so on. It operates primarily on `AnchoredFile`, which
@@ -38,6 +39,10 @@ import Control.Monad
(
unless
)
import Data.ByteString
(
ByteString
)
import Data.Foldable
(
for_
@@ -55,12 +60,12 @@ import qualified HPath as P
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileType
import HSFM.Utils.IO
import System.Posix.Directory
import System.Posix.Directory.ByteString
(
createDirectory
, removeDirectory
)
import System.Posix.Files
import System.Posix.Files.ByteString
(
createSymbolicLink
, fileMode
@@ -79,22 +84,17 @@ import System.Posix.Files
, unionFileModes
, removeLink
)
import qualified "unix" System.Posix.IO as SPI
import qualified "unix" System.Posix.IO.ByteString as SPI
import "unix-bytestring" System.Posix.IO.ByteString
(
fdWrite
)
import qualified System.Posix.Process.ByteString as SPP
import System.Posix.Types
(
FileMode
, ProcessID
)
import System.Process
(
spawnProcess
, ProcessHandle
)
import qualified Data.ByteString as BS
@@ -110,7 +110,7 @@ data FileOperation = FCopy Copy
| FMove Move
| FDelete (AnchoredFile FileInfo)
| FOpen (AnchoredFile FileInfo)
| FExecute (AnchoredFile FileInfo) [String]
| FExecute (AnchoredFile FileInfo) [ByteString]
| None
@@ -264,9 +264,9 @@ copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
throwCantOpenDirectory . P.dirname . fullPath $ from
throwCantOpenDirectory . fullPath $ to
fromFstatus <- getSymbolicLinkStatus (P.fromAbs from')
fromContent <- BS.readFile (P.fromAbs from')
fromContent <- readFileContents from
fd <- SPI.createFile (P.fromAbs to')
(System.Posix.Files.fileMode fromFstatus)
(System.Posix.Files.ByteString.fileMode fromFstatus)
_ <- onException (fdWrite fd fromContent) (SPI.closeFd fd)
SPI.closeFd fd
@@ -335,7 +335,9 @@ deleteDirRecursive f@(_ :/ Dir {}) = do
(_ :/ SymLink {}) -> deleteSymlink file
(_ :/ Dir {}) -> deleteDirRecursive file
(_ :/ RegFile {}) -> removeLink (P.toFilePath . fullPath $ file)
_ -> throw $ FileDoesExist (P.toFilePath . fullPath $ file)
_ -> throw $ FileDoesExist
(P.fpToString . P.toFilePath . fullPath
$ file)
removeDirectory . P.toFilePath $ fp
deleteDirRecursive _ = throw $ InvalidOperation "wrong input type"
@@ -361,18 +363,19 @@ easyDelete _ = throw $ InvalidOperation "wrong input type"
-- |Opens a file appropriately by invoking xdg-open.
openFile :: AnchoredFile a
-> IO ProcessHandle
-> IO ProcessID
openFile AFileInvFN = throw InvalidFileName
openFile f = spawnProcess "xdg-open" [fullPathS f]
openFile f =
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fullPathS f] Nothing
-- |Executes a program with the given arguments.
executeFile :: AnchoredFile FileInfo -- ^ program
-> [String] -- ^ arguments
-> IO ProcessHandle
-> [ByteString] -- ^ arguments
-> IO ProcessID
executeFile AFileInvFN _ = throw InvalidFileName
executeFile prog@(_ :/ RegFile {}) args
= spawnProcess (fullPathS prog) args
= SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
executeFile _ _ = throw $ InvalidOperation "wrong input type"

54
src/HSFM/FileSystem/FileType.hs
View File

@@ -16,6 +16,8 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |This module provides data types for representing directories/files
@@ -30,6 +32,7 @@ module HSFM.FileSystem.FileType where
import Control.Exception
(
handle
, bracket
)
import Control.Exception.Base
(
@@ -40,11 +43,8 @@ import Control.Monad.State.Lazy
(
)
import Data.ByteString(ByteString)
import Data.Default
import Data.List
(
isPrefixOf
)
import Data.Time.Clock.POSIX
(
POSIXTime
@@ -60,12 +60,6 @@ import HPath
)
import qualified HPath as P
import HSFM.Utils.MyPrelude
import System.FilePath
(
isAbsolute
, pathSeparator
, (</>)
)
import System.IO.Error
(
ioeGetErrorType
@@ -83,8 +77,13 @@ import System.Posix.Types
, UserID
)
import qualified System.Posix.Files as PF
import qualified System.Posix.Directory as PFD
import qualified Data.ByteString as B
import qualified System.Posix.Directory.ByteString as PFD
import qualified System.Posix.Files.ByteString as PF
import qualified "unix" System.Posix.IO.ByteString as PIO
import qualified "unix-bytestring" System.Posix.IO.ByteString as PIOB
@@ -124,7 +123,7 @@ data File a =
, fvar :: a
, sdest :: AnchoredFile a -- ^ symlink madness,
-- we need to know where it points to
, rawdest :: FilePath
, rawdest :: ByteString
}
| BlockDev {
name :: Path Fn
@@ -250,7 +249,7 @@ invalidFileName :: Path Fn -> (Bool, Path Fn)
invalidFileName p@(Path "") = (True, p)
invalidFileName p@(Path ".") = (True, p)
invalidFileName p@(Path "..") = (True, p)
invalidFileName p = (elem pathSeparator (P.fromRel p), p)
invalidFileName p = (B.elem P.pathSeparator (P.fromRel p), p)
-- |Matches on invalid filesnames, such as ".", ".." and anything
@@ -409,7 +408,7 @@ readWith ff p = do
-- watch out, we call </> from 'filepath' here, but it is safe
-- TODO: could it happen that too many '..' lead
-- to something like '/' after normalization?
let sfp = if isAbsolute x then x else (P.fromAbs bd') </> x
let sfp = (P.fromAbs bd') `P.combine` x
rsfp <- P.realPath sfp
readWith ff =<< P.parseAbs rsfp
return $ SymLink fn' fv resolvedSyml x
@@ -511,6 +510,26 @@ comparingConstr t t' = compare (name t) (name t')
---------------------------
--[ LOW LEVEL FUNCTIONS ]--
---------------------------
-- |Follows symbolic links.
readFileContents :: AnchoredFile a -> IO ByteString
readFileContents af@(_ :/ RegFile{}) =
bracket (PIO.openFd f PIO.ReadOnly Nothing PIO.defaultFileFlags)
PIO.closeFd
$ \fd -> do
filesz <- fmap PF.fileSize $ PF.getFdStatus fd
PIOB.fdRead fd ((fromIntegral filesz `max` 0) + 1)
where
f = fullPathS af
readFileContents _ = return B.empty
---------------
--[ HELPERS ]--
---------------
@@ -684,7 +703,7 @@ isBrokenSymlink _ = False
hiddenFile :: Path Fn -> Bool
hiddenFile (Path ".") = False
hiddenFile (Path "..") = False
hiddenFile p = "." `isPrefixOf` (P.fromRel p)
hiddenFile p = "." `B.isPrefixOf` (P.fromRel p)
-- |Apply a function on the free variable. If there is no free variable
@@ -711,7 +730,7 @@ fullPath (bp :/ f) = bp P.</> name f
-- |Get the full path of the file, converted to a `FilePath`.
fullPathS :: AnchoredFile a -> FilePath
fullPathS :: AnchoredFile a -> ByteString
fullPathS = P.fromAbs . fullPath
@@ -728,6 +747,7 @@ packPermissions :: File FileInfo
-> String
packPermissions dt = fromFreeVar (pStr . fileMode) dt
where
pStr :: FileMode -> String
pStr ffm = typeModeStr ++ ownerModeStr ++ groupModeStr ++ otherModeStr
where
typeModeStr = case dt of