content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE ViewPatterns      #-}
  
  {-|
  Module      : Path.Extra
  Description : Extra Path utilities.
  License     : BSD-3-Clause
  -}
  
  module Path.Extra
    ( toFilePathNoTrailingSep
    , parseCollapsedAbsDir
    , parseCollapsedAbsFile
    , concatAndCollapseAbsDir
    , rejectMissingFile
    , rejectMissingDir
    , pathToByteString
    , pathToLazyByteString
    , pathToText
    , tryGetModificationTime
    , forgivingResolveDir
    , forgivingResolveFile
    , forgivingResolveFile'
    ) where
  
  import           Data.Time ( UTCTime )
  import           Path
                     ( Abs, Dir, File, Path, PathException (..), parseAbsDir
                     , parseAbsFile, toFilePath
                     )
  import           Path.IO
                     ( doesDirExist, doesFileExist, getCurrentDir
                     , getModificationTime
                     )
  import           RIO
  import           System.IO.Error ( isDoesNotExistError )
  import qualified Data.ByteString.Char8 as BS
  import qualified Data.ByteString.Lazy.Char8 as BSL
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  import qualified System.Directory as D
  import qualified System.FilePath as FP
  
  -- | Convert to FilePath but don't add a trailing slash.
  toFilePathNoTrailingSep :: Path loc Dir -> FilePath
  toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . toFilePath
  
  -- | Collapse intermediate "." and ".." directories from path, then parse
  -- it with 'parseAbsDir'.
  -- (probably should be moved to the Path module)
  parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir)
  parseCollapsedAbsDir = parseAbsDir . collapseFilePath
  
  -- | Collapse intermediate "." and ".." directories from path, then parse
  -- it with 'parseAbsFile'.
  -- (probably should be moved to the Path module)
  parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File)
  parseCollapsedAbsFile = parseAbsFile . collapseFilePath
  
  -- | Add a relative FilePath to the end of a Path
  -- We can't parse the FilePath first because we need to account for ".."
  -- in the FilePath (#2895)
  concatAndCollapseAbsDir ::
       MonadThrow m
    => Path Abs Dir
    -> FilePath
    -> m (Path Abs Dir)
  concatAndCollapseAbsDir base rel =
    parseCollapsedAbsDir (toFilePath base FP.</> rel)
  
  -- | Collapse intermediate "." and ".." directories from a path.
  --
  -- > collapseFilePath "./foo" == "foo"
  -- > collapseFilePath "/bar/../baz" == "/baz"
  -- > collapseFilePath "/../baz" == "/../baz"
  -- > collapseFilePath "parent/foo/baz/../bar" ==  "parent/foo/bar"
  -- > collapseFilePath "parent/foo/baz/../../bar" ==  "parent/bar"
  -- > collapseFilePath "parent/foo/.." ==  "parent"
  -- > collapseFilePath "/parent/foo/../../bar" ==  "/bar"
  --
  -- (adapted from @Text.Pandoc.Shared@)
  collapseFilePath :: FilePath -> FilePath
  collapseFilePath = FP.joinPath . reverse . foldl' go [] . FP.splitDirectories
   where
    go rs "." = rs
    go r@(p:rs) ".." = case p of
                            ".." -> "..":r
                            (checkPathSeparator -> True) -> "..":r
                            _ -> rs
    go _ (checkPathSeparator -> True) = [[FP.pathSeparator]]
    go rs x = x:rs
    checkPathSeparator [x] = FP.isPathSeparator x
    checkPathSeparator _ = False
  
  -- | If given file in 'Maybe' does not exist, ensure we have 'Nothing'. This
  -- is to be used in conjunction with 'Path.IO.forgivingAbsence' and
  -- 'Path.IO.resolveFile'.
  --
  -- Previously the idiom @forgivingAbsence (resolveFile …)@ alone was used, which
  -- relied on 'Path.IO.canonicalizePath' throwing 'isDoesNotExistError' when path
  -- does not exist. As it turns out, this behavior is actually not intentional
  -- and unreliable, see <https://github.com/haskell/directory/issues/44>. This
  -- was “fixed” in version @1.2.3.0@ of @directory@ package (now it never
  -- throws). To make it work with all versions, we need to use the following
  -- idiom:
  --
  -- > forgivingAbsence (resolveFile …) >>= rejectMissingFile
  
  rejectMissingFile ::
       MonadIO m
    => Maybe (Path Abs File)
    -> m (Maybe (Path Abs File))
  rejectMissingFile Nothing = pure Nothing
  rejectMissingFile (Just p) = bool Nothing (Just p) <$> doesFileExist p
  
  -- | See 'rejectMissingFile'.
  
  rejectMissingDir ::
       MonadIO m
    => Maybe (Path Abs Dir)
    -> m (Maybe (Path Abs Dir))
  rejectMissingDir Nothing = pure Nothing
  rejectMissingDir (Just p) = bool Nothing (Just p) <$> doesDirExist p
  
  -- | Convert to a lazy ByteString using toFilePath and UTF8.
  pathToLazyByteString :: Path b t -> BSL.ByteString
  pathToLazyByteString = BSL.fromStrict . pathToByteString
  
  -- | Convert to a ByteString using toFilePath and UTF8.
  pathToByteString :: Path b t -> BS.ByteString
  pathToByteString = T.encodeUtf8 . pathToText
  
  -- | Convert to a 'T.Text' type.
  pathToText :: Path b t -> T.Text
  pathToText = T.pack . toFilePath
  
  -- | Attempt to get the time at which the given file was last modified. Yields
  -- `Left ()` if the file does not exist.
  --
  -- The operation may fail with 'System.IO.Error.isPermissionError' if the user
  -- is not permitted to read the modification time.
  --
  -- Caveat for POSIX systems: This function returns a timestamp with sub-second
  -- resolution only if this package is compiled against `unix-2.6.0.0` or later
  -- and the underlying filesystem supports them.
  tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
  tryGetModificationTime =
    liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime
  
  -- | 'Path.IO.resolveDir' (@path-io@ package) throws 'InvalidAbsDir' (@path@
  -- package) in certain circumstances; this function yields 'Nothing' in those
  -- circumstances.
  forgivingResolveDir ::
       MonadIO m
    => Path Abs Dir
       -- ^ Base directory
    -> FilePath
       -- ^ Path to resolve
    -> m (Maybe (Path Abs Dir))
  forgivingResolveDir b p = liftIO $
    D.canonicalizePath (toFilePath b FP.</> p) >>= \cp ->
      catch
        (Just <$> parseAbsDir cp)
        ( \e -> case e of
            InvalidAbsDir _ -> pure Nothing
            _ -> throwIO e
        )
  
  -- | 'Path.IO.resolveFile' (@path-io@ package) throws 'InvalidAbsFile' (@path@
  -- package) in certain circumstances; this function yields 'Nothing' in those
  -- circumstances.
  forgivingResolveFile ::
       MonadIO m
    => Path Abs Dir
       -- ^ Base directory
    -> FilePath
       -- ^ Path to resolve
    -> m (Maybe (Path Abs File))
  forgivingResolveFile b p = liftIO $
    D.canonicalizePath (toFilePath b FP.</> p) >>= \cp ->
      catch
        (Just <$> parseAbsFile cp)
        ( \e -> case e of
            InvalidAbsFile _ -> pure Nothing
            _ -> throwIO e
        )
  
  -- | 'Path.IO.resolveFile'' (@path-io@ package) throws 'InvalidAbsFile' (@path@
  -- package) in certain circumstances; this function yields 'Nothing' in those
  -- circumstances.
  forgivingResolveFile' ::
       MonadIO m
    => FilePath
       -- ^ Path to resolve
    -> m (Maybe (Path Abs File))
  forgivingResolveFile' p = getCurrentDir >>= flip forgivingResolveFile p
  