diff --git a/lib/Filesystem.hs b/lib/Filesystem.hs new file mode 100644 --- /dev/null +++ b/lib/Filesystem.hs @@ -0,0 +1,516 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE PackageImports #-} + +-- | +-- Module: Filesystem +-- Copyright: 2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Simple 'FilePath'‐aware wrappers around standard "System.IO" +-- computations. See the linked documentation for each computation for +-- details on exceptions and operating system interaction. +module Filesystem + ( IO.Handle + , IO.IOMode(..) + , rename + + -- * Files + , isFile + , getModified + , getSize + , copyFile + , removeFile + + -- ** Binary files + , openFile + , withFile + , readFile + , writeFile + , appendFile + + -- ** Text files + , openTextFile + , withTextFile + , readTextFile + , writeTextFile + , appendTextFile + + -- * Directories + , isDirectory + , canonicalizePath + , listDirectory + + -- ** Creating + , createDirectory + , createTree + + -- ** Removing + , removeDirectory + , removeTree + + -- ** Current working directory + , getWorkingDirectory + , setWorkingDirectory + + -- ** Commonly used paths + , getHomeDirectory + , getDesktopDirectory + , getDocumentsDirectory + , getAppDataDirectory + , getAppCacheDirectory + , getAppConfigDirectory + ) where + +import Prelude hiding (FilePath, readFile, writeFile, appendFile) + +import qualified Control.Exception as Exc +import qualified Data.ByteString as B +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Foreign.Ptr (Ptr, nullPtr) +import Foreign.C (CString, withCString, peekCString) +import qualified System.Environment as SE + +#if MIN_VERSION_system_filepath(0,4,0) +import Filesystem.Path (FilePath, append) +import Filesystem.Path.CurrentOS (currentOS, encodeString, decodeString) +import qualified Filesystem.Path.Rules as R +#else +import System.FilePath (FilePath, append) +import System.FilePath.CurrentOS (currentOS, encodeString, decodeString) +import qualified System.FilePath.Rules as R +#endif + +import qualified System.IO as IO +import System.IO.Error (isDoesNotExistError) + +#ifdef CABAL_OS_WINDOWS + +import Data.Bits ((.|.)) +import Data.Time ( UTCTime(..) + , fromGregorian + , secondsToDiffTime + , picosecondsToDiffTime) +import qualified System.Win32 as Win32 + +#else + +import Data.Time (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import qualified System.Posix as Posix +import qualified System.Posix.Error as Posix + +#endif + +-- hopefully temporary +import qualified "directory" System.Directory as SD + +-- | Check if a file exists at the given path. +-- +-- See: 'SD.doesFileExist' +isFile :: FilePath -> IO Bool +isFile path = SD.doesFileExist (encodeString path) + +-- | Check if a directory exists at the given path. +-- +-- See: 'SD.doesDirectoryExist' +isDirectory :: FilePath -> IO Bool +isDirectory path = SD.doesDirectoryExist (encodeString path) + +-- | Rename a filesystem object. Some operating systems have restrictions +-- on what objects can be renamed; see linked documentation for details. +-- +-- See: 'SD.renameFile' and 'SD.renameDirectory' +rename :: FilePath -> FilePath -> IO () +rename old new = + let old' = encodeString old in + let new' = encodeString new in +#ifdef CABAL_OS_WINDOWS + Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING +#else + Posix.rename old' new' +#endif + +-- Resolve symlinks and \"..\" path elements to return a canonical path. +-- It is intended that two paths referring to the same object will always +-- resolve to the same canonical path. +-- +-- Note that on many operating systems, it is impossible to guarantee that +-- two paths to the same file will resolve to the same canonical path. +-- +-- See: 'SD.canonicalizePath' +-- +-- Since: 0.1.1 +canonicalizePath :: FilePath -> IO FilePath +canonicalizePath path = fmap decodeString $ do + let path' = encodeString path +#ifdef CABAL_OS_WINDOWS +#if MIN_VERSION_Win32(2,2,1) + Win32.getFullPathName path' +#else + Win32.withTString path' $ \c_name -> do + Win32.try "getFullPathName" (\buf len -> + c_GetFullPathNameW c_name len buf nullPtr) 512 +#endif +#else + withCString path' $ \cPath -> do + cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr) + peekCString cOut +#endif + +#ifdef CABAL_OS_WINDOWS +#if MIN_VERSION_Win32(2,2,1) +#else +foreign import stdcall unsafe "GetFullPathNameW" + c_GetFullPathNameW :: Win32.LPCTSTR -> Win32.DWORD -> Win32.LPTSTR -> Ptr Win32.LPTSTR -> IO Win32.DWORD +#endif +#endif + +#ifndef CABAL_OS_WINDOWS +foreign import ccall unsafe "realpath" + c_realpath :: CString -> CString -> IO CString +#endif + +-- | Create a directory at a given path. The user may choose whether it is +-- an error for a directory to already exist at that path. +-- +-- See: 'SD.createDirectory'. +createDirectory :: Bool -- ^ Succeed if the directory already exists + -> FilePath -> IO () +createDirectory False path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.createDirectory path' Nothing +#else + Posix.createDirectory path' 0o777 +#endif +createDirectory True path = SD.createDirectoryIfMissing False (encodeString path) + +-- | Create a directory at a given path, including any parents which might +-- be missing. +-- +-- See: 'SD.createDirectoryIfMissing' +createTree :: FilePath -> IO () +createTree path = SD.createDirectoryIfMissing True (encodeString path) + +-- | List contents of a directory, excluding @\".\"@ and @\"..\"@. Each +-- returned 'FilePath' includes the path of the directory. +-- +-- See: 'SD.getDirectoryContents' +listDirectory :: FilePath -> IO [FilePath] +listDirectory path = fmap cleanup contents where + contents = SD.getDirectoryContents (encodeString path) + cleanup = map (append path) . map decodeString . filter (`notElem` [".", ".."]) + +-- | Remove a file. +-- +-- See: 'SD.removeFile' +removeFile :: FilePath -> IO () +removeFile path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.deleteFile path' +#else + Posix.removeLink path' +#endif + +-- | Remove an empty directory. +-- +-- See: 'SD.removeDirectory' +removeDirectory :: FilePath -> IO () +removeDirectory path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.removeDirectory path' +#else + Posix.removeDirectory path' +#endif + +-- | Recursively remove a directory tree rooted at the given path. +-- +-- See: 'SD.removeDirectoryRecursive' +removeTree :: FilePath -> IO () +removeTree path = SD.removeDirectoryRecursive (encodeString path) + +-- | Get the current working directory. +-- +-- See: 'SD.getCurrentDirectory' +getWorkingDirectory :: IO FilePath +getWorkingDirectory = fmap decodeString $ do +#ifdef CABAL_OS_WINDOWS +#if MIN_VERSION_Win32(2,2,1) + Win32.getCurrentDirectory +#else + Win32.try "getCurrentDirectory" (flip c_GetCurrentDirectoryW) 512 +#endif +#else + Posix.getWorkingDirectory +#endif + +#ifdef CABAL_OS_WINDOWS +#if MIN_VERSION_Win32(2,2,1) +#else +foreign import stdcall unsafe "GetCurrentDirectoryW" + c_GetCurrentDirectoryW :: Win32.DWORD -> Win32.LPTSTR -> IO Win32.UINT +#endif +#endif + +-- | Set the current working directory. +-- +-- See: 'SD.setCurrentDirectory' +setWorkingDirectory :: FilePath -> IO () +setWorkingDirectory path = + let path' = encodeString path in +#ifdef CABAL_OS_WINDOWS + Win32.setCurrentDirectory path' +#else + Posix.changeWorkingDirectory path' +#endif + +-- TODO: expose all known exceptions as specific types, for users to catch +-- if need be + +-- | Get the user’s home directory. This is useful for building paths +-- to more specific directories. +-- +-- For directing the user to open or safe a document, use +-- 'getDocumentsDirectory'. +-- +-- For data files the user does not explicitly create, such as automatic +-- saves, use 'getAppDataDirectory'. +-- +-- See: 'SD.getHomeDirectory' +getHomeDirectory :: IO FilePath +getHomeDirectory = fmap decodeString SD.getHomeDirectory + +-- | Get the user’s home directory. This is a good starting point for +-- file dialogs and other user queries. For data files the user does not +-- explicitly create, such as automatic saves, use 'getAppDataDirectory'. +getDesktopDirectory :: IO FilePath +getDesktopDirectory = xdg "XDG_DESKTOP_DIR" Nothing + (homeSlash "Desktop") + +-- | Get the user’s documents directory. This is a good place to save +-- user-created files. For data files the user does not explicitly create, +-- such as automatic saves, use 'getAppDataDirectory'. +-- +-- See: 'SD.getUserDocumentsDirectory' +getDocumentsDirectory :: IO FilePath +getDocumentsDirectory = xdg "XDG_DOCUMENTS_DIR" Nothing +#ifdef CABAL_OS_WINDOWS + (fmap decodeString SD.getUserDocumentsDirectory) +#else + (homeSlash "Documents") +#endif + +-- | Get the user’s application data directory, given an application +-- label. This directory is where applications should store data the user did +-- not explicitly create, such as databases and automatic saves. +-- +-- See: 'SD.getAppUserDataDirectory' +getAppDataDirectory :: T.Text -> IO FilePath +getAppDataDirectory label = xdg "XDG_DATA_HOME" (Just label) +#ifdef CABAL_OS_WINDOWS + (fmap decodeString (SD.getAppUserDataDirectory "")) +#else + (homeSlash ".local/share") +#endif + +-- | Get the user’s application cache directory, given an application +-- label. This directory is where applications should store caches, which +-- might be large and can be safely deleted. +getAppCacheDirectory :: T.Text -> IO FilePath +getAppCacheDirectory label = xdg "XDG_CACHE_HOME" (Just label) +#ifdef CABAL_OS_WINDOWS + (homeSlash "Local Settings\\Cache") +#else + (homeSlash ".cache") +#endif + +-- | Get the user’s application configuration directory, given an +-- application label. This directory is where applications should store their +-- configurations and settings. +getAppConfigDirectory :: T.Text -> IO FilePath +getAppConfigDirectory label = xdg "XDG_CONFIG_HOME" (Just label) +#ifdef CABAL_OS_WINDOWS + (homeSlash "Local Settings") +#else + (homeSlash ".config") +#endif + +homeSlash :: String -> IO FilePath +homeSlash path = do + home <- getHomeDirectory + return (append home (decodeString path)) + +getenv :: String -> IO (Maybe String) +getenv key = Exc.catch + (fmap Just (SE.getEnv key)) + (\e -> if isDoesNotExistError e + then return Nothing + else Exc.throwIO e) + +xdg :: String -> Maybe T.Text -> IO FilePath -> IO FilePath +xdg envkey label fallback = do + env <- getenv envkey + dir <- case env of + Just var -> return (decodeString var) + Nothing -> fallback + return $ case label of + Just text -> append dir (R.fromText currentOS text) + Nothing -> dir + +-- | Copy a file to a new entry in the filesystem. If a file already exists +-- at the new location, it will be replaced. +-- +-- See: 'SD.copyFile' +-- +-- Since: 0.1.1 +copyFile :: FilePath -- ^ Old location + -> FilePath -- ^ New location + -> IO () +copyFile old new = SD.copyFile (encodeString old) (encodeString new) + +-- | Get when the object at a given path was last modified. +-- +-- Since: 0.2 +getModified :: FilePath -> IO UTCTime +getModified path = do +#ifdef CABAL_OS_WINDOWS + info <- withHANDLE path Win32.getFileInformationByHandle + let ftime = Win32.bhfiLastWriteTime info + stime <- Win32.fileTimeToSystemTime ftime + + let date = fromGregorian + (fromIntegral (Win32.wYear stime)) + (fromIntegral (Win32.wMonth stime)) + (fromIntegral (Win32.wDay stime)) + + let seconds = secondsToDiffTime $ + (toInteger (Win32.wHour stime) * 3600) + + (toInteger (Win32.wMinute stime) * 60) + + (toInteger (Win32.wSecond stime)) + + let msecs = picosecondsToDiffTime $ + (toInteger (Win32.wMilliseconds stime) * 1000000000) + + return (UTCTime date (seconds + msecs)) +#else + stat <- Posix.getFileStatus (encodeString path) + let mtime = Posix.modificationTime stat + return (posixSecondsToUTCTime (realToFrac mtime)) +#endif + +-- | Get the size of an object at a given path. For special objects like +-- links or directories, the size is filesystem‐ and +-- platform‐dependent. +-- +-- Since: 0.2 +getSize :: FilePath -> IO Integer +getSize path = do +#ifdef CABAL_OS_WINDOWS + info <- withHANDLE path Win32.getFileInformationByHandle + return (toInteger (Win32.bhfiSize info)) +#else + stat <- Posix.getFileStatus (encodeString path) + return (toInteger (Posix.fileSize stat)) +#endif + +-- | Open a file in binary mode, and return an open 'Handle'. The 'Handle' +-- should be 'IO.hClose'd when it is no longer needed. +-- +-- 'withFile' is easier to use, because it will handle the 'Handle'’s +-- lifetime automatically. +-- +-- See: 'IO.openBinaryFile' +openFile :: FilePath -> IO.IOMode -> IO IO.Handle +openFile path = IO.openBinaryFile (encodeString path) + +-- | Open a file in binary mode, and pass its 'Handle' to a provided +-- computation. The 'Handle' will be automatically closed when the +-- computation returns. +-- +-- See: 'IO.withBinaryFile' +withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a +withFile path mode = Exc.bracket (openFile path mode) IO.hClose + +-- | Read in the entire contents of a binary file. +-- +-- See: 'B.readFile' +readFile :: FilePath -> IO B.ByteString +readFile path = withFile path IO.ReadMode + (\h -> IO.hFileSize h >>= B.hGet h . fromIntegral) + +-- | Replace the entire contents of a binary file with the provided +-- 'B.ByteString'. +-- +-- See: 'B.writeFile' +writeFile :: FilePath -> B.ByteString -> IO () +writeFile path bytes = withFile path IO.WriteMode + (\h -> B.hPut h bytes) + +-- | Append a 'B.ByteString' to a file. If the file does not exist, it will +-- be created. +-- +-- See: 'B.appendFile' +appendFile :: FilePath -> B.ByteString -> IO () +appendFile path bytes = withFile path IO.AppendMode + (\h -> B.hPut h bytes) + +-- | Open a file in text mode, and return an open 'Handle'. The 'Handle' +-- should be 'IO.hClose'd when it is no longer needed. +-- +-- 'withTextFile' is easier to use, because it will handle the +-- 'Handle'’s lifetime automatically. +-- +-- See: 'IO.openFile' +openTextFile :: FilePath -> IO.IOMode -> IO IO.Handle +openTextFile path = IO.openFile (encodeString path) + +-- | Open a file in text mode, and pass its 'Handle' to a provided +-- computation. The 'Handle' will be automatically closed when the +-- computation returns. +-- +-- See: 'IO.withFile' +withTextFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a +withTextFile path mode = Exc.bracket (openTextFile path mode) IO.hClose + +-- | Read in the entire contents of a text file. +-- +-- See: 'T.readFile' +readTextFile :: FilePath -> IO T.Text +readTextFile path = openTextFile path IO.ReadMode >>= T.hGetContents + +-- | Replace the entire contents of a text file with the provided +-- 'T.Text'. +-- +-- See: 'T.writeFile' +writeTextFile :: FilePath -> T.Text -> IO () +writeTextFile path text = withTextFile path IO.WriteMode + (\h -> T.hPutStr h text) + +-- | Append 'T.Text' to a file. If the file does not exist, it will +-- be created. +-- +-- See: 'T.appendFile' +appendTextFile :: FilePath -> T.Text -> IO () +appendTextFile path text = withTextFile path IO.AppendMode + (\h -> T.hPutStr h text) + +#ifdef CABAL_OS_WINDOWS +withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a +withHANDLE path = Exc.bracket open close where + open = Win32.createFile + (encodeString path) + Win32.gENERIC_READ + (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) + Nothing + Win32.oPEN_EXISTING + 0 + Nothing + close = Win32.closeHandle +#endif diff --git a/lib/System/Directory.hs b/lib/System/Directory.hs new file mode 100644 --- /dev/null +++ b/lib/System/Directory.hs @@ -0,0 +1,42 @@ +-- | +-- Module: System.Directory +-- Copyright: 2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Deprecated alias for "Filesystem". +module System.Directory + ( + + -- * Generic operations + isFile + , isDirectory + , rename + , canonicalizePath + , listDirectory + + -- * Creating things + , createDirectory + , createTree + + -- * Removing things + , removeFile + , removeDirectory + , removeTree + + -- * Current working directory + , getWorkingDirectory + , setWorkingDirectory + + -- * Commonly used paths + , getHomeDirectory + , getDesktopDirectory + , getDocumentsDirectory + , getAppDataDirectory + , getAppCacheDirectory + , getAppConfigDirectory + ) where + +import Filesystem diff --git a/lib/System/File.hs b/lib/System/File.hs new file mode 100644 --- /dev/null +++ b/lib/System/File.hs @@ -0,0 +1,36 @@ +-- | +-- Module: System.File +-- Copyright: 2011 John Millikin +-- License: MIT +-- +-- Maintainer: jmillikin@gmail.com +-- Portability: portable +-- +-- Deprecated alias for "Filesystem". +module System.File + ( Filesystem.Handle + , Filesystem.IOMode(..) + + -- * File operations + , copyFile + + -- * File information + , getModified + , getSize + + -- * Binary files + , openFile + , withFile + , Filesystem.readFile + , Filesystem.writeFile + , Filesystem.appendFile + + -- * Text files + , openTextFile + , withTextFile + , readTextFile + , writeTextFile + , appendTextFile + ) where + +import Filesystem diff --git a/scripts/common.bash b/scripts/common.bash new file mode 100644 --- /dev/null +++ b/scripts/common.bash @@ -0,0 +1,23 @@ +PATH="$PATH:$PWD/cabal-dev/bin/" + +VERSION=$(awk '/^version:/{print $2}' system-fileio.cabal) + +CABAL_DEV=$(which cabal-dev) +XZ=$(which xz) + +require_cabal_dev() +{ + if [ -z "$CABAL_DEV" ]; then + echo "Can't find 'cabal-dev' executable; make sure it exists on your "'$PATH' + echo "Cowardly refusing to fuck with the global package database" + exit 1 + fi +} + +clean_dev_install() +{ + require_cabal_dev + + rm -rf dist + $CABAL_DEV install || exit 1 +} diff --git a/scripts/run-coverage b/scripts/run-coverage new file mode 100644 --- /dev/null +++ b/scripts/run-coverage @@ -0,0 +1,28 @@ +#!/bin/bash +if [ ! -f 'system-fileio.cabal' ]; then + echo -n "Can't find system-fileio.cabal; please run this script as" + echo -n " ./scripts/run-coverage from within the system-fileio source" + echo " directory" + exit 1 +fi + +. scripts/common.bash + +require_cabal_dev + +pushd tests +$CABAL_DEV -s ../cabal-dev install --flags="coverage" || exit 1 +popd + +rm -f system-fileio_tests.tix +cabal-dev/bin/system-fileio_tests $@ + +EXCLUDES="\ +--exclude=Main \ +--exclude=FilesystemTests.Posix \ +--exclude=FilesystemTests.Util \ +--exclude=FilesystemTests.Windows +" + +hpc markup --srcdir=src --srcdir=tests/ system-fileio_tests.tix --destdir=hpc-markup $EXCLUDES > /dev/null +hpc report --srcdir=src --srcdir=tests/ system-fileio_tests.tix $EXCLUDES diff --git a/scripts/run-tests b/scripts/run-tests new file mode 100644 --- /dev/null +++ b/scripts/run-tests @@ -0,0 +1,17 @@ +#!/bin/bash +if [ ! -f 'system-fileio.cabal' ]; then + echo -n "Can't find system-fileio.cabal; please run this script as" + echo -n " ./scripts/run-tests from within the system-fileio source" + echo " directory" + exit 1 +fi + +. scripts/common.bash + +require_cabal_dev + +pushd tests +$CABAL_DEV -s ../cabal-dev install || exit 1 +popd + +cabal-dev/bin/system-fileio_tests $@ diff --git a/src/Filesystem.hs b/src/Filesystem.hs deleted file mode 100644 --- a/src/Filesystem.hs +++ /dev/null @@ -1,526 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE PackageImports #-} - --- | --- Module: Filesystem --- Copyright: 2011 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Simple 'FilePath'‐aware wrappers around standard "System.IO" --- computations. See the linked documentation for each computation for --- details on exceptions and operating system interaction. -module Filesystem - ( IO.Handle - , IO.IOMode(..) - , rename - - -- * Files - , isFile - , getModified - , getSize - , copyFile - , removeFile - - -- ** Binary files - , openFile - , withFile - , readFile - , writeFile - , appendFile - - -- ** Text files - , openTextFile - , withTextFile - , readTextFile - , writeTextFile - , appendTextFile - - -- * Directories - , isDirectory - , canonicalizePath - , listDirectory - - -- ** Creating - , createDirectory - , createTree - - -- ** Removing - , removeDirectory - , removeTree - - -- ** Current working directory - , getWorkingDirectory - , setWorkingDirectory - - -- ** Commonly used paths - , getHomeDirectory - , getDesktopDirectory - , getDocumentsDirectory - , getAppDataDirectory - , getAppCacheDirectory - , getAppConfigDirectory - ) where - -import Prelude hiding (FilePath, readFile, writeFile, appendFile) - -import qualified Control.Exception as Exc -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Foreign.Ptr (Ptr, nullPtr) -import Foreign.C (CString, withCString, peekCString) -import qualified System.Environment as SE - -#if MIN_VERSION_system_filepath(0,4,0) -import Filesystem.Path (FilePath, append) -import Filesystem.Path.CurrentOS (currentOS) -import qualified Filesystem.Path.Rules as R -#else -import System.FilePath (FilePath, append) -import System.FilePath.CurrentOS (currentOS) -import qualified System.FilePath.Rules as R -#endif - -import qualified System.IO as IO -import System.IO.Error (isDoesNotExistError) - -#ifdef CABAL_OS_WINDOWS - -import Data.Bits ((.|.)) -import Data.Time ( UTCTime(..) - , fromGregorian - , secondsToDiffTime - , picosecondsToDiffTime) -import qualified System.Win32 as Win32 - -#else - -import Data.Time (UTCTime) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import qualified System.Posix as Posix -import qualified System.Posix.Error as Posix - -#endif - --- hopefully temporary -import qualified "directory" System.Directory as SD - --- | Check if a file exists at the given path. --- --- See: 'SD.doesFileExist' -isFile :: FilePath -> IO Bool -isFile path = SD.doesFileExist (encodeString path) - --- | Check if a directory exists at the given path. --- --- See: 'SD.doesDirectoryExist' -isDirectory :: FilePath -> IO Bool -isDirectory path = SD.doesDirectoryExist (encodeString path) - --- | Rename a filesystem object. Some operating systems have restrictions --- on what objects can be renamed; see linked documentation for details. --- --- See: 'SD.renameFile' and 'SD.renameDirectory' -rename :: FilePath -> FilePath -> IO () -rename old new = - let old' = encodeString old in - let new' = encodeString new in -#ifdef CABAL_OS_WINDOWS - Win32.moveFileEx old' new' Win32.mOVEFILE_REPLACE_EXISTING -#else - Posix.rename old' new' -#endif - --- Resolve symlinks and \"..\" path elements to return a canonical path. --- It is intended that two paths referring to the same object will always --- resolve to the same canonical path. --- --- Note that on many operating systems, it is impossible to guarantee that --- two paths to the same file will resolve to the same canonical path. --- --- See: 'SD.canonicalizePath' --- --- Since: 0.1.1 -canonicalizePath :: FilePath -> IO FilePath -canonicalizePath path = fmap decodeString $ do - let path' = encodeString path -#ifdef CABAL_OS_WINDOWS -#if MIN_VERSION_Win32(2,2,1) - Win32.getFullPathName path' -#else - Win32.withTString path' $ \c_name -> do - Win32.try "getFullPathName" (\buf len -> - c_GetFullPathNameW c_name len buf nullPtr) 512 -#endif -#else - withCString path' $ \cPath -> do - cOut <- Posix.throwErrnoPathIfNull "canonicalizePath" path' (c_realpath cPath nullPtr) - peekCString cOut -#endif - -#ifdef CABAL_OS_WINDOWS -#if MIN_VERSION_Win32(2,2,1) -#else -foreign import stdcall unsafe "GetFullPathNameW" - c_GetFullPathNameW :: Win32.LPCTSTR -> Win32.DWORD -> Win32.LPTSTR -> Ptr Win32.LPTSTR -> IO Win32.DWORD -#endif -#endif - -#ifndef CABAL_OS_WINDOWS -foreign import ccall unsafe "realpath" - c_realpath :: CString -> CString -> IO CString -#endif - --- | Create a directory at a given path. The user may choose whether it is --- an error for a directory to already exist at that path. --- --- See: 'SD.createDirectory'. -createDirectory :: Bool -- ^ Succeed if the directory already exists - -> FilePath -> IO () -createDirectory False path = - let path' = encodeString path in -#ifdef CABAL_OS_WINDOWS - Win32.createDirectory path' Nothing -#else - Posix.createDirectory path' 0o777 -#endif -createDirectory True path = SD.createDirectoryIfMissing False (encodeString path) - --- | Create a directory at a given path, including any parents which might --- be missing. --- --- See: 'SD.createDirectoryIfMissing' -createTree :: FilePath -> IO () -createTree path = SD.createDirectoryIfMissing True (encodeString path) - --- | List contents of a directory, excluding @\".\"@ and @\"..\"@. Each --- returned 'FilePath' includes the path of the directory. --- --- See: 'SD.getDirectoryContents' -listDirectory :: FilePath -> IO [FilePath] -listDirectory path = fmap cleanup contents where - contents = SD.getDirectoryContents (encodeString path) - cleanup = map (append path) . map decodeString . filter (`notElem` [".", ".."]) - --- | Remove a file. --- --- See: 'SD.removeFile' -removeFile :: FilePath -> IO () -removeFile path = - let path' = encodeString path in -#ifdef CABAL_OS_WINDOWS - Win32.deleteFile path' -#else - Posix.removeLink path' -#endif - --- | Remove an empty directory. --- --- See: 'SD.removeDirectory' -removeDirectory :: FilePath -> IO () -removeDirectory path = - let path' = encodeString path in -#ifdef CABAL_OS_WINDOWS - Win32.removeDirectory path' -#else - Posix.removeDirectory path' -#endif - --- | Recursively remove a directory tree rooted at the given path. --- --- See: 'SD.removeDirectoryRecursive' -removeTree :: FilePath -> IO () -removeTree path = SD.removeDirectoryRecursive (encodeString path) - --- | Get the current working directory. --- --- See: 'SD.getCurrentDirectory' -getWorkingDirectory :: IO FilePath -getWorkingDirectory = fmap decodeString $ do -#ifdef CABAL_OS_WINDOWS -#if MIN_VERSION_Win32(2,2,1) - Win32.getCurrentDirectory -#else - Win32.try "getCurrentDirectory" (flip c_GetCurrentDirectoryW) 512 -#endif -#else - Posix.getWorkingDirectory -#endif - -#ifdef CABAL_OS_WINDOWS -#if MIN_VERSION_Win32(2,2,1) -#else -foreign import stdcall unsafe "GetCurrentDirectoryW" - c_GetCurrentDirectoryW :: Win32.DWORD -> Win32.LPTSTR -> IO Win32.UINT -#endif -#endif - --- | Set the current working directory. --- --- See: 'SD.setCurrentDirectory' -setWorkingDirectory :: FilePath -> IO () -setWorkingDirectory path = - let path' = encodeString path in -#ifdef CABAL_OS_WINDOWS - Win32.setCurrentDirectory path' -#else - Posix.changeWorkingDirectory path' -#endif - --- TODO: expose all known exceptions as specific types, for users to catch --- if need be - --- | Get the user’s home directory. This is useful for building paths --- to more specific directories. --- --- For directing the user to open or safe a document, use --- 'getDocumentsDirectory'. --- --- For data files the user does not explicitly create, such as automatic --- saves, use 'getAppDataDirectory'. --- --- See: 'SD.getHomeDirectory' -getHomeDirectory :: IO FilePath -getHomeDirectory = fmap decodeString SD.getHomeDirectory - --- | Get the user’s home directory. This is a good starting point for --- file dialogs and other user queries. For data files the user does not --- explicitly create, such as automatic saves, use 'getAppDataDirectory'. -getDesktopDirectory :: IO FilePath -getDesktopDirectory = xdg "XDG_DESKTOP_DIR" Nothing - (homeSlash "Desktop") - --- | Get the user’s documents directory. This is a good place to save --- user-created files. For data files the user does not explicitly create, --- such as automatic saves, use 'getAppDataDirectory'. --- --- See: 'SD.getUserDocumentsDirectory' -getDocumentsDirectory :: IO FilePath -getDocumentsDirectory = xdg "XDG_DOCUMENTS_DIR" Nothing -#ifdef CABAL_OS_WINDOWS - (fmap decodeString SD.getUserDocumentsDirectory) -#else - (homeSlash "Documents") -#endif - --- | Get the user’s application data directory, given an application --- label. This directory is where applications should store data the user did --- not explicitly create, such as databases and automatic saves. --- --- See: 'SD.getAppUserDataDirectory' -getAppDataDirectory :: T.Text -> IO FilePath -getAppDataDirectory label = xdg "XDG_DATA_HOME" (Just label) -#ifdef CABAL_OS_WINDOWS - (fmap decodeString (SD.getAppUserDataDirectory "")) -#else - (homeSlash ".local/share") -#endif - --- | Get the user’s application cache directory, given an application --- label. This directory is where applications should store caches, which --- might be large and can be safely deleted. -getAppCacheDirectory :: T.Text -> IO FilePath -getAppCacheDirectory label = xdg "XDG_CACHE_HOME" (Just label) -#ifdef CABAL_OS_WINDOWS - (homeSlash "Local Settings\\Cache") -#else - (homeSlash ".cache") -#endif - --- | Get the user’s application configuration directory, given an --- application label. This directory is where applications should store their --- configurations and settings. -getAppConfigDirectory :: T.Text -> IO FilePath -getAppConfigDirectory label = xdg "XDG_CONFIG_HOME" (Just label) -#ifdef CABAL_OS_WINDOWS - (homeSlash "Local Settings") -#else - (homeSlash ".config") -#endif - -homeSlash :: String -> IO FilePath -homeSlash path = do - home <- getHomeDirectory - return (append home (decodeString path)) - -getenv :: String -> IO (Maybe String) -getenv key = Exc.catch - (fmap Just (SE.getEnv key)) - (\e -> if isDoesNotExistError e - then return Nothing - else Exc.throwIO e) - -xdg :: String -> Maybe T.Text -> IO FilePath -> IO FilePath -xdg envkey label fallback = do - env <- getenv envkey - dir <- case env of - Just var -> return (decodeString var) - Nothing -> fallback - return $ case label of - Just text -> append dir (R.fromText currentOS text) - Nothing -> dir - --- | Copy a file to a new entry in the filesystem. If a file already exists --- at the new location, it will be replaced. --- --- See: 'SD.copyFile' --- --- Since: 0.1.1 -copyFile :: FilePath -- ^ Old location - -> FilePath -- ^ New location - -> IO () -copyFile old new = SD.copyFile (encodeString old) (encodeString new) - --- | Get when the object at a given path was last modified. --- --- Since: 0.2 -getModified :: FilePath -> IO UTCTime -getModified path = do -#ifdef CABAL_OS_WINDOWS - info <- withHANDLE path Win32.getFileInformationByHandle - let ftime = Win32.bhfiLastWriteTime info - stime <- Win32.fileTimeToSystemTime ftime - - let date = fromGregorian - (fromIntegral (Win32.wYear stime)) - (fromIntegral (Win32.wMonth stime)) - (fromIntegral (Win32.wDay stime)) - - let seconds = secondsToDiffTime $ - (toInteger (Win32.wHour stime) * 3600) + - (toInteger (Win32.wMinute stime) * 60) + - (toInteger (Win32.wSecond stime)) - - let msecs = picosecondsToDiffTime $ - (toInteger (Win32.wMilliseconds stime) * 1000000000) - - return (UTCTime date (seconds + msecs)) -#else - stat <- Posix.getFileStatus (encodeString path) - let mtime = Posix.modificationTime stat - return (posixSecondsToUTCTime (realToFrac mtime)) -#endif - --- | Get the size of an object at a given path. For special objects like --- links or directories, the size is filesystem‐ and --- platform‐dependent. --- --- Since: 0.2 -getSize :: FilePath -> IO Integer -getSize path = do -#ifdef CABAL_OS_WINDOWS - info <- withHANDLE path Win32.getFileInformationByHandle - return (toInteger (Win32.bhfiSize info)) -#else - stat <- Posix.getFileStatus (encodeString path) - return (toInteger (Posix.fileSize stat)) -#endif - --- | Open a file in binary mode, and return an open 'Handle'. The 'Handle' --- should be 'IO.hClose'd when it is no longer needed. --- --- 'withFile' is easier to use, because it will handle the 'Handle'’s --- lifetime automatically. --- --- See: 'IO.openBinaryFile' -openFile :: FilePath -> IO.IOMode -> IO IO.Handle -openFile path = IO.openBinaryFile (encodeString path) - --- | Open a file in binary mode, and pass its 'Handle' to a provided --- computation. The 'Handle' will be automatically closed when the --- computation returns. --- --- See: 'IO.withBinaryFile' -withFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a -withFile path = IO.withBinaryFile (encodeString path) - --- | Read in the entire contents of a binary file. --- --- See: 'B.readFile' -readFile :: FilePath -> IO B.ByteString -readFile path = B.readFile (encodeString path) - --- | Replace the entire contents of a binary file with the provided --- 'B.ByteString'. --- --- See: 'B.writeFile' -writeFile :: FilePath -> B.ByteString -> IO () -writeFile path = B.writeFile (encodeString path) - --- | Append a 'B.ByteString' to a file. If the file does not exist, it will --- be created. --- --- See: 'B.appendFile' -appendFile :: FilePath -> B.ByteString -> IO () -appendFile path = B.appendFile (encodeString path) - --- | Open a file in text mode, and return an open 'Handle'. The 'Handle' --- should be 'IO.hClose'd when it is no longer needed. --- --- 'withTextFile' is easier to use, because it will handle the --- 'Handle'’s lifetime automatically. --- --- See: 'IO.openFile' -openTextFile :: FilePath -> IO.IOMode -> IO IO.Handle -openTextFile path = IO.openFile (encodeString path) - --- | Open a file in text mode, and pass its 'Handle' to a provided --- computation. The 'Handle' will be automatically closed when the --- computation returns. --- --- See: 'IO.withFile' -withTextFile :: FilePath -> IO.IOMode -> (IO.Handle -> IO a) -> IO a -withTextFile path = IO.withFile (encodeString path) - --- | Read in the entire contents of a text file. --- --- See: 'T.readFile' -readTextFile :: FilePath -> IO T.Text -readTextFile path = T.readFile (encodeString path) - --- | Replace the entire contents of a text file with the provided --- 'T.Text'. --- --- See: 'T.writeFile' -writeTextFile :: FilePath -> T.Text -> IO () -writeTextFile path = T.writeFile (encodeString path) - --- | Append 'T.Text' to a file. If the file does not exist, it will --- be created. --- --- See: 'T.appendFile' -appendTextFile :: FilePath -> T.Text -> IO () -appendTextFile path = T.appendFile (encodeString path) - -#ifdef CABAL_OS_WINDOWS -withHANDLE :: FilePath -> (Win32.HANDLE -> IO a) -> IO a -withHANDLE path = Exc.bracket open close where - open = Win32.createFile - (encodeString path) - Win32.gENERIC_READ - (Win32.fILE_SHARE_READ .|. Win32.fILE_SHARE_WRITE) - Nothing - Win32.oPEN_EXISTING - 0 - Nothing - close = Win32.closeHandle -#endif - -encodeString :: FilePath -> String -#ifdef CABAL_OS_WINDOWS -encodeString = T.unpack . R.encode R.windows -#else -encodeString = B8.unpack . R.encode R.posix -#endif - -decodeString :: String -> FilePath -#ifdef CABAL_OS_WINDOWS -decodeString = R.decode R.windows . T.pack -#else -decodeString = R.decode R.posix . B8.pack -#endif diff --git a/src/System/Directory.hs b/src/System/Directory.hs deleted file mode 100644 --- a/src/System/Directory.hs +++ /dev/null @@ -1,42 +0,0 @@ --- | --- Module: System.Directory --- Copyright: 2011 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated alias for "Filesystem". -module System.Directory - ( - - -- * Generic operations - isFile - , isDirectory - , rename - , canonicalizePath - , listDirectory - - -- * Creating things - , createDirectory - , createTree - - -- * Removing things - , removeFile - , removeDirectory - , removeTree - - -- * Current working directory - , getWorkingDirectory - , setWorkingDirectory - - -- * Commonly used paths - , getHomeDirectory - , getDesktopDirectory - , getDocumentsDirectory - , getAppDataDirectory - , getAppCacheDirectory - , getAppConfigDirectory - ) where - -import Filesystem diff --git a/src/System/File.hs b/src/System/File.hs deleted file mode 100644 --- a/src/System/File.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | --- Module: System.File --- Copyright: 2011 John Millikin --- License: MIT --- --- Maintainer: jmillikin@gmail.com --- Portability: portable --- --- Deprecated alias for "Filesystem". -module System.File - ( Filesystem.Handle - , Filesystem.IOMode(..) - - -- * File operations - , copyFile - - -- * File information - , getModified - , getSize - - -- * Binary files - , openFile - , withFile - , Filesystem.readFile - , Filesystem.writeFile - , Filesystem.appendFile - - -- * Text files - , openTextFile - , withTextFile - , readTextFile - , writeTextFile - , appendTextFile - ) where - -import Filesystem diff --git a/system-fileio.cabal b/system-fileio.cabal --- a/system-fileio.cabal +++ b/system-fileio.cabal @@ -1,5 +1,5 @@ name: system-fileio -version: 0.2.2.1 +version: 0.2.3 synopsis: High-level filesystem interaction license: MIT license-file: license.txt @@ -17,6 +17,17 @@ This is a small wrapper around the \"directory\", \"unix\", and \"Win32\" packages for use with \"system-filepath\". +extra-source-files: + scripts/common.bash + scripts/run-coverage + scripts/run-tests + -- + tests/system-fileio-tests.cabal + tests/FilesystemTests.hs + tests/FilesystemTests/Posix.hs + tests/FilesystemTests/Util.hs + tests/FilesystemTests/Windows.hs + source-repository head type: bzr location: https://john-millikin.com/software/hs-fileio/ @@ -24,18 +35,18 @@ source-repository this type: bzr location: https://john-millikin.com/branches/hs-fileio/0.2/ - tag: system-fileio_0.2.2.1 + tag: system-fileio_0.2.3 library ghc-options: -Wall -O2 - hs-source-dirs: src + hs-source-dirs: lib build-depends: - base >= 3 && < 5 + base >= 4.0 && < 5.0 , bytestring >= 0.9 && < 0.10 , directory >= 1.0 && < 1.2 - , system-filepath >= 0.3 && < 0.5 - , text >= 0.1 && < 0.12 + , system-filepath >= 0.3.1 && < 0.5 + , text >= 0.7.1 && < 0.12 , time >= 1.0 && < 1.5 if os(windows) diff --git a/tests/FilesystemTests.hs b/tests/FilesystemTests.hs new file mode 100644 --- /dev/null +++ b/tests/FilesystemTests.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2011 John Millikin +-- +-- See license.txt for details +module Main + ( tests + , main + ) where + +import Test.Chell + +#ifdef CABAL_OS_WINDOWS +import FilesystemTests.Windows (test_Windows) +#else +import FilesystemTests.Posix (test_Posix) +#endif + +main :: IO () +main = Test.Chell.defaultMain tests + +tests :: [Suite] +#ifdef CABAL_OS_WINDOWS +tests = [test_Windows] +#else +tests = [test_Posix] +#endif diff --git a/tests/FilesystemTests/Posix.hs b/tests/FilesystemTests/Posix.hs new file mode 100644 --- /dev/null +++ b/tests/FilesystemTests/Posix.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2011 John Millikin +-- +-- See license.txt for details +module FilesystemTests.Posix + ( test_Posix + ) where + +import Prelude hiding (FilePath) +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString +import Data.Text (Text) +import Data.Text.Encoding (encodeUtf8) +import Foreign +import Foreign.C +import Test.Chell + +import Filesystem +import Filesystem.Path.CurrentOS + +import FilesystemTests.Util (assertionsWithTemp, todo) + +test_Posix :: Suite +test_Posix = suite "posix" + [ suite "isFile" + [ test_IsFile "ascii" + (decode "test.txt") + , test_IsFile "utf8" + (fromText "\xA1\xA2.txt") + , test_IsFile "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + , suite "isDirectory" + [ test_IsDirectory "ascii" + (decode "test.d") + , test_IsDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_IsDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + , suite "rename" + [ test_Rename "ascii" + (decode "old_test.txt") + (decode "new_test.txt") + , test_Rename "utf8" + (fromText "old_\xA1\xA2.txt") + (fromText "new_\xA1\xA2.txt") + , test_Rename "iso8859" + (decode "old_\xA1\xA2\xA3.txt") + (decode "new_\xA1\xA2\xA3.txt") + ] + , suite "canonicalizePath" + [ test_CanonicalizePath "ascii" + (decode "test-a.txt") + (decode "test-b.txt") + , test_CanonicalizePath "utf8" + (fromText "\xA1\xA2-a.txt") + (fromText "\xA1\xA2-b.txt") + , test_CanonicalizePath "iso8859" + (decode "\xA1\xA2\xA3-a.txt") + (decode "\xA1\xA2\xA3-b.txt") + ] + , todo "createDirectory" + , todo "createTree" + , test_ListDirectory + , todo "removeFile" + , todo "removeDirectory" + , todo "removeTree" + , todo "getWorkingDirectory" + , todo "setWorkingDirectory" + , todo "getHomeDirectory" + , todo "getDesktopDirectory" + , todo "getDocumentsDirectory" + , todo "getAppDataDirectory" + , todo "getAppCacheDirectory" + , todo "getAppConfigDirectory" + , todo "copyFile" + , todo "getModified" + , todo "getSize" + , todo "openFile" + , todo "withFile" + , todo "readFile" + , todo "writeFile" + , todo "appendFile" + , todo "openTextFile" + , todo "withTextFile" + , todo "readTextFile" + , todo "writeTextFile" + , todo "appendTextFile" + ] + +test_IsFile :: Text -> FilePath -> Suite +test_IsFile test_name file_name = assertionsWithTemp test_name $ \dir -> do + let path = dir file_name + + before <- liftIO $ Filesystem.isFile path + $expect (not before) + + touch_ffi path "contents\n" + + after <- liftIO $ Filesystem.isFile path + $expect after + +test_IsDirectory :: Text -> FilePath -> Suite +test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \dir -> do + let path = dir dir_name + + before <- liftIO $ Filesystem.isDirectory path + $expect (not before) + + mkdir_ffi path + + after <- liftIO $ Filesystem.isDirectory path + $expect after + +test_Rename :: Text -> FilePath -> FilePath -> Suite +test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \dir -> do + let old_path = dir old_name + let new_path = dir new_name + + touch_ffi old_path "" + + old_before <- liftIO $ Filesystem.isFile old_path + new_before <- liftIO $ Filesystem.isFile new_path + $expect old_before + $expect (not new_before) + + liftIO $ Filesystem.rename old_path new_path + + old_after <- liftIO $ Filesystem.isFile old_path + new_after <- liftIO $ Filesystem.isFile new_path + $expect (not old_after) + $expect new_after + +test_ListDirectory :: Suite +test_ListDirectory = assertionsWithTemp "listDirectory" $ \dir -> do + let paths = + [ dir decode "test.txt" + , dir fromText "\xA1\xA2.txt" + , dir decode "\xA1\xA2\xA3.txt" + ] + forM_ paths (\path -> touch_ffi path "") + + names <- liftIO $ Filesystem.listDirectory dir + $expect $ sameItems paths names + +test_CanonicalizePath :: Text -> FilePath -> FilePath -> Suite +test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \dir -> do + let src_path = dir src_name + let subdir = dir "subdir" + + -- canonicalize the directory first, to avoid false negatives if + -- it gets placed in a symlinked location. + mkdir_ffi subdir + canon_subdir <- liftIO (Filesystem.canonicalizePath subdir) + + let dst_path = canon_subdir dst_name + + touch_ffi dst_path "" + symlink_ffi dst_path src_path + + canonicalized <- liftIO $ Filesystem.canonicalizePath src_path + $expect $ equal canonicalized dst_path + +withPathCString :: FilePath -> (CString -> IO a) -> IO a +withPathCString p = Data.ByteString.useAsCString bytes where +#ifdef CABAL_OS_DARWIN + bytes = encodeUtf8 (encode p) +#else + bytes = encode p +#endif + +-- | Create a file using the raw POSIX API, via FFI +touch_ffi :: FilePath -> Data.ByteString.ByteString -> Assertions () +touch_ffi path contents = do + fp <- liftIO $ withPathCString path $ \path_cstr -> + Foreign.C.withCString "wb" $ \mode_cstr -> + c_fopen path_cstr mode_cstr + + $assert (fp /= nullPtr) + + _ <- liftIO $ Data.ByteString.useAsCStringLen contents $ \(buf, len) -> + c_fwrite buf 1 (fromIntegral len) fp + + _ <- liftIO $ c_fclose fp + return () + +-- | Create a directory using the raw POSIX API, via FFI +mkdir_ffi :: FilePath -> Assertions () +mkdir_ffi path = do + ret <- liftIO $ withPathCString path $ \path_cstr -> + c_mkdir path_cstr 0o700 + + $assert (ret == 0) + +-- | Create a symlink using the raw POSIX API, via FFI +symlink_ffi :: FilePath -> FilePath -> Assertions () +symlink_ffi dst src = do + ret <- liftIO $ + withPathCString dst $ \dst_p -> + withPathCString src $ \src_p -> + c_symlink dst_p src_p + + $assert (ret == 0) + +foreign import ccall unsafe "fopen" + c_fopen :: CString -> CString -> IO (Ptr ()) + +foreign import ccall unsafe "fclose" + c_fclose :: Ptr () -> IO CInt + +foreign import ccall unsafe "fwrite" + c_fwrite :: CString -> CSize -> CSize -> Ptr () -> IO CSize + +foreign import ccall unsafe "mkdir" + c_mkdir :: CString -> CInt -> IO CInt + +foreign import ccall unsafe "symlink" + c_symlink :: CString -> CString -> IO CInt diff --git a/tests/FilesystemTests/Util.hs b/tests/FilesystemTests/Util.hs new file mode 100644 --- /dev/null +++ b/tests/FilesystemTests/Util.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2011 John Millikin +-- +-- See license.txt for details +module FilesystemTests.Util + ( assertionsWithTemp + , todo + ) where + +import Prelude hiding (FilePath) +import Data.Text (Text, unpack) +import System.IO.Temp (withSystemTempDirectory) +import Test.Chell + +import Filesystem.Path.CurrentOS (FilePath, decodeString) + +assertionsWithTemp :: Text -> (FilePath -> Assertions a) -> Suite +assertionsWithTemp name io = test (Test name impl) where + impl options = withSystemTempDirectory ("tests." ++ unpack name ++ ".") $ \dir -> do + let dirPath = decodeString dir + case suiteTests (assertions name (io dirPath)) of + [(Test _ io')] -> io' options + _ -> error "assertionsWithTemp: use in place of 'assertions' only." + +todo :: Text -> Suite +todo name = skipIf True (assertions name (return ())) diff --git a/tests/FilesystemTests/Windows.hs b/tests/FilesystemTests/Windows.hs new file mode 100644 --- /dev/null +++ b/tests/FilesystemTests/Windows.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +-- Copyright (C) 2011 John Millikin +-- +-- See license.txt for details +module FilesystemTests.Windows + ( test_Windows + ) where + +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Test.Chell + +import Filesystem +import Filesystem.Path.CurrentOS + +import FilesystemTests.Util (assertionsWithTemp, todo) + +test_Windows :: Suite +test_Windows = suite "windows" + [ todo "isFile" + , todo "isDirectory" + , todo "rename" + , todo "canonicalizePath" + , todo "createDirectory" + , todo "createTree" + , test_ListDirectory + , todo "removeFile" + , todo "removeDirectory" + , todo "removeTree" + , todo "getWorkingDirectory" + , todo "setWorkingDirectory" + , todo "getHomeDirectory" + , todo "getDesktopDirectory" + , todo "getDocumentsDirectory" + , todo "getAppDataDirectory" + , todo "getAppCacheDirectory" + , todo "getAppConfigDirectory" + , todo "copyFile" + , todo "getModified" + , todo "getSize" + , todo "openFile" + , todo "withFile" + , todo "readFile" + , todo "writeFile" + , todo "appendFile" + , todo "openTextFile" + , todo "withTextFile" + , todo "readTextFile" + , todo "writeTextFile" + , todo "appendTextFile" + ] + +test_ListDirectory :: Suite +test_ListDirectory = assertionsWithTemp "listDirectory" $ \dir -> do + let paths = + [ dir decode "test.txt" + , dir decode "\12354\946\1076\119070.txt" + , dir decode "\xA1\xA2\xA3.txt" + ] + + liftIO $ forM_ paths (\path -> writeTextFile path "") + + names <- liftIO $ Filesystem.listDirectory dir + $expect $ sameItems paths names diff --git a/tests/system-fileio-tests.cabal b/tests/system-fileio-tests.cabal new file mode 100644 --- /dev/null +++ b/tests/system-fileio-tests.cabal @@ -0,0 +1,38 @@ +name: system-fileio-tests +version: 0 +build-type: Simple +cabal-version: >= 1.6 + +flag coverage + default: False + manual: True + +executable system-fileio_tests + main-is: FilesystemTests.hs + ghc-options: -Wall + hs-source-dirs: ../lib,. + + if flag(coverage) + ghc-options: -fhpc + + build-depends: + base >= 4.0 && < 5.0 + , bytestring >= 0.9 && < 0.10 + , chell >= 0.2 && < 0.3 + , directory >= 1.0 && < 1.2 + , system-filepath >= 0.3 && < 0.5 + , temporary >= 1.1 && < 2.0 + , text >= 0.1 && < 0.12 + , time >= 1.0 && < 1.5 + , transformers >= 0.2 && < 0.3 + + if os(windows) + cpp-options: -DCABAL_OS_WINDOWS + + if os(darwin) + cpp-options: -DCABAL_OS_DARWIN + + if os(windows) + build-depends: Win32 >= 2.2 && < 2.3 + else + build-depends: unix >= 2.3 && < 2.6