hasufell/hpath
1
1
Fork 0
Code Issues 8 Pull Requests Releases Wiki Activity

Split packages into hpath{,-io,-filepath}

Browse Source
This commit is contained in:
Julian Ospald
2020-01-04 17:52:21 +01:00
parent 4e07fcf5b2
commit 09eea518b8
61 changed files with 349 additions and 229 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
hpath/CHANGELOG Normal file
View File

@@ -0,0 +1,76 @@
0.9.2
* fix build with ghc-7.6
* raise required bytestring version
* Tighten base bound to prevent building before GHC 7.6 (by George Wilson)
0.9.1
* fix build with ghc-7.8 and 7.10
0.9.0
* don't force "Path Abs" anymore in IO module, abstract more over Path types
* add 'toAbs'
0.8.1
* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile'
0.8.0
* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument
* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)
* 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms')
* various documentation fixes
* improved reliability of tests
0.7.5:
* relicense to BSD3
0.7.3:
* don't expose HPath.Internal
0.7.2:
* fix tests, so they work with the sdist tarball too
* added the following function to HPath.IO: createSymlink
0.7.1:
* various cleanups and documentation improvements
* added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid
0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* lift version constraints in benchmark
* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead
0.6.0:
* fixes 'throwDestinationInSource' to be more reliable.
* removes some unused HPathIOException constructors
* consistently provide exception constructor identifiers
* be less harsh when non-supported file types get passed to our functions, possibly ignoring them
* minor cleanups
0.5.9:
* Adds our posix-paths fork and a lot of IO operations.
0.5.8:
* First version of the fork.
0.5.7:
* Fix haddock problem.
0.5.6:
* Reject only .. and .
0.5.5:
* Use filepath's isValid function for additional sanity checks
0.5.4:
* Disable parsing of path consisting only of "."
* Add NFData instance for Path
* Some typo/docs improvements
* Add standard headers to modules
0.5.3:
* Added conversion functions.
0.2.0:
* Rename parentAbs to simply parent.
* Add dirname.
0.3.0:
* Removed Generic instance.
0.4.0:
* Implemented stricter parsing, disabling use of "..".
* Made stripDir generic over MonadThrow
0.5.0:
* Fix stripDir p p /= Nothing bug.
0.5.2:
* Removed unused DeriveGeneric.

30
hpath/LICENSE Normal file
View File

@@ -0,0 +1,30 @@
Copyright (c) Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the author nor the names of his contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

37
hpath/README.md Normal file
View File

@@ -0,0 +1,37 @@
# HPath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath)
Support for well-typed paths in Haskell.
## Motivation
The motivation came during development of
[hsfm](https://github.com/hasufell/hsfm)
which has a pretty strict File type, but lacks a strict Path type, e.g.
for user input.
The library that came closest to my needs was
[path](https://github.com/chrisdone/path),
but the API turned out to be oddly complicated for my use case, so I
decided to fork it.
## Goals
* well-typed paths
* safe filepath manipulation, never using String as filepath, but ByteString
Note: this library was written for __posix__ systems and it will probably not support other systems.
## Differences to 'path'
* doesn't attempt to fake IO-related information into the path, so whether a path points to a file or directory is up to your IO-code to decide...
* trailing path separators will be preserved if they exist, no messing with that
* uses safe ByteString for filepaths under the hood instead of unsafe String
* fixes broken [dirname](https://github.com/chrisdone/path/issues/18)
* renames dirname/filename to basename/dirname to match the POSIX shell functions
* introduces a new `Path Fn` for safe filename guarantees and a `RelC` class
* allows pattern matching via unidirectional PatternSynonym
* uses simple doctest for testing
* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME`
* remove TH, it sucks

2
hpath/Setup.hs Normal file
View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

44
hpath/hpath.cabal Normal file
View File

@@ -0,0 +1,44 @@
name: hpath
version: 0.9.2
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016
category: Filesystem
build-type: Simple
cabal-version: 1.14
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
extra-source-files: README.md
CHANGELOG
library
if os(windows)
build-depends: unbuildable<0
buildable: False
hs-source-dirs: src/
default-language: Haskell2010
if impl(ghc >= 8.0)
ghc-options: -Wall -Wno-redundant-constraints
else
ghc-options: -Wall
exposed-modules: HPath
HPath.Internal
build-depends: base >= 4.8 && <5
, bytestring >= 0.10.0.0
, deepseq
, exceptions
, hpath-filepath
, word8
source-repository head
type: git
location: https://github.com/hasufell/hpath

21
hpath/run-doctests.sh Executable file
View File

@@ -0,0 +1,21 @@
#!/bin/sh
set -e
if [ -n "${SKIP_DOCTESTS}" ] ; then
echo "Skipping doctests"
exit 0
fi
if ! command -v doctest >/dev/null ; then
tempdir="$(mktemp -d)"
(
cd "${tempdir}"
cabal install --installdir="${tempdir}" doctest
)
export PATH="${tempdir}:$PATH"
fi
set -x
cabal exec doctest -- -ihpath/src -XOverloadedStrings HPath

376
hpath/src/HPath.hs Normal file
View File

@@ -0,0 +1,376 @@
-- |
-- Module : HPath
-- Copyright : © 2015–2016 FP Complete, 2016 Julian Ospald
-- License : BSD 3 clause
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Support for well-typed paths.
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
module HPath
(
-- * Types
Abs
,Path
,Rel
,Fn
,PathParseException
,PathException
,RelC
#if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns
,pattern Path
#endif
-- * Path Parsing
,parseAbs
,parseFn
,parseRel
-- * Path Conversion
,fromAbs
,fromRel
,toFilePath
-- * Path Operations
,(</>)
,basename
,dirname
,isParentOf
,getAllParents
,stripDir
-- * Path IO helpers
,withAbsPath
,withRelPath
,withFnPath
)
where
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..))
#if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix)
#else
import Data.ByteString(ByteString)
import qualified Data.List as L
#endif
import qualified Data.ByteString as BS
import Data.Data
import Data.Maybe
import Data.Word8
import HPath.Internal
import System.Posix.FilePath hiding ((</>))
--------------------------------------------------------------------------------
-- Types
-- | An absolute path.
data Abs deriving (Typeable)
-- | A relative path; one without a root.
data Rel deriving (Typeable)
-- | A filename, without any '/'.
data Fn deriving (Typeable)
-- | Exception when parsing a location.
data PathParseException
= InvalidAbs ByteString
| InvalidRel ByteString
| InvalidFn ByteString
| Couldn'tStripPrefixTPS ByteString ByteString
deriving (Show,Typeable)
instance Exception PathParseException
data PathException = RootDirHasNoBasename
deriving (Show,Typeable)
instance Exception PathException
class RelC m
instance RelC Rel
instance RelC Fn
--------------------------------------------------------------------------------
-- PatternSynonyms
#if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a
#endif
#if __GLASGOW_HASKELL__ >= 708
pattern Path x <- (MkPath x)
#endif
--------------------------------------------------------------------------------
-- Path Parsers
-- | Get a location for an absolute path. Produces a normalised path.
--
-- Throws: 'PathParseException'
--
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- Just "/abc"
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- Just "/"
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- Just "/abc/def"
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
-- Just "/abc/def/"
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- Nothing
parseAbs :: MonadThrow m
=> ByteString -> m (Path Abs)
parseAbs filepath =
if isAbsolute filepath &&
isValid filepath &&
not (hasParentDir filepath)
then return (MkPath $ normalise filepath)
else throwM (InvalidAbs filepath)
-- | Get a location for a relative path. Produces a normalised
-- path.
--
-- Note that @filepath@ may contain any number of @./@ but may not consist
-- solely of @./@. It also may not contain a single @..@ anywhere.
--
-- Throws: 'PathParseException'
--
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- Just "abc"
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- Just "def/"
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- Just "abc/def"
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- Just "abc/def/"
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "." :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel ".." :: Maybe (Path Rel)
-- Nothing
parseRel :: MonadThrow m
=> ByteString -> m (Path Rel)
parseRel filepath =
if not (isAbsolute filepath) &&
filepath /= BS.singleton _period &&
filepath /= BS.pack [_period, _period] &&
not (hasParentDir filepath) &&
isValid filepath
then return (MkPath $ normalise filepath)
else throwM (InvalidRel filepath)
-- | Parses a filename. Filenames must not contain slashes.
-- Excludes '.' and '..'.
--
-- Throws: 'PathParseException'
--
-- >>> parseFn "abc" :: Maybe (Path Fn)
-- Just "abc"
-- >>> parseFn "..." :: Maybe (Path Fn)
-- Just "..."
-- >>> parseFn "def/" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "/abc" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn ".." :: Maybe (Path Fn)
-- Nothing
parseFn :: MonadThrow m
=> ByteString -> m (Path Fn)
parseFn filepath =
if isFileName filepath &&
filepath /= BS.singleton _period &&
filepath /= BS.pack [_period, _period] &&
isValid filepath
then return (MkPath filepath)
else throwM (InvalidFn filepath)
--------------------------------------------------------------------------------
-- Path Conversion
-- | Convert any Path to a ByteString type.
toFilePath :: Path b -> ByteString
toFilePath (MkPath l) = l
-- | Convert an absolute Path to a ByteString type.
fromAbs :: Path Abs -> ByteString
fromAbs = toFilePath
-- | Convert a relative Path to a ByteString type.
fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath
--------------------------------------------------------------------------------
-- Path Operations
-- | Append two paths.
--
-- The second argument must always be a relative path, which ensures
-- that undefinable things like `"/abc" </> "/def"` cannot happen.
--
-- Technically, the first argument can be a path that points to a non-directory,
-- because this library is IO-agnostic and makes no assumptions about
-- file types.
--
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file"
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- "/path/to/file"
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
where
a' = if BS.last a == pathSeparator
then a
else addTrailingPathSeparator a
-- | Strip directory from path, making it relative to that directory.
-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.
--
-- The bases must match.
--
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- Nothing
stripDir :: MonadThrow m
=> Path b -> Path b -> m (Path Rel)
stripDir (MkPath p) (MkPath l) =
case stripPrefix p' l of
Nothing -> throwM (Couldn'tStripPrefixTPS p' l)
Just ok -> if BS.null ok
then throwM (Couldn'tStripPrefixTPS p' l)
else return (MkPath ok)
where
p' = addTrailingPathSeparator p
-- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match.
--
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- True
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- True
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- False
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
-- False
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- False
isParentOf :: Path b -> Path b -> Bool
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
-- |Get all parents of a path.
--
-- >>> getAllParents (MkPath "/abs/def/dod")
-- ["/abs/def","/abs","/"]
-- >>> getAllParents (MkPath "/")
-- []
getAllParents :: Path Abs -> [Path Abs]
getAllParents (MkPath p)
| np == BS.singleton pathSeparator = []
| otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np)
where
np = dropTrailingPathSeparator . normalise $ p
-- | Extract the directory name of a path.
--
-- >>> dirname (MkPath "/abc/def/dod")
-- "/abc/def"
-- >>> dirname (MkPath "/")
-- "/"
dirname :: Path Abs -> Path Abs
dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
-- | Extract the file part of a path.
--
--
-- The following properties hold:
--
-- @basename (p \<\/> a) == basename a@
--
-- Throws: `PathException` if given the root path "/"
--
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn)
basename (MkPath l)
| not (isAbsolute rl) = return $ MkPath rl
| otherwise = throwM RootDirHasNoBasename
where
rl = last . splitPath . dropTrailingPathSeparator $ l
--------------------------------------------------------------------------------
-- Path IO helpers
withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
withAbsPath (MkPath p) action = action p
withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
withRelPath (MkPath p) action = action p
withFnPath :: Path Fn -> (ByteString -> IO a) -> IO a
withFnPath (MkPath p) action = action p
------------------------
-- ByteString helpers
#if MIN_VERSION_bytestring(0,10,8)
#else
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
#endif

51
hpath/src/HPath/Internal.hs Normal file
View File

@@ -0,0 +1,51 @@
{-# LANGUAGE DeriveDataTypeable #-}
-- | Internal types and functions.
module HPath.Internal
(Path(..))
where
import Control.DeepSeq (NFData (..))
import Data.ByteString (ByteString)
import Data.Data
-- | Path of some base and type.
--
-- Internally is a ByteString. The ByteString can be of two formats only:
--
-- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@
--
-- There are no duplicate
-- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.
data Path b = MkPath ByteString
deriving (Typeable)
-- | ByteString equality.
--
-- The following property holds:
--
-- @show x == show y ≡ x == y@
instance Eq (Path b) where
(==) (MkPath x) (MkPath y) = x == y
-- | ByteString ordering.
--
-- The following property holds:
--
-- @show x \`compare\` show y ≡ x \`compare\` y@
instance Ord (Path b) where
compare (MkPath x) (MkPath y) = compare x y
-- | Same as 'HPath.toFilePath'.
--
-- The following property holds:
--
-- @x == y ≡ show x == show y@
instance Show (Path b) where
show (MkPath x) = show x
instance NFData (Path b) where
rnf (MkPath x) = rnf x