Merge branch 'split-packages'

This commit is contained in:
Julian Ospald 2020-01-04 18:36:24 +01:00
commit a6f902a9df
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
61 changed files with 355 additions and 229 deletions

2
.ghci
View File

@ -1,2 +0,0 @@
:set -package HUnit -package hspec
:set -package template-haskell

View File

@ -17,7 +17,7 @@ matrix:
addons: {apt: {packages: [cabal-install-3.0,ghc-8.4.4], sources: [hvr-ghc]}}
- env: CABALVER=3.0 GHCVER=8.6.5
addons: {apt: {packages: [cabal-install-3.0,ghc-8.6.5], sources: [hvr-ghc]}}
- env: CABALVER=3.0 GHCVER=8.8.1 UPDATE_GH_PAGES=yes
- env: CABALVER=3.0 GHCVER=8.8.1
addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.1], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
@ -40,16 +40,16 @@ install:
- cabal install --installdir=$HOME/.cabal/bin doctest
script:
- cabal build --enable-tests
- cabal test
- ./run-doctests.sh
- cabal check
- cabal sdist
- cabal haddock --haddock-hyperlink-source --haddock-html-location=https://hackage.haskell.org/package/\$pkg-\$version/docs/
- cabal install --lib
after_script:
- ./update-gh-pages.sh
- cabal build --enable-tests all
- cabal test all
- ./hpath/run-doctests.sh
- ./hpath-filepath/run-doctests.sh
- (cd hpath && cabal check)
- (cd hpath-filepath && cabal check)
- (cd hpath-io && cabal check)
- cabal sdist all
- cabal haddock --haddock-hyperlink-source --haddock-html-location=https://hackage.haskell.org/package/\$pkg-\$version/docs/ all
- cabal install --lib all
notifications:
email:

View File

@ -1,87 +1,17 @@
# HPath
# HPath libraries
[![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)
[![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)
Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation.
Set of libraries to deal with filepaths and files.
## 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.
* filepaths should be type-safe (absolute, relative, ...)
* filepaths should be ByteString under the hood, see [Abstract FilePath Proposal (AFPP)](https://gitlab.haskell.org/ghc/ghc/wikis/proposal/abstract-file-path)
* file high-level operations should be platform-specific, exception-stable, safe and as atomic as possible
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.
Similarly, [posix-paths](https://github.com/JohnLato/posix-paths)
was exactly what I wanted for the low-level operations, but upstream seems dead,
so it is forked as well and merged into this library.
## Goals
* well-typed paths
* high-level API to file operations like recursive directory copy
* safe filepath manipulation, never using String as filepath, but ByteString
* still allowing sufficient control to interact with the underlying low-level calls
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
## Differences to 'posix-paths'
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart
* added various functions:
* `equalFilePath`
* `getSearchPath`
* `hasParentDir`
* `hiddenFile`
* `isFileName`
* `isValid`
* `makeRelative`
* `makeValid`
* `normalise`
* `splitSearchPath`
* `stripExtension`
* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart
* adds a `getDirectoryContents'` version that works on Fd
## Examples in ghci
Start ghci via `cabal repl`:
```hs
-- enable OverloadedStrings
:set -XOverloadedStrings
-- import HPath.IO
import HPath.IO
-- parse an absolute path
abspath <- parseAbs "/home"
-- parse a relative path (e.g. user users home directory)
relpath <- parseRel "jule"
-- concatenate paths
let newpath = abspath </> relpath
-- get file type
getFileType newpath
-- return all contents of that directory
getDirsFiles newpath
-- return all contents of the parent directory
getDirsFiles (dirname newpath)
```
## Projects
* [hpath](./hpath): Support for well-typed paths
* [hpath-filepath](./hpath-filepath): ByteString based filepath manipulation (can be used without hpath)
* [hpath-io](./hpath-io): high-level file API (recursive copy, writeFile etc.) using hpath

10
cabal.project Normal file
View File

@ -0,0 +1,10 @@
packages: ./hpath
./hpath-filepath
./hpath-io
package hpath-io
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
-- https://github.com/composewell/streamly/blob/master/docs/Build.md
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@ -0,0 +1,5 @@
# Revision history for hpath-filepath
## 0.9.3 -- 2020-01-04
* First version. Released on an unsuspecting world.

30
hpath-filepath/LICENSE Normal file
View File

@ -0,0 +1,30 @@
Copyright (c) 2020, 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:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* 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.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT
OWNER 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.

23
hpath-filepath/README.md Normal file
View File

@ -0,0 +1,23 @@
# HPath-filepath
[![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-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [![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-filepath.svg)](http://packdeps.haskellers.com/feed?needle=hpath-filepath)
Support for bytestring based filepath manipulation, similar to 'filepath'.
## Motivation
This is basically a fork of [posix-paths](https://github.com/JohnLato/posix-paths), which seemed to have stalled development.
There is also a similar library [filepath-bytestring](https://hackage.haskell.org/package/filepath-bytestring), but it doesn't follow an open development model and is cross-platform, which this library is not interested in.
## Differences to 'posix-paths'
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart
* has some additional functions
## Differences to 'filepath-bytestring'
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* is not cross-platform (less odd code to maintain)
* has some additional functions

View File

@ -0,0 +1,39 @@
name: hpath-filepath
version: 0.10.0
synopsis: ByteString based filepath manipulation
description: ByteString based filepath manipulation, similar to 'filepath' package. This is POSIX only.
-- bug-reports:
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.md
library
if os(windows)
build-depends: unbuildable<0
buildable: False
exposed-modules: System.Posix.FilePath
-- other-modules:
-- other-extensions:
build-depends: base >=4.8 && <5
, bytestring >= 0.10.0.0
, unix >= 2.5
, word8
hs-source-dirs: src
default-language: Haskell2010
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -18,5 +18,4 @@ fi
set -x
cabal exec doctest -- -isrc -XOverloadedStrings System.Posix.FilePath
cabal exec doctest -- -isrc -XOverloadedStrings HPath
cabal exec doctest -- -ihpath-filepath/src -XOverloadedStrings System.Posix.FilePath

5
hpath-io/CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for hpath-io
## 0.9.3 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

30
hpath-io/LICENSE Normal file
View File

@ -0,0 +1,30 @@
Copyright (c) 2020, 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:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* 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.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT
OWNER 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.

26
hpath-io/README.md Normal file
View File

@ -0,0 +1,26 @@
# HPath-IO
[![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-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![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-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io)
High-level IO operations on files/directories, utilizing type-safe Paths.
## Motivation
The motivation came during development of
[hsfm](https://github.com/hasufell/hsfm)
in order to have a proper high-level API of file related operations,
while utilizing type-safe Paths.
## Goals
* high-level API to file operations like recursive directory copy
* still allowing sufficient control to interact with the underlying low-level calls
* unit-testing exceptions (because yes, people may rely on them)
Note: this library was written for __posix__ systems and it will probably not support other systems.
## Differences to 'posix-paths'
* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart
* adds a `getDirectoryContents'` version that works on Fd

2
hpath-io/Setup.hs Normal file
View File

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

View File

@ -1,7 +1,8 @@
name: hpath
version: 0.9.2
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
name: hpath-io
version: 0.10.0
synopsis: High-level IO operations on files/directories
description: High-level IO operations on files/directories, utilizing type-safe Paths
-- bug-reports:
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
@ -17,40 +18,33 @@ tested-with: GHC==7.10.3
, GHC==8.6.5
, GHC==8.8.1
extra-source-files: README.md
CHANGELOG
CHANGELOG.md
cbits/dirutils.h
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
c-sources: cbits/dirutils.c
exposed-modules: HPath,
HPath.IO,
exposed-modules: HPath.IO,
HPath.IO.Errors,
System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals,
System.Posix.FD,
System.Posix.FilePath
other-modules: HPath.Internal
System.Posix.FD
c-sources: cbits/dirutils.c
-- other-modules:
-- other-extensions:
build-depends: base >= 4.8 && <5
, IfElse
, bytestring >= 0.10.0.0
, deepseq
, exceptions
, hspec
, hpath >= 0.10 && < 0.11
, hpath-filepath >= 0.10 && < 0.11
, streamly >= 0.7
, unix >= 2.5
, unix-bytestring
, utf8-string
, word8
hs-source-dirs: src
default-language: Haskell2010
test-suite spec
if os(windows)
@ -94,6 +88,7 @@ test-suite spec
, IfElse
, bytestring >= 0.10.0.0
, hpath
, hpath-io
, hspec >= 1.3
, process
, unix
@ -103,4 +98,3 @@ test-suite spec
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -149,9 +149,9 @@ toConstr RecursiveFailure {} = "RecursiveFailure"
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{}
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty)
isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty)
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty)
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils

View File

@ -127,7 +127,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
CollectFailures
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"

View File

@ -106,7 +106,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
@ -114,7 +115,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
tmpDir' <- getRawTmpDir
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD")
++ toString tmpDir' ++ "alreadyExistsD"
++ " >/dev/null")
`shouldReturn` (ExitFailure 1)
copyDirRecursive' "inputDir"
"alreadyExistsD"
@ -122,7 +124,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD")
++ toString tmpDir' ++ "alreadyExistsD"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"

View File

@ -91,7 +91,8 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils

View File

@ -13,7 +13,6 @@ import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Process
import Utils

View File

@ -1,19 +1,24 @@
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as BS
import Data.IORef
import Test.Hspec
import Test.Hspec.Runner
import Test.Hspec.Formatters
import qualified Spec
import Utils
import System.Posix.Temp.ByteString (mkdtemp)
-- TODO: chardev, blockdev, namedpipe, socket
main :: IO ()
main =
main = do
tmpBase <- mkdtemp "/tmp/"
writeIORef baseTmpDir (Just (tmpBase `BS.append` "/"))
putStrLn $ ("Temporary test directory at: " ++ show tmpBase)
hspecWith
defaultConfig { configFormatter = Just progress }
$ beforeAll_ createBaseTmpDir
$ afterAll_ deleteBaseTmpDir
$ Spec.spec

View File

@ -39,10 +39,6 @@ import System.IO.Unsafe
unsafePerformIO
)
import qualified System.Posix.Directory.Traversals as DT
import System.Posix.Env.ByteString
(
getEnv
)
import Data.ByteString
(
ByteString
@ -61,18 +57,14 @@ import System.Posix.Files.ByteString
, unionFileModes
)
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
baseTmpDir :: IORef (Maybe ByteString)
{-# NOINLINE baseTmpDir #-}
baseTmpDir = unsafePerformIO (newIORef Nothing)
baseTmpDir :: ByteString
baseTmpDir = "test/HPath/IO/tmp/"
tmpDir :: IORef ByteString
tmpDir :: IORef (Maybe ByteString)
{-# NOINLINE tmpDir #-}
tmpDir = unsafePerformIO (newIORef baseTmpDir)
tmpDir = unsafePerformIO (newIORef Nothing)
@ -83,49 +75,39 @@ tmpDir = unsafePerformIO (newIORef baseTmpDir)
setTmpDir :: ByteString -> IO ()
{-# NOINLINE setTmpDir #-}
setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs)
setTmpDir bs = do
tmp <- fromJust <$> readIORef baseTmpDir
writeIORef tmpDir (Just (tmp `BS.append` bs))
createTmpDir :: IO ()
{-# NOINLINE createTmpDir #-}
createTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir
void $ createDir newDirPerms (pwd P.</> tmp)
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
void $ createDir newDirPerms tmp
deleteTmpDir :: IO ()
{-# NOINLINE deleteTmpDir #-}
deleteTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir
void $ deleteDir (pwd P.</> tmp)
createBaseTmpDir :: IO ()
{-# NOINLINE createBaseTmpDir #-}
createBaseTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel baseTmpDir
void $ createDir newDirPerms (pwd P.</> tmp)
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
void $ deleteDir tmp
deleteBaseTmpDir :: IO ()
{-# NOINLINE deleteBaseTmpDir #-}
deleteBaseTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel baseTmpDir
contents <- getDirsFiles (pwd P.</> tmp)
tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs
contents <- getDirsFiles tmp
forM_ contents deleteDir
void $ deleteDir (pwd P.</> tmp)
void $ deleteDir tmp
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withRawTmpDir #-}
withRawTmpDir f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir
f (pwd P.</> tmp)
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
f tmp
getRawTmpDir :: IO ByteString
@ -136,9 +118,8 @@ getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withTmpDir #-}
withTmpDir ip f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir
p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
p <- (tmp P.</>) <$> P.parseRel ip
f p
@ -148,10 +129,9 @@ withTmpDir' :: ByteString
-> IO a
{-# NOINLINE withTmpDir' #-}
withTmpDir' ip1 ip2 f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir
p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1
p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
p1 <- (tmp P.</>) <$> P.parseRel ip1
p2 <- (tmp P.</>) <$> P.parseRel ip2
f p1 p2

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.10.0
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 >= 0.10 && < 0.11
, 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

View File

@ -1,55 +0,0 @@
#!/bin/bash
SOURCE_BRANCH="master"
TARGET_BRANCH="gh-pages"
REPO="https://${GITHUB_TOKEN}@github.com/hasufell/hpath"
if [ -z "${UPDATE_GH_PAGES}" ] ; then
exit 0
fi
# Pull requests and commits to other branches shouldn't try to deploy,
# just build to verify
if [ "$TRAVIS_PULL_REQUEST" != "false" -o "$TRAVIS_BRANCH" != "$SOURCE_BRANCH" ]; then
echo "Skipping docs deploy."
exit 0
fi
cd "$HOME"
git config --global user.email "travis@travis-ci.org"
git config --global user.name "travis-ci"
git clone --branch=${TARGET_BRANCH} ${REPO} ${TARGET_BRANCH} || exit 1
# docs
cd ${TARGET_BRANCH} || exit 1
echo "Removing old docs."
rm -rf *
echo "Adding new docs."
cp -rf "${TRAVIS_BUILD_DIR}"/dist-newstyle/build/x86_64-linux/ghc-*/hpath-*/doc/html/hpath/* . || exit 1
# If there are no changes to the compiled out (e.g. this is a README update)
# then just bail.
if [ -z "`git diff --exit-code`" ]; then
echo "No changes to the output on this push; exiting."
exit 0
fi
git add -- .
if [[ -e ./index.html ]] ; then
echo "Commiting docs."
git commit -m "Lastest docs updated
travis build: $TRAVIS_BUILD_NUMBER
commit: $TRAVIS_COMMIT
auto-pushed to gh-pages"
git push origin $TARGET_BRANCH
echo "Published docs to gh-pages."
else
echo "Error: docs are empty."
exit 1
fi