Internal.hs

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 = handle (\e -> case e of
    IOError
        { ioe_type = ResourceVanished
        , ioe_errno = Just ioe }
        | Errno ioe == ePIPE -> return ()
    _ -> throwIO 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 = Right . Text.pack
{-# DEPRECATED toText "Use Data.Text.pack instead" #-}

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

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

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

-- | Find the greatest common prefix between a list of `FilePath`s
commonPrefix :: [FilePath] -> FilePath
commonPrefix [ ] = mempty
commonPrefix (path : paths) = foldr longestPathPrefix path paths
  where
    longestPathPrefix left right =
        FilePath.joinPath (longestPrefix leftComponents rightComponents)
      where
        leftComponents = splitExt (splitDirectories left)

        rightComponents = splitExt (splitDirectories right)

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

-- | Remove a prefix from a path
stripPrefix :: FilePath -> FilePath -> Maybe FilePath
stripPrefix prefix path = do
    suffix <- List.stripPrefix prefixComponents pathComponents

    return (FilePath.joinPath suffix)
  where
    prefixComponents = splitExt (splitDirectories prefix)

    pathComponents = splitExt (splitDirectories path)

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

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

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

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

-- | Retrieves the `FilePath`'s root
root :: FilePath -> FilePath
root = fst . FilePath.splitDrive

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

    components = loop (splitDirectories rest)

    prefix =
        case components of
            "./"  : _ -> drive
            "../" : _ -> drive
            _ | null drive -> "./"
              | otherwise  -> drive

    suffix = FilePath.joinPath components

    loop [ _ ]    = [ ]
    loop [ ]      = [ ]
    loop (c : cs) = c : loop cs

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

    trailingSlash ""       = "/"
    trailingSlash "/"      = "/"
    trailingSlash (c : cs) = c : trailingSlash cs

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

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

    deslash ""       = Nothing
    deslash "/"      = Just ""
    deslash (c : cs) = fmap (c :) (deslash cs)

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

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

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

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

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

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

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

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