{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{- |
   Module     : System.Path.NameManip
   Copyright  : Copyright (C) 2004 Volker Wysk
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

Low-level path name manipulations.

Written by Volker Wysk
-}

module System.Path.NameManip where

import           Data.List        (intercalate, unfoldr)
import           System.Directory (getCurrentDirectory)
import           System.FilePath  (isPathSeparator, pathSeparator, (</>))

{- | Split a path in components. Repeated \"@\/@\" characters don\'t lead to empty
components. \"@.@\" path components are removed. If the path is absolute, the first component
will start with \"@\/@\". \"@..@\" components are left intact. They can't be simply
removed, because the preceding component might be a symlink. In this case,
'realpath' is probably what you need.

The case that the path is empty, is probably an error. However, it is
treated like \"@.@\", yielding an empty path components list.

Examples:

>slice_path "/"        = ["/"]
>slice_path "/foo/bar" = ["/foo","bar"]
>slice_path "..//./"   = [".."]
>slice_path "."        = []

See 'unslice_path', 'realpath', 'realpath_s'.
-}
slice_path :: String    -- ^ The path to be broken to components.
           -> [String]  -- ^ List of path components.
slice_path :: String -> [String]
slice_path String
"" = []
slice_path (Char
c:String
cs) = if Char -> Bool
isPathSeparator Char
c
                       then case String -> [String]
slice_path' String
cs of
                           []     -> [[Char
c]]
                           (String
p:[String]
ps) -> (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
p)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ps
                       else String -> [String]
slice_path' (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)
    where
      slice_path' :: String -> [String]
slice_path' String
o = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
c -> String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
".") (String -> [String]
split String
o)

      split :: String -> [String]
split String
xs = (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr String -> Maybe (String, String)
f String
xs
        where
          f :: String -> Maybe (String, String)
f String
"" = Maybe (String, String)
forall a. Maybe a
Nothing
          f String
xs = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> (String, String) -> (String, String)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
forall {a}. [a] -> [a]
tail' ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator String
xs
          tail' :: [a] -> [a]
tail' [] = []
          tail' [a]
xs = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs


{- | Form a path from path components. This isn't the inverse
of 'slice_path', since @'unslice_path' . 'slice_path'@
normalises the path.

See 'slice_path'.
-}
unslice_path :: [String]        -- ^ List of path components
             -> String          -- ^ The path which consists of the supplied path components
unslice_path :: [String] -> String
unslice_path [] = String
"."
unslice_path [String]
cs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
pathSeparator] [String]
cs


{- | Normalise a path. This is done by reducing repeated @\/@ characters to one, and removing
@.@ path components. @..@ path components are left intact, because of possible symlinks.

@'normalise_path' = 'unslice_path' . 'slice_path'@
-}
normalise_path :: String        -- ^ Path to be normalised
               -> String        -- ^ Path in normalised form
normalise_path :: String -> String
normalise_path = [String] -> String
unslice_path ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
slice_path


{- | Split a file name in components. This are the base file name and the
suffixes, which are separated by dots. If the name starts with a dot, it is
regarded as part of the base name. The result is a list of file name
components. The filename may be a path. In this case, everything up to the
last path component will be returned as part of the base file name. The
path gets normalised thereby.

No empty suffixes are returned. If the file name contains several
consecutive dots, they are regared as part of the preceding file name
component.

Concateneting the name components and adding dots, reproduces the
original name, with a normalised path:
@concat . intersperse \".\" . 'slice_filename' == 'normalise'@.

Note that the last path component might be \"@..@\". Then it is not
possible to deduce the refered directory's name from the path. An IO
action for getting the real path is then necessary.

Examples:

@
'slice_filename' \"a.b\/\/.\/.foo.tar.gz\" == [\"a.b\/.foo\",\"tar\",\"gz\"]
'slice_filename' \".x..y.\"             == [\".x.\", \"y.\"]
@

See 'unslice_filename', @slice_filename\'@.
-}
slice_filename :: String        -- ^ Path
               -> [String]      -- ^ List of components the file name is made up of
slice_filename :: String -> [String]
slice_filename String
path =
   let comps :: [String]
comps = String -> [String]
slice_path String
path
   in if [String]
comps [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== []
         then []
         else -- slice_filename' result not empty, because comps not empty
              let (String
base:[String]
suffixes) = String -> [String]
slice_filename' ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
comps)
              in ([String] -> String
unslice_path ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
comps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
base]) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
suffixes)


{- | This is a variant of 'slice_filename'. It is like 'slice_filename', except for
being more efficient, and the filename must not contain any preceding path,
since this case isn't considered.

See 'slice_filename', 'unslice_filename'.
-}
slice_filename' :: String        -- ^ File name without path
                -> [String]      -- ^ List of components the file name is made up of
slice_filename' :: String -> [String]
slice_filename' = \case
     (Char
'.':String
filename') -> case String -> [String]
slice_filename'' String
filename' of
                           []     -> [String
"."]
                           (String
t:[String]
ts) -> (Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
t) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ts
     String
filename -> String -> [String]
slice_filename'' String
filename
   where
      slice_filename'' :: String -> [String]
      slice_filename'' :: String -> [String]
slice_filename'' String
"" = []
      slice_filename'' String
fn =
         let (String
beg,String
rest) = String -> (String, String)
split1 String
fn
         in  (String
beg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
slice_filename'' String
rest)

      split1 :: String -> (String, String)
      split1 :: String -> (String, String)
split1 (Char
x:Char
y:String
r) =
         if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.' then (String
"", Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
r)
                                 else let (String
beg,String
rest) = String -> (String, String)
split1 (Char
yChar -> String -> String
forall a. a -> [a] -> [a]
:String
r)
                                      in  (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
beg,String
rest)
      split1 String
str = (String
str, String
"")



{- | Form file name from file name components, interspersing dots. This is
the inverse of 'slice_filename', except for normalisation of any path.

> unslice_filename = concat . intersperse "."

See 'slice_filename'.
-}
unslice_filename :: [String]    -- ^ List of file name components
                 -> String      -- ^ Name of the file which consists of the supplied components
unslice_filename :: [String] -> String
unslice_filename = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"."


{- | Split a path in directory and file name. Only in the case that the
supplied path is empty, both parts are empty strings. Otherwise, @\".\"@ is filled in
for the corresponding part, if necessary. Unless the path is empty,
concatenating the returned path and file name components with a slash in
between, makes a valid path to the file.

@split_path@ splits off the last path component. This
isn't the same as the text after the last @\/@.

Note that the last path component might be @\"..\"@. Then it is not
possible to deduce the refered directory's name from the path. Then an IO
action for getting the real path is necessary.

Examples:

>split_path "/a/b/c"      == ("/a/b", "c")
>split_path "foo"         == (".", "foo")
>split_path "foo/bar"     == ("foo", "bar")
>split_path "foo/.."      == ("foo", "..")
>split_path "."           == (".", ".")
>split_path ""            == ("", "")
>split_path "/foo"        == ("/", "foo")
>split_path "foo/"        == (".", "foo")
>split_path "foo/."       == (".", "foo")
>split_path "foo///./bar" == ("foo", "bar")

See 'slice_path'.
-}
split_path :: String            -- ^ Path to be split
           -> (String, String)  -- ^ Directory and file name components of the path. The directory path is normalized.
split_path :: String -> (String, String)
split_path String
"" = (String
"",String
"")
split_path String
path =
   case String -> [String]
slice_path String
path of
      []     -> (String
".", String
".")
      [String
""]   -> (String
".", String
"")
      [Char
f:String
fs] -> if Char -> Bool
isPathSeparator Char
f then ([Char
pathSeparator], String
fs) else (String
".", Char
fChar -> String -> String
forall a. a -> [a] -> [a]
:String
fs)
      [String]
parts  -> ( [String] -> String
unslice_path ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
parts)
                , [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
parts
                )

{- | Get the directory part of a path.

>dir_part = fst . split_path

See 'split_path'.
-}
dir_part :: String -> String
dir_part :: String -> String
dir_part = (String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
split_path


{- | Get the last path component of a path.

>filename_part = snd . split_path

Examples:

>filename_part "foo/bar" == "bar"
>filename_part "."       == "."

See 'split_path'.
-}
filename_part :: String -> String
filename_part :: String -> String
filename_part = (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
split_path


{- | Inverse of 'split_path', except for normalisation.

This concatenates two paths, and takes care of @\".\"@ and empty paths. When the two components are the result of @split_path@, then @unsplit_path@
creates a normalised path. It is best documented by its definition:

>unsplit_path (".", "") = "."
>unsplit_path ("", ".") = "."
>unsplit_path (".", q)  = q
>unsplit_path ("", q)   = q
>unsplit_path (p, "")   = p
>unsplit_path (p, ".")  = p
>unsplit_path (p, q)    = p ++ "/" ++ q

Examples:

>unsplit_path ("", "")     == ""
>unsplit_path (".", "")    == "."
>unsplit_path (".", ".")   == "."
>unsplit_path ("foo", ".") == "foo"

See 'split_path'.
-}
unsplit_path :: ( String, String )  -- ^ Directory and file name
             -> String          -- ^ Path formed from the directory and file name parts
unsplit_path :: (String, String) -> String
unsplit_path (String
".", String
"") = String
"."
unsplit_path (String
"", String
".") = String
"."
unsplit_path (String
".", String
q)  = String
q
unsplit_path (String
"", String
q)   = String
q
unsplit_path (String
p, String
"")   = String
p
unsplit_path (String
p, String
".")  = String
p
unsplit_path (String
p, String
q)    = String
p String -> String -> String
</> String
q


{- | Split a file name in prefix and suffix. If there isn't any suffix in
the file name, then return an empty suffix. A dot at the beginning or at
the end is not regarded as introducing a suffix.

The last path component is what is being split. This isn't the same as
splitting the string at the last dot. For instance, if the file name
doesn't contain any dot, dots in previous path component's aren't mistaken
as introducing suffixes.

The path part is returned in normalised form. This means, @\".\"@ components
are removed, and multiple \"@\/@\"s are reduced to one.

Note that there isn't any plausibility check performed on the suffix. If the file name doesn't have a suffix, but happens to contain a dot, then this
dot is mistaken as introducing a suffix.

Examples:

>split_filename "path/to/foo.bar"                             = ("path/to/foo","bar")
>split_filename "path/to/foo"                                 = ("path/to/foo","")
>split_filename "/path.to/foo"                                = ("/path.to/foo","")
>split_filename "a///./x"                                     = ("a/x","")
>split_filename "dir.suffix/./"                               = ("dir","suffix")
>split_filename "Photographie, Das 20. Jahrhundert (300 dpi)" = ("Photographie, Das 20", " Jahrhundert (300 dpi)")

See 'slice_path', 'split_filename\''
-}
split_filename :: String                -- ^ Path including the file name to be split
               -> (String, String)      -- ^ The normalised path with the file prefix, and the file suffix.
split_filename :: String -> (String, String)
split_filename String
"" = (String
"", String
"")
split_filename String
path =
   case String -> [String]
slice_path String
path of
      []    -> (String
".",String
"")
      [String]
comps -> let (String
pref_fn, String
suff_fn) = String -> (String, String)
split_filename' ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
comps)
               in ( String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [Char
pathSeparator] ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
comps [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
pref_fn])
                  , String
suff_fn
                  )


{- | Variant of 'split_filename'. This is a more efficient version
of 'split_filename', for the case that you know the string is
is a pure file name without any slashes.

See 'split_filename'.
-}
split_filename' :: String               -- ^ Filename to be split
                -> (String, String)     -- ^ Base name and the last suffix
split_filename' :: String -> (String, String)
split_filename' String
"" = (String
"", String
"")
split_filename' String
fn =
   let parts :: [String]
parts = String -> [String]
slice_filename' String
fn
   in case [String]
parts of
         []     -> (String
".", String
"")
         [String
base] -> (String
base, String
"")
         [String]
p      -> ([String] -> String
unslice_filename ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
p), [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
p)


{- | Inverse of 'split_filename'. Concatenate prefix and suffix, adding
a dot in between, iff the suffix is not empty. The path part of the prefix is
normalised.

See 'split_filename'.
-}
unsplit_filename :: (String, String)    -- ^ File name prefix and suffix
                 -> String              -- ^ Path
unsplit_filename :: (String, String) -> String
unsplit_filename (String
prefix, String
suffix) =
   if String
suffix String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
prefix else String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix


{- | Split a path in directory, base file name and suffix.
-}
split3 :: String                        -- ^ Path to split
       -> (String, String, String)      -- ^ Directory part, base file name part and suffix part
split3 :: String -> (String, String, String)
split3 String
"" = (String
"",String
"",String
"")
split3 String
path =
   let comps :: [String]
comps = String -> [String]
slice_path String
path
       (String
base, String
suffix) = String -> (String, String)
split_filename' ([String] -> String
forall a. HasCallStack => [a] -> a
last [String]
comps)
   in  ([String] -> String
unslice_path ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
comps), String
base, String
suffix)


{- |
Form path from directory, base file name and suffix parts.
-}
unsplit3 :: (String, String, String)    -- ^ Directory part, base file name part and suffix part
         -> String                      -- ^ Path consisting of dir, base and suffix
unsplit3 :: (String, String, String) -> String
unsplit3 (String
dir, String
base, String
suffix) =
   (String, String) -> String
unsplit_path (String
dir, ((String, String) -> String
unsplit_filename (String
base,String
suffix)))


{- | Test a path for a specific suffix and split it off.

If the path ends with the suffix, then the result is @Just
prefix@, where @prefix@ is the normalised path
without the suffix. Otherwise it's @Nothing@.
-}
test_suffix :: String           -- ^ Suffix to split off
            -> String           -- ^ Path to test
            -> Maybe String     -- ^ Prefix without the suffix or @Nothing@
test_suffix :: String -> String -> Maybe String
test_suffix String
suffix String
path =
    let (String
prefix, String
suff) = String -> (String, String)
split_filename String
path
    in if String
suff String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
suffix then String -> Maybe String
forall a. a -> Maybe a
Just String
prefix
                         else Maybe String
forall a. Maybe a
Nothing


{- | Make a path absolute, using the current working directory.

This makes a relative path absolute with respect to the current
working directory. An absolute path is returned unmodified.

The current working directory is determined with @getCurrentDirectory@
which means that symbolic links in it are expanded and the path is
normalised. This is different from @pwd@.
-}
absolute_path :: String         -- ^ The path to be made absolute
              -> IO String      -- ^ Absulte path
absolute_path :: String -> IO String
absolute_path String
path = (String -> String) -> IO String -> IO String
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
absolute_path' String
path) IO String
getCurrentDirectory


{- | Make a path absolute.

This makes a relative path absolute with respect to a specified
directory. An absolute path is returned unmodified.
-}
absolute_path_by :: String        -- ^ The directory relative to which the path is made absolute
                 -> String        -- ^ The path to be made absolute
                 -> String        -- ^ Absolute path
absolute_path_by :: String -> String -> String
absolute_path_by = String -> String -> String
(</>)


{- | Make a path absolute.

This makes a relative path absolute with respect to a specified
directory. An absolute path is returned unmodified.

The order of the arguments can be confusing. You should rather use 'absolute_path_by'. @absolute_path\'@ is included for backwards compatibility.
-}
absolute_path' :: String        -- ^ The path to be made absolute
               -> String        -- ^ The directory relative to which the path is made absolute
               -> String        -- ^ Absolute path
absolute_path' :: String -> String -> String
absolute_path' = (String -> String -> String) -> String -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> String
absolute_path_by


{- | Guess the @\"..\"@-component free form of a path, specified as a list of path components, by syntactically removing them, along with the preceding
   path components. This will produce
   erroneous results when the path contains symlinks. If the path contains leading @\"..\"@ components, or more @\"..\"@ components than preceeding normal
   components, then the @\"..\"@ components can't be normalised away. In this case, the result is @Nothing@.
-}
guess_dotdot_comps :: [String]          -- ^ List of path components
                   -> Maybe [String]    -- ^ In case the path could be transformed, the @\"..\"@-component free list of path components.
guess_dotdot_comps :: [String] -> Maybe [String]
guess_dotdot_comps = [String] -> [String] -> Maybe [String]
guess_dotdot_comps' []
   where
      guess_dotdot_comps' :: [String] -> [String] -> Maybe [String]
guess_dotdot_comps' [String]
schon [] = [String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
schon
      guess_dotdot_comps' [] (String
"..":[String]
_) = Maybe [String]
forall a. Maybe a
Nothing
      guess_dotdot_comps' [String]
schon (String
"..":[String]
teile) = [String] -> [String] -> Maybe [String]
guess_dotdot_comps' ([String] -> [String]
forall {a}. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall {a}. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
schon) [String]
teile
      guess_dotdot_comps' [String]
schon (String
teil:[String]
teile) = [String] -> [String] -> Maybe [String]
guess_dotdot_comps' ([String]
schon [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
teil]) [String]
teile


{- | Guess the @\"..\"@-component free, normalised form of a path. The transformation is purely syntactic. @\"..\"@ path components will be removed, along
   with their preceding path components. This will produce
   erroneous results when the path contains symlinks. If the path contains leading @\"..\"@ components, or more @\"..\"@ components than preceeding normal
   components, then the @\"..\"@ components can't be normalised away. In this case, the result is @Nothing@.

>guess_dotdot = fmap unslice_path . guess_dotdot_comps . slice_path
-}
guess_dotdot :: String                  -- ^ Path to be normalised
             -> Maybe String            -- ^ In case the path could be transformed, the normalised, @\"..\"@-component free form of the path.
guess_dotdot :: String -> Maybe String
guess_dotdot =
   ([String] -> String) -> Maybe [String] -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unslice_path (Maybe [String] -> Maybe String)
-> (String -> Maybe [String]) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe [String]
guess_dotdot_comps ([String] -> Maybe [String])
-> (String -> [String]) -> String -> Maybe [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
slice_path