Compare commits
4 Commits
master
...
gitea-mast
Author | SHA1 | Date | |
---|---|---|---|
809ffc7745 | |||
a0510eaec1 | |||
cce2c68cab | |||
3c5f06f41d |
2
.gitignore
vendored
2
.gitignore
vendored
@ -10,3 +10,5 @@ tags
|
||||
.stack-work/
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
dist-newstyle/
|
||||
.ghc.environment.*
|
||||
|
@ -8,6 +8,7 @@ main =
|
||||
doctest
|
||||
["-isrc"
|
||||
, "-XOverloadedStrings"
|
||||
, "-XScopedTypeVariables"
|
||||
, "src/HPath.hs"
|
||||
]
|
||||
|
||||
|
50
src/HPath.hs
50
src/HPath.hs
@ -10,12 +10,14 @@
|
||||
-- Support for well-typed paths.
|
||||
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
#endif
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module HPath
|
||||
(
|
||||
@ -39,6 +41,8 @@ module HPath
|
||||
,fromAbs
|
||||
,fromRel
|
||||
,toFilePath
|
||||
,unsafeToString
|
||||
,unsafeToString'
|
||||
-- * Path Operations
|
||||
,(</>)
|
||||
,basename
|
||||
@ -53,8 +57,10 @@ module HPath
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (Exception)
|
||||
import Control.Exception (IOException, Exception, catch)
|
||||
import Control.Monad ((<$!>))
|
||||
import Control.Monad.Catch (MonadThrow(..))
|
||||
import Data.ByteString.Unsafe(unsafeUseAsCStringLen)
|
||||
#if MIN_VERSION_bytestring(0,10,8)
|
||||
import Data.ByteString(ByteString, stripPrefix)
|
||||
#else
|
||||
@ -65,10 +71,17 @@ import qualified Data.ByteString as BS
|
||||
import Data.Data
|
||||
import Data.Maybe
|
||||
import Data.Word8
|
||||
import GHC.Foreign(peekCStringLen)
|
||||
import GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
|
||||
import HPath.Internal
|
||||
import System.IO.Unsafe(unsafePerformIO)
|
||||
import System.Posix.FilePath hiding ((</>))
|
||||
|
||||
|
||||
-- $setup
|
||||
-- >>> import GHC.IO.Encoding(utf8)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Types
|
||||
|
||||
@ -232,6 +245,41 @@ fromAbs = toFilePath
|
||||
fromRel :: RelC r => Path r -> ByteString
|
||||
fromRel = toFilePath
|
||||
|
||||
-- | This converts the underlying bytestring of the path to an unsafe
|
||||
-- FilePath by assuming the encoding of the current locale setting. This
|
||||
-- may be utterly wrong, but isn't particularly worse than what the
|
||||
-- base library does. Blows up on decoding errors.
|
||||
--
|
||||
-- >>> unsafeToString (MkPath "/lal/lad")
|
||||
-- "/lal/lad"
|
||||
-- >>> unsafeToString (MkPath "/")
|
||||
-- "/"
|
||||
-- >>> unsafeToString (MkPath "lad")
|
||||
-- "lad"
|
||||
-- >>> catch (Just <$> unsafeToString (MkPath "<22>")) (\(_ :: IOException) -> pure Nothing)
|
||||
-- Nothing
|
||||
unsafeToString :: Path b -> IO FilePath
|
||||
unsafeToString (MkPath p) = do
|
||||
enc <- getLocaleEncoding
|
||||
unsafeUseAsCStringLen p (peekCStringLen enc)
|
||||
|
||||
-- | Same as @unsafeToString@, except requires the encoding
|
||||
-- to be passed explicitly. This uses 'unsafePerformIO' and
|
||||
-- returns 'Nothing' on decoding errors.
|
||||
--
|
||||
-- >>> unsafeToString' (MkPath "/lal/lad") utf8
|
||||
-- Just "/lal/lad"
|
||||
-- >>> unsafeToString' (MkPath "/") utf8
|
||||
-- Just "/"
|
||||
-- >>> unsafeToString' (MkPath "lad") utf8
|
||||
-- Just "lad"
|
||||
-- >>> unsafeToString' (MkPath "<22>") utf8
|
||||
-- Nothing
|
||||
unsafeToString' :: Path b -> TextEncoding -> Maybe FilePath
|
||||
unsafeToString' (MkPath !p) enc =
|
||||
unsafePerformIO $!
|
||||
catch (Just <$!> unsafeUseAsCStringLen p (peekCStringLen enc))
|
||||
(\(_ :: IOException) -> pure Nothing)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
7
stack.yaml
Normal file
7
stack.yaml
Normal file
@ -0,0 +1,7 @@
|
||||
resolver: lts-12.1
|
||||
|
||||
packages:
|
||||
- '.'
|
||||
|
||||
extra-deps:
|
||||
- IfElse-0.85
|
@ -13,7 +13,6 @@ import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
@ -13,7 +13,6 @@ import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
@ -13,7 +13,6 @@ import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
@ -13,7 +13,6 @@ import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
@ -61,9 +61,6 @@ 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 :: ByteString
|
||||
|
Loading…
Reference in New Issue
Block a user