module Turtle.Internal where

import Control.Applicative ((<|>))
import Control.Exception (handle, throwIO)
import Data.Text (Text)
import Foreign.C.Error (Errno(..), ePIPE)
import GHC.IO.Exception (IOErrorType(..), IOException(..))
import System.FilePath ((</>))

import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified System.FilePath as FilePath

ignoreSIGPIPE :: IO () -> IO ()
ignoreSIGPIPE :: IO () -> IO ()
ignoreSIGPIPE = (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\IOException
e -> case IOException
e of
    IOError
        { ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
ResourceVanished
        , ioe_errno :: IOException -> Maybe CInt
ioe_errno = Just CInt
ioe }
        | CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IOException
_ -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e
    )

{-| Convert a `FilePath` to human-readable `Text`

    Note that even though the type says `Either` this utility actually always
    succeeds and returns a `Right` value.  The only reason for the `Either` is
    compatibility with the old type from the @system-filepath@ package.
-}
toText :: FilePath -> Either Text Text
toText :: FilePath -> Either Text Text
toText = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (FilePath -> Text) -> FilePath -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
{-# DEPRECATED toText "Use Data.Text.pack instead" #-}

-- | Convert `Text` to a `FilePath`
fromText :: Text -> FilePath
fromText :: Text -> FilePath
fromText = Text -> FilePath
Text.unpack
{-# DEPRECATED fromText "Use Data.Text.unpack instead" #-}

-- | Convert a `String` to a `FilePath`
decodeString :: String -> FilePath
decodeString :: FilePath -> FilePath
decodeString = FilePath -> FilePath
forall a. a -> a
id
{-# DEPRECATED decodeString "Use id instead" #-}

-- | Convert a `FilePath` to a `String`
encodeString :: FilePath -> String
encodeString :: FilePath -> FilePath
encodeString = FilePath -> FilePath
forall a. a -> a
id
{-# DEPRECATED encodeString "Use id instead" #-}

-- | Find the greatest common prefix between a list of `FilePath`s
commonPrefix :: [FilePath] -> FilePath
commonPrefix :: [FilePath] -> FilePath
commonPrefix [ ] = FilePath
forall a. Monoid a => a
mempty
commonPrefix (FilePath
path : [FilePath]
paths) = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
longestPathPrefix FilePath
path [FilePath]
paths
  where
    longestPathPrefix :: FilePath -> FilePath -> FilePath
longestPathPrefix FilePath
left FilePath
right
        | [FilePath]
leftComponents [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== [FilePath]
rightComponents =
               [FilePath] -> FilePath
FilePath.joinPath [FilePath]
leftComponents
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
longestPrefix [FilePath]
leftExtensions [FilePath]
rightExtensions)
        | Bool
otherwise =
           [FilePath] -> FilePath
FilePath.joinPath ([FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
longestPrefix [FilePath]
leftComponents [FilePath]
rightComponents)
      where
        ([FilePath]
leftComponents, [FilePath]
leftExtensions)  = [FilePath] -> ([FilePath], [FilePath])
splitExt (FilePath -> [FilePath]
splitDirectories FilePath
left)

        ([FilePath]
rightComponents, [FilePath]
rightExtensions) = [FilePath] -> ([FilePath], [FilePath])
splitExt (FilePath -> [FilePath]
splitDirectories FilePath
right)

longestPrefix :: Eq a => [a] -> [a] -> [a]
longestPrefix :: [a] -> [a] -> [a]
longestPrefix (a
l : [a]
ls) (a
r : [a]
rs)
    | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r = a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
longestPrefix [a]
ls [a]
rs
longestPrefix [a]
_ [a]
_ = [ ]

-- | Remove a prefix from a path
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix FilePath
prefix FilePath
path = do
    [FilePath]
componentSuffix <- [FilePath] -> [FilePath] -> Maybe [FilePath]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [FilePath]
prefixComponents [FilePath]
pathComponents

    if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
componentSuffix
        then do
            [FilePath]
prefixSuffix <- [FilePath] -> [FilePath] -> Maybe [FilePath]
forall a. Eq a => [a] -> [a] -> Maybe [a]
List.stripPrefix [FilePath]
prefixExtensions [FilePath]
pathExtensions

            FilePath -> Maybe FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath]
prefixSuffix)
        else do
            FilePath -> Maybe FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
FilePath.joinPath [FilePath]
componentSuffix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [FilePath]
pathExtensions)
  where
    ([FilePath]
prefixComponents, [FilePath]
prefixExtensions) = [FilePath] -> ([FilePath], [FilePath])
splitExt (FilePath -> [FilePath]
splitDirectories FilePath
prefix)

    ([FilePath]
pathComponents, [FilePath]
pathExtensions) = [FilePath] -> ([FilePath], [FilePath])
splitExt (FilePath -> [FilePath]
splitDirectories FilePath
path)

-- Internal helper function for `stripPrefix` and `commonPrefix`
splitExt :: [FilePath] -> ([FilePath], [String])
splitExt :: [FilePath] -> ([FilePath], [FilePath])
splitExt [ FilePath
component ] = ([ FilePath
base ], (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
exts)
  where
    (FilePath
base, [FilePath]
exts) = FilePath -> (FilePath, [FilePath])
splitExtensions FilePath
component
splitExt [ ] =
    ([ ], [ ])
splitExt (FilePath
component : [FilePath]
components) = (FilePath
component FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
base, [FilePath]
exts)
  where
    ([FilePath]
base, [FilePath]
exts) = [FilePath] -> ([FilePath], [FilePath])
splitExt [FilePath]
components

-- | Normalise a path
collapse :: FilePath -> FilePath
collapse :: FilePath -> FilePath
collapse = FilePath -> FilePath
FilePath.normalise
{-# DEPRECATED collapse "Use System.FilePath.normalise instead" #-}

-- | Read in a file as `Text`
readTextFile :: FilePath -> IO Text
readTextFile :: FilePath -> IO Text
readTextFile = FilePath -> IO Text
Text.IO.readFile
{-# DEPRECATED readTextFile "Use Data.Text.IO.readFile instead" #-}

-- | Write out a file as `Text`
writeTextFile :: FilePath -> Text -> IO ()
writeTextFile :: FilePath -> Text -> IO ()
writeTextFile = FilePath -> Text -> IO ()
Text.IO.writeFile
{-# DEPRECATED writeTextFile "Use Data.Text.IO.writeFile instead" #-}

-- | Retrieves the `FilePath`'s root
root :: FilePath -> FilePath
root :: FilePath -> FilePath
root = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
FilePath.splitDrive

-- | Retrieves the `FilePath`'s parent directory
parent :: FilePath -> FilePath
parent :: FilePath -> FilePath
parent FilePath
path = FilePath
prefix FilePath -> FilePath -> FilePath
</> FilePath
suffix
  where
    (FilePath
drive, FilePath
rest) = FilePath -> (FilePath, FilePath)
FilePath.splitDrive FilePath
path

    components :: [FilePath]
components = [FilePath] -> [FilePath]
forall a. [a] -> [a]
loop (FilePath -> [FilePath]
splitDirectories FilePath
rest)

    prefix :: FilePath
prefix =
        case [FilePath]
components of
            FilePath
"./"  : [FilePath]
_ -> FilePath
drive
            FilePath
"../" : [FilePath]
_ -> FilePath
drive
            [FilePath]
_ | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drive -> FilePath
"./"
              | Bool
otherwise  -> FilePath
drive

    suffix :: FilePath
suffix = [FilePath] -> FilePath
FilePath.joinPath [FilePath]
components

    loop :: [a] -> [a]
loop [ a
_ ]    = [ ]
    loop [ ]      = [ ]
    loop (a
c : [a]
cs) = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
loop [a]
cs

-- | Retrieves the `FilePath`'s directory
directory :: FilePath -> FilePath
directory :: FilePath -> FilePath
directory FilePath
path
    | FilePath
prefix FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"" Bool -> Bool -> Bool
&& FilePath
suffix FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." =
        FilePath
"../"
    | Bool
otherwise =
        FilePath -> FilePath
trailingSlash (FilePath -> FilePath
FilePath.takeDirectory FilePath
prefix) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suffix
  where
    (FilePath
prefix, FilePath
suffix) = FilePath -> (FilePath, FilePath)
trailingParent FilePath
path
      where
        trailingParent :: FilePath -> (FilePath, FilePath)
trailingParent FilePath
".."     = (FilePath
""      , FilePath
"..")
        trailingParent [ Char
a, Char
b ] = ([ Char
a, Char
b ], FilePath
""  )
        trailingParent [ Char
a ]    = ([ Char
a ]   , FilePath
""  )
        trailingParent [ ]      = ([ ]     , FilePath
""  )
        trailingParent (Char
c : FilePath
cs) = (Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
p, FilePath
s)
          where
            ~(FilePath
p, FilePath
s) = FilePath -> (FilePath, FilePath)
trailingParent FilePath
cs

    trailingSlash :: FilePath -> FilePath
trailingSlash FilePath
""       = FilePath
"/"
    trailingSlash FilePath
"/"      = FilePath
"/"
    trailingSlash (Char
c : FilePath
cs) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
trailingSlash FilePath
cs

-- | Retrieves the `FilePath`'s filename component
filename :: FilePath -> FilePath
filename :: FilePath -> FilePath
filename FilePath
path
    | FilePath
result FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"." Bool -> Bool -> Bool
|| FilePath
result FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".." = FilePath
""
    | Bool
otherwise                       = FilePath
result
  where
    result :: FilePath
result = FilePath -> FilePath
FilePath.takeFileName FilePath
path

-- | Retrieve a `FilePath`'s directory name
dirname :: FilePath -> FilePath
dirname :: FilePath -> FilePath
dirname FilePath
path = [FilePath] -> FilePath
loop (FilePath -> [FilePath]
splitDirectories FilePath
path)
  where
    loop :: [FilePath] -> FilePath
loop [ FilePath
x, FilePath
y ] =
        case FilePath -> Maybe FilePath
deslash FilePath
y Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Maybe FilePath
deslash FilePath
x of
            Just FilePath
name -> FilePath
name
            Maybe FilePath
Nothing   -> FilePath
""
    loop [ FilePath
x ] =
        case FilePath -> Maybe FilePath
deslash FilePath
x of
            Just FilePath
name -> FilePath
name
            Maybe FilePath
Nothing   -> FilePath
""
    loop [ ] =
        FilePath
""
    loop (FilePath
_ : [FilePath]
xs) =
        [FilePath] -> FilePath
loop [FilePath]
xs

    deslash :: FilePath -> Maybe FilePath
deslash FilePath
""       = Maybe FilePath
forall a. Maybe a
Nothing
    deslash FilePath
"/"      = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
""
    deslash (Char
c : FilePath
cs) = (FilePath -> FilePath) -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) (FilePath -> Maybe FilePath
deslash FilePath
cs)

-- | Retrieve a `FilePath`'s basename component
basename :: FilePath -> String
basename :: FilePath -> FilePath
basename FilePath
path =
    case FilePath
name of
        Char
'.' : FilePath
_ -> FilePath
name
        FilePath
_ ->
            case FilePath -> (FilePath, [FilePath])
splitExtensions FilePath
name of
                (FilePath
base, [FilePath]
_) -> FilePath
base
  where
    name :: FilePath
name = FilePath -> FilePath
filename FilePath
path

-- | Test whether a path is absolute
absolute :: FilePath -> Bool
absolute :: FilePath -> Bool
absolute = FilePath -> Bool
FilePath.isAbsolute
{-# DEPRECATED absolute "Use System.FilePath.isAbsolute instead" #-}

-- | Test whether a path is relative
relative :: FilePath -> Bool
relative :: FilePath -> Bool
relative = FilePath -> Bool
FilePath.isRelative
{-# DEPRECATED relative "Use System.FilePath.isRelative instead" #-}

-- | Split a `FilePath` into its components
splitDirectories :: FilePath -> [FilePath]
splitDirectories :: FilePath -> [FilePath]
splitDirectories FilePath
path = [FilePath] -> [FilePath]
loop (FilePath -> [FilePath]
FilePath.splitPath FilePath
path)
  where
    loop :: [FilePath] -> [FilePath]
loop [ ]      = [ ]
    loop [ FilePath
".." ] = [ FilePath
"../" ]
    loop [ FilePath
"." ]  = [ FilePath
"./" ]
    loop (FilePath
c : [FilePath]
cs) = FilePath
c FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
loop [FilePath]
cs

-- | Get a `FilePath`'s last extension, or `Nothing` if it has no extension
extension :: FilePath -> Maybe String
extension :: FilePath -> Maybe FilePath
extension FilePath
path =
    case FilePath
suffix of
        Char
'.' : FilePath
ext -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ext
        FilePath
_         -> Maybe FilePath
forall a. Maybe a
Nothing
  where
    suffix :: FilePath
suffix = FilePath -> FilePath
FilePath.takeExtension FilePath
path

-- | Split a `FilePath` on its extension
splitExtension :: FilePath -> (String, Maybe String)
splitExtension :: FilePath -> (FilePath, Maybe FilePath)
splitExtension FilePath
path =
    case FilePath
suffix of
        Char
'.' : FilePath
ext -> (FilePath
prefix, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ext)
        FilePath
_         -> (FilePath
prefix, Maybe FilePath
forall a. Maybe a
Nothing)
  where
    (FilePath
prefix, FilePath
suffix) = FilePath -> (FilePath, FilePath)
FilePath.splitExtension FilePath
path

-- | Split a `FilePath` on its extensions
splitExtensions :: FilePath -> (String, [String])
splitExtensions :: FilePath -> (FilePath, [FilePath])
splitExtensions FilePath
path0 = (FilePath
prefix0, [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
exts0)
  where
    (FilePath
prefix0, [FilePath]
exts0) = FilePath -> (FilePath, [FilePath])
loop FilePath
path0

    loop :: FilePath -> (FilePath, [FilePath])
loop FilePath
path = case FilePath -> (FilePath, Maybe FilePath)
splitExtension FilePath
path of
        (FilePath
prefix, Just FilePath
ext) ->
            (FilePath
base, FilePath
ext FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
exts)
          where
            (FilePath
base, [FilePath]
exts) = FilePath -> (FilePath, [FilePath])
loop FilePath
prefix
        (FilePath
base, Maybe FilePath
Nothing) ->
            (FilePath
base, [])