Cleanup, improve docs

This commit is contained in:
Julian Ospald 2016-05-09 17:37:16 +02:00
parent 3bbde22377
commit f27becc4df
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
5 changed files with 60 additions and 21 deletions

View File

@ -14,7 +14,6 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HPath module HPath
( (
@ -48,10 +47,6 @@ module HPath
-- * ByteString operations -- * ByteString operations
,fpToString ,fpToString
,userStringToFP ,userStringToFP
-- * Queries
,hasParentDir
,isFileName
-- * String based functions
) )
where where
@ -211,13 +206,15 @@ parseFn filepath =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Path Conversion -- Path Conversion
-- | Convert to a ByteString type. -- | Convert any Path to a ByteString type.
toFilePath :: Path b -> ByteString toFilePath :: Path b -> ByteString
toFilePath (MkPath l) = l toFilePath (MkPath l) = l
-- | Convert an absolute Path to a ByteString type.
fromAbs :: Path Abs -> ByteString fromAbs :: Path Abs -> ByteString
fromAbs = toFilePath fromAbs = toFilePath
-- | Convert a relative Path to a ByteString type.
fromRel :: RelC r => Path r -> ByteString fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath fromRel = toFilePath

View File

@ -8,7 +8,7 @@
-- Portability : portable -- Portability : portable
-- --
-- This module provides high-level IO related file operations like -- This module provides high-level IO related file operations like
-- copy, delete, move and so on. It only operates on `Path Abs` which -- copy, delete, move and so on. It only operates on /Path Abs/ which
-- guarantees us well-typed paths which are absolute. -- guarantees us well-typed paths which are absolute.
-- --
-- Some functions are just path-safe wrappers around -- Some functions are just path-safe wrappers around
@ -16,7 +16,7 @@
-- and some implement functionality that doesn't have a unix -- and some implement functionality that doesn't have a unix
-- counterpart (like `copyDirRecursive`). -- counterpart (like `copyDirRecursive`).
-- --
-- Some of these operations are due to their nature not _atomic_, which -- Some of these operations are due to their nature __not atomic__, which
-- means they may do multiple syscalls which form one context. Some -- means they may do multiple syscalls which form one context. Some
-- of them also have to examine the filetypes explicitly before the -- of them also have to examine the filetypes explicitly before the
-- syscalls, so a reasonable decision can be made. That means -- syscalls, so a reasonable decision can be made. That means
@ -24,13 +24,52 @@
-- while the non-atomic operation is still happening. However, where -- while the non-atomic operation is still happening. However, where
-- possible, as few syscalls as possible are used and the underlying -- possible, as few syscalls as possible are used and the underlying
-- exception handling is kept. -- exception handling is kept.
--
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
-- are not explicitly supported right now. Calling any of these
-- functions on such a file may throw an exception.
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HPath.IO where
module HPath.IO
(
-- * Types
FileType(..)
-- * File copying
, copyDirRecursive
, copyDirRecursiveOverwrite
, recreateSymlink
, copyFile
, copyFileOverwrite
, easyCopy
, easyCopyOverwrite
-- * File deletion
, deleteFile
, deleteDir
, deleteDirRecursive
, easyDelete
-- * File opening
, openFile
, executeFile
-- * File creation
, createRegularFile
, createDir
-- * File renaming/moving
, renameFile
, moveFile
, moveFileOverwrite
-- * File permissions
, newFilePerms
, newDirPerms
-- * Directory reading
, getDirsFiles
-- * Filetype operations
, getFileType
-- * Others
, canonicalizePath
)
where
import Control.Exception import Control.Exception
@ -517,7 +556,7 @@ easyDelete p = do
-- |Opens a file appropriately by invoking xdg-open. The file type -- |Opens a file appropriately by invoking xdg-open. The file type
-- is not checked. -- is not checked. This forks a process.
openFile :: Path Abs openFile :: Path Abs
-> IO ProcessID -> IO ProcessID
openFile p = openFile p =
@ -525,7 +564,7 @@ openFile p =
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
-- |Executes a program with the given arguments. -- |Executes a program with the given arguments. This forks a process.
executeFile :: Path Abs -- ^ program executeFile :: Path Abs -- ^ program
-> [ByteString] -- ^ arguments -> [ByteString] -- ^ arguments
-> IO ProcessID -> IO ProcessID

View File

@ -11,7 +11,6 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HPath.IO.Errors where module HPath.IO.Errors where
@ -42,10 +41,6 @@ import GHC.IO.Exception
) )
import HPath import HPath
import HPath.IO.Utils import HPath.IO.Utils
{- import HPath.IO -}
{- ( -}
{- canonicalizePath -}
{- ) -}
import System.IO.Error import System.IO.Error
( (
catchIOError catchIOError

View File

@ -9,8 +9,6 @@
-- --
-- Random and general IO/monad utilities. -- Random and general IO/monad utilities.
{-# OPTIONS_HADDOCK ignore-exports #-}
module HPath.IO.Utils where module HPath.IO.Utils where

View File

@ -18,6 +18,7 @@
module System.Posix.FilePath ( module System.Posix.FilePath (
-- * Separators
pathSeparator pathSeparator
, isPathSeparator , isPathSeparator
, searchPathSeparator , searchPathSeparator
@ -25,6 +26,7 @@ module System.Posix.FilePath (
, extSeparator , extSeparator
, isExtSeparator , isExtSeparator
-- * File extensions
, splitExtension , splitExtension
, takeExtension , takeExtension
, replaceExtension , replaceExtension
@ -36,6 +38,7 @@ module System.Posix.FilePath (
, dropExtensions , dropExtensions
, takeExtensions , takeExtensions
-- * Filenames/Directory names
, splitFileName , splitFileName
, takeFileName , takeFileName
, replaceFileName , replaceFileName
@ -44,17 +47,23 @@ module System.Posix.FilePath (
, replaceBaseName , replaceBaseName
, takeDirectory , takeDirectory
, replaceDirectory , replaceDirectory
-- * Path combinators and splitters
, combine , combine
, (</>) , (</>)
, splitPath , splitPath
, joinPath , joinPath
, normalise
, splitDirectories , splitDirectories
-- * Path conversions
, normalise
-- * Trailing path separator
, hasTrailingPathSeparator , hasTrailingPathSeparator
, addTrailingPathSeparator , addTrailingPathSeparator
, dropTrailingPathSeparator , dropTrailingPathSeparator
-- * Queries
, isRelative , isRelative
, isAbsolute , isAbsolute
, isValid , isValid
@ -63,6 +72,7 @@ module System.Posix.FilePath (
, equalFilePath , equalFilePath
, hiddenFile , hiddenFile
-- * Type conversion
, fpToString , fpToString
, userStringToFP , userStringToFP