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 -- | Like 'getDirsFiles', but returns the filename only, instead
-- of prepending the base path. -- of prepending the base path.
getDirsFiles' :: Path b -- ^ dir to read getDirsFiles' :: Path b -- ^ dir to read
-> IO [Path Fn] -> IO [Path Rel]
getDirsFiles' p@(MkPath fp) = do getDirsFiles' p@(MkPath fp) = do
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
rawContents <- getDirectoryContents' fd rawContents <- getDirectoryContents' fd
fmap catMaybes $ for rawContents $ \(_, f) -> fmap catMaybes $ for rawContents $ \(_, f) ->
if FP.isSpecialDirectoryEntry f if FP.isSpecialDirectoryEntry f
then pure Nothing 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 * uses safe ByteString for filepaths under the hood instead of unsafe String
* fixes broken [dirname](https://github.com/chrisdone/path/issues/18) * fixes broken [dirname](https://github.com/chrisdone/path/issues/18)
* renames dirname/filename to basename/dirname to match the POSIX shell functions * 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 * allows pattern matching via unidirectional PatternSynonym
* uses simple doctest for testing * uses simple doctest for testing
* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME` * 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 Abs
,Path ,Path
,Rel ,Rel
,Fn
,PathParseException ,PathParseException
,PathException ,PathException
,RelC
#if __GLASGOW_HASKELL__ >= 708 #if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns -- * PatternSynonyms/ViewPatterns
,pattern Path ,pattern Path
#endif #endif
-- * Path Parsing -- * Path Parsing
,parseAbs ,parseAbs
,parseFn
,parseRel ,parseRel
,parseAny ,parseAny
-- * Path Conversion -- * Path Conversion
@ -52,11 +49,9 @@ module HPath
-- * Path IO helpers -- * Path IO helpers
,withAbsPath ,withAbsPath
,withRelPath ,withRelPath
,withFnPath
-- * Quasiquoters -- * Quasiquoters
,abs ,abs
,rel ,rel
,fn
,any ,any
) )
where where
@ -91,14 +86,10 @@ data Abs deriving (Typeable)
-- | A relative path; one without a root. -- | A relative path; one without a root.
data Rel deriving (Typeable) data Rel deriving (Typeable)
-- | A filename, without any '/'.
data Fn deriving (Typeable)
-- | Exception when parsing a location. -- | Exception when parsing a location.
data PathParseException data PathParseException
= InvalidAbs ByteString = InvalidAbs ByteString
| InvalidRel ByteString | InvalidRel ByteString
| InvalidFn ByteString
| Couldn'tStripPrefixTPS ByteString ByteString | Couldn'tStripPrefixTPS ByteString ByteString
deriving (Show,Typeable) deriving (Show,Typeable)
instance Exception PathParseException instance Exception PathParseException
@ -107,10 +98,6 @@ data PathException = RootDirHasNoBasename
deriving (Show,Typeable) deriving (Show,Typeable)
instance Exception PathException instance Exception PathException
class RelC m
instance RelC Rel
instance RelC Fn
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- PatternSynonyms -- PatternSynonyms
@ -193,41 +180,6 @@ parseRel filepath =
else throwM (InvalidRel 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 -- | Parses a path, whether it's relative or absolute. Will lose
-- information on whether it's relative or absolute. If you need to know, -- information on whether it's relative or absolute. If you need to know,
@ -276,10 +228,9 @@ fromAbs :: Path Abs -> ByteString
fromAbs = toFilePath fromAbs = toFilePath
-- | Convert a relative Path to a ByteString type. -- | Convert a relative Path to a ByteString type.
fromRel :: RelC r => Path r -> ByteString fromRel :: Path Rel -> ByteString
fromRel = toFilePath fromRel = toFilePath
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Path Operations -- Path Operations
@ -300,7 +251,7 @@ fromRel = toFilePath
-- "/file/lal" -- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel) -- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/" -- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b (</>) :: Path b -> Path Rel -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b) (</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
where where
a' = if BS.last a == pathSeparator a' = if BS.last a == pathSeparator
@ -382,13 +333,13 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
-- --
-- Throws: `PathException` if given the root path "/" -- 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" -- Just "dod"
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn) -- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Rel)
-- Just "dod" -- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn) -- >>> basename (MkPath "/") :: Maybe (Path Rel)
-- Nothing -- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn) basename :: MonadThrow m => Path b -> m (Path Rel)
basename (MkPath l) basename (MkPath l)
| not (isAbsolute rl) = return $ MkPath rl | not (isAbsolute rl) = return $ MkPath rl
| otherwise = throwM RootDirHasNoBasename | otherwise = throwM RootDirHasNoBasename
@ -408,9 +359,6 @@ withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
withRelPath (MkPath p) action = action p withRelPath (MkPath p) action = action p
withFnPath :: Path Fn -> (ByteString -> IO a) -> IO a
withFnPath (MkPath p) action = action p
------------------------ ------------------------
-- ByteString helpers -- ByteString helpers
@ -447,9 +395,6 @@ mkAbs = either (error . show) lift . parseAbs
mkRel :: ByteString -> Q Exp mkRel :: ByteString -> Q Exp
mkRel = either (error . show) lift . parseRel mkRel = either (error . show) lift . parseRel
mkFN :: ByteString -> Q Exp
mkFN = either (error . show) lift . parseFn
mkAny :: ByteString -> Q Exp mkAny :: ByteString -> Q Exp
mkAny = either (error . show) lift . parseAny mkAny = either (error . show) lift . parseAny
@ -475,15 +420,6 @@ abs = qq mkAbs
rel :: QuasiQuoter rel :: QuasiQuoter
rel = qq mkRel 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). -- | Quasiquote any path (relative or absolute).
-- This accepts Unicode Chars and will encode as UTF-8. -- This accepts Unicode Chars and will encode as UTF-8.
-- --