1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE ViewPatterns #-}
3
4-- | Extra Path utilities.
5
6module Path.Extra
7  (toFilePathNoTrailingSep
8  ,dropRoot
9  ,parseCollapsedAbsDir
10  ,parseCollapsedAbsFile
11  ,concatAndColapseAbsDir
12  ,rejectMissingFile
13  ,rejectMissingDir
14  ,pathToByteString
15  ,pathToLazyByteString
16  ,pathToText
17  ,tryGetModificationTime
18  ) where
19
20import           Data.Time (UTCTime)
21import           Path
22import           Path.IO
23import           Path.Internal (Path(..))
24import           RIO
25import           System.IO.Error (isDoesNotExistError)
26import qualified Data.ByteString.Char8 as BS
27import qualified Data.ByteString.Lazy.Char8 as BSL
28import qualified Data.Text as T
29import qualified Data.Text.Encoding as T
30import qualified System.FilePath as FP
31
32-- | Convert to FilePath but don't add a trailing slash.
33toFilePathNoTrailingSep :: Path loc Dir -> FilePath
34toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . toFilePath
35
36-- | Collapse intermediate "." and ".." directories from path, then parse
37-- it with 'parseAbsDir'.
38-- (probably should be moved to the Path module)
39parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
40parseCollapsedAbsDir = parseAbsDir . collapseFilePath
41
42-- | Collapse intermediate "." and ".." directories from path, then parse
43-- it with 'parseAbsFile'.
44-- (probably should be moved to the Path module)
45parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
46parseCollapsedAbsFile = parseAbsFile . collapseFilePath
47
48-- | Add a relative FilePath to the end of a Path
49-- We can't parse the FilePath first because we need to account for ".."
50-- in the FilePath (#2895)
51concatAndColapseAbsDir :: MonadThrow m => Path Abs Dir -> FilePath -> m (Path Abs Dir)
52concatAndColapseAbsDir base rel = parseCollapsedAbsDir (toFilePath base FP.</> rel)
53
54-- | Collapse intermediate "." and ".." directories from a path.
55--
56-- > collapseFilePath "./foo" == "foo"
57-- > collapseFilePath "/bar/../baz" == "/baz"
58-- > collapseFilePath "/../baz" == "/../baz"
59-- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
60-- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
61-- > collapseFilePath "parent/foo/.." ==  "parent"
62-- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
63--
64-- (adapted from @Text.Pandoc.Shared@)
65collapseFilePath :: FilePath -> FilePath
66collapseFilePath = FP.joinPath . reverse . foldl' go [] . FP.splitDirectories
67  where
68    go rs "." = rs
69    go r@(p:rs) ".." = case p of
70                            ".." -> "..":r
71                            (checkPathSeparator -> True) -> "..":r
72                            _ -> rs
73    go _ (checkPathSeparator -> True) = [[FP.pathSeparator]]
74    go rs x = x:rs
75    checkPathSeparator [x] = FP.isPathSeparator x
76    checkPathSeparator _ = False
77
78-- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on
79-- Windows).
80dropRoot :: Path Abs t -> Path Rel t
81dropRoot (Path l) = Path (FP.dropDrive l)
82
83-- | If given file in 'Maybe' does not exist, ensure we have 'Nothing'. This
84-- is to be used in conjunction with 'forgivingAbsence' and
85-- 'resolveFile'.
86--
87-- Previously the idiom @forgivingAbsence (relsoveFile …)@ alone was used,
88-- which relied on 'canonicalizePath' throwing 'isDoesNotExistError' when
89-- path does not exist. As it turns out, this behavior is actually not
90-- intentional and unreliable, see
91-- <https://github.com/haskell/directory/issues/44>. This was “fixed” in
92-- version @1.2.3.0@ of @directory@ package (now it never throws). To make
93-- it work with all versions, we need to use the following idiom:
94--
95-- > forgivingAbsence (resolveFile …) >>= rejectMissingFile
96
97rejectMissingFile :: MonadIO m
98  => Maybe (Path Abs File)
99  -> m (Maybe (Path Abs File))
100rejectMissingFile Nothing = return Nothing
101rejectMissingFile (Just p) = bool Nothing (Just p) `liftM` doesFileExist p
102
103-- | See 'rejectMissingFile'.
104
105rejectMissingDir :: MonadIO m
106  => Maybe (Path Abs Dir)
107  -> m (Maybe (Path Abs Dir))
108rejectMissingDir Nothing = return Nothing
109rejectMissingDir (Just p) = bool Nothing (Just p) `liftM` doesDirExist p
110
111-- | Convert to a lazy ByteString using toFilePath and UTF8.
112pathToLazyByteString :: Path b t -> BSL.ByteString
113pathToLazyByteString = BSL.fromStrict . pathToByteString
114
115-- | Convert to a ByteString using toFilePath and UTF8.
116pathToByteString :: Path b t -> BS.ByteString
117pathToByteString = T.encodeUtf8 . pathToText
118
119pathToText :: Path b t -> T.Text
120pathToText = T.pack . toFilePath
121
122tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
123tryGetModificationTime = liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime
124