Remove RelC and Fn wrt #29

'Path Fn </> Path Fn' leads to incorrect semantics.
The only fix is introducing complicated type family
machinery, which isn't justified.
This commit is contained in:
Julian Ospald 2020-01-20 18:40:23 +01:00
parent 117641c419
commit 3abc68cdd6
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 8 additions and 73 deletions

View File

@ -1177,14 +1177,14 @@ getDirsFiles p@(MkPath fp) = do
-- | Like 'getDirsFiles', but returns the filename only, instead
-- of prepending the base path.
getDirsFiles' :: Path b -- ^ dir to read
-> IO [Path Fn]
-> IO [Path Rel]
getDirsFiles' p@(MkPath fp) = do
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
rawContents <- getDirectoryContents' fd
fmap catMaybes $ for rawContents $ \(_, f) ->
if FP.isSpecialDirectoryEntry f
then pure Nothing
else fmap Just $ parseFn f
else fmap Just $ parseRel f

View File

@ -32,7 +32,6 @@ Note: this library was written for __posix__ systems and it will probably not su
* 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`

View File

@ -25,17 +25,14 @@ module HPath
Abs
,Path
,Rel
,Fn
,PathParseException
,PathException
,RelC
#if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns
,pattern Path
#endif
-- * Path Parsing
,parseAbs
,parseFn
,parseRel
,parseAny
-- * Path Conversion
@ -52,11 +49,9 @@ module HPath
-- * Path IO helpers
,withAbsPath
,withRelPath
,withFnPath
-- * Quasiquoters
,abs
,rel
,fn
,any
)
where
@ -91,14 +86,10 @@ 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
@ -107,10 +98,6 @@ data PathException = RootDirHasNoBasename
deriving (Show,Typeable)
instance Exception PathException
class RelC m
instance RelC Rel
instance RelC Fn
--------------------------------------------------------------------------------
-- PatternSynonyms
@ -193,41 +180,6 @@ parseRel 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)
-- | Parses a path, whether it's relative or absolute. Will lose
-- information on whether it's relative or absolute. If you need to know,
@ -276,10 +228,9 @@ fromAbs :: Path Abs -> ByteString
fromAbs = toFilePath
-- | Convert a relative Path to a ByteString type.
fromRel :: RelC r => Path r -> ByteString
fromRel :: Path Rel -> ByteString
fromRel = toFilePath
--------------------------------------------------------------------------------
-- Path Operations
@ -300,7 +251,7 @@ fromRel = toFilePath
-- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b
(</>) :: Path b -> Path Rel -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
where
a' = if BS.last a == pathSeparator
@ -382,13 +333,13 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
--
-- Throws: `PathException` if given the root path "/"
--
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Rel)
-- Just "dod"
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn)
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Rel)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- >>> basename (MkPath "/") :: Maybe (Path Rel)
-- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn)
basename :: MonadThrow m => Path b -> m (Path Rel)
basename (MkPath l)
| not (isAbsolute rl) = return $ MkPath rl
| otherwise = throwM RootDirHasNoBasename
@ -408,9 +359,6 @@ 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
@ -447,9 +395,6 @@ mkAbs = either (error . show) lift . parseAbs
mkRel :: ByteString -> Q Exp
mkRel = either (error . show) lift . parseRel
mkFN :: ByteString -> Q Exp
mkFN = either (error . show) lift . parseFn
mkAny :: ByteString -> Q Exp
mkAny = either (error . show) lift . parseAny
@ -475,15 +420,6 @@ abs = qq mkAbs
rel :: QuasiQuoter
rel = qq mkRel
-- | Quasiquote a file name. This accepts Unicode Chars and will encode as UTF-8.
--
-- >>> [fn|etc|] :: Path Fn
-- "etc"
-- >>> [fn||] :: Path Fn
-- "\239\131\144"
fn :: QuasiQuoter
fn = qq mkFN
-- | Quasiquote any path (relative or absolute).
-- This accepts Unicode Chars and will encode as UTF-8.
--