{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.FilePath.FilePather.Posix (
  splitExtension
, takeExtension
, replaceExtension
, dropExtension
, addExtension
, hasExtension
, splitExtensions
, dropExtensions
, takeExtensions
, replaceExtensions
, isExtensionOf
, stripExtension
, splitFileName
, takeFileName
, replaceFileName
, dropFileName
, takeBaseName
, replaceBaseName
, takeDirectory
, replaceDirectory
, combine
, splitPath
, joinPath
, splitDirectories
, splitDrive
, joinDrive
, takeDrive
, hasDrive
, dropDrive
, isDrive
, hasTrailingPathSeparator
, addTrailingPathSeparator
, dropTrailingPathSeparator
, normalise
, equalFilePath
, makeRelative
, isRelative
, isAbsolute
, isValid
, makeValid
, module SFP
) where

import Control.Applicative ( Applicative )
import Control.Category((.))
import Data.String( String )
import Data.Bool( Bool )
import Data.Maybe ( Maybe )
import qualified System.FilePath.Posix as FP
import System.FilePath.Posix as SFP( FilePath )
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePathT, liftReadFilePath )
import System.FilePath.FilePather.ReadFilePaths
    ( ReadFilePathsT, liftReadFilePaths )

splitExtension ::
  Applicative f =>
  ReadFilePathT e f (String, String)
splitExtension :: forall (f :: * -> *) e.
Applicative f =>
ReadFilePathT e f (String, String)
splitExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> (String, String)
FP.splitExtension
{-# INLINE splitExtension #-}

takeExtension ::
  Applicative f =>
  ReadFilePathT e f String
takeExtension :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeExtension
{-# INLINE takeExtension #-}

replaceExtension ::
  Applicative f =>
  String
  -> ReadFilePathT e f FilePath
replaceExtension :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
replaceExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.replaceExtension
{-# INLINE replaceExtension #-}

dropExtension ::
  Applicative f =>
  ReadFilePathT e f FilePath
dropExtension :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
dropExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.dropExtensions
{-# INLINE dropExtension #-}

addExtension ::
  Applicative f =>
  String
  -> ReadFilePathT e f FilePath
addExtension :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
addExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.addExtension
{-# INLINE addExtension #-}

hasExtension ::
  Applicative f =>
  ReadFilePathT e f Bool
hasExtension :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
hasExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.hasExtension
{-# INLINE hasExtension #-}

splitExtensions ::
  Applicative f =>
  ReadFilePathT e f (FilePath, String)
splitExtensions :: forall (f :: * -> *) e.
Applicative f =>
ReadFilePathT e f (String, String)
splitExtensions =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> (String, String)
FP.splitExtensions
{-# INLINE splitExtensions #-}

dropExtensions ::
  Applicative f =>
  ReadFilePathT e f FilePath
dropExtensions :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
dropExtensions =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.dropExtensions
{-# INLINE dropExtensions #-}

takeExtensions ::
  Applicative f =>
  ReadFilePathT e f String
takeExtensions :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeExtensions =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeExtensions
{-# INLINE takeExtensions #-}

replaceExtensions ::
  Applicative f =>
  String
  -> ReadFilePathT e f FilePath
replaceExtensions :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
replaceExtensions =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.replaceExtensions
{-# INLINE replaceExtensions #-}

isExtensionOf ::
  Applicative f =>
  String
  -> ReadFilePathT e f Bool
isExtensionOf :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f Bool
isExtensionOf =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> Bool
FP.isExtensionOf
{-# INLINE isExtensionOf #-}

stripExtension ::
  Applicative f =>
  String
  -> ReadFilePathT e f (Maybe FilePath)
stripExtension :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f (Maybe String)
stripExtension =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> Maybe String
FP.stripExtension
{-# INLINE stripExtension #-}

splitFileName ::
  Applicative f =>
  ReadFilePathT e f (String, String)
splitFileName :: forall (f :: * -> *) e.
Applicative f =>
ReadFilePathT e f (String, String)
splitFileName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> (String, String)
FP.splitFileName
{-# INLINE splitFileName #-}

takeFileName ::
  Applicative f =>
  ReadFilePathT e f String
takeFileName :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeFileName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeFileName
{-# INLINE takeFileName #-}

replaceFileName ::
  Applicative f =>
  String
  -> ReadFilePathT e f FilePath
replaceFileName :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
replaceFileName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.replaceFileName
{-# INLINE replaceFileName #-}

dropFileName ::
  Applicative f =>
  ReadFilePathT e f FilePath
dropFileName :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
dropFileName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.dropFileName
{-# INLINE dropFileName #-}

takeBaseName ::
  Applicative f =>
  ReadFilePathT e f String
takeBaseName :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeBaseName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeBaseName
{-# INLINE takeBaseName #-}

replaceBaseName ::
  Applicative f =>
  String ->
  ReadFilePathT e f FilePath
replaceBaseName :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
replaceBaseName =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.replaceBaseName
{-# INLINE replaceBaseName #-}

takeDirectory ::
  Applicative f =>
  ReadFilePathT e f FilePath
takeDirectory :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeDirectory =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeDirectory
{-# INLINE takeDirectory #-}

replaceDirectory ::
  Applicative f =>
  String ->
  ReadFilePathT e f FilePath
replaceDirectory :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
replaceDirectory =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.replaceDirectory
{-# INLINE replaceDirectory #-}

combine ::
  Applicative f =>
  FilePath
  ->  ReadFilePathT e f FilePath
combine :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
combine =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.combine
{-# INLINE combine #-}

splitPath ::
  Applicative f =>
  ReadFilePathT e f [FilePath]
splitPath :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f [String]
splitPath =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> [String]
FP.splitPath
{-# INLINE splitPath #-}

joinPath ::
  Applicative f =>
  ReadFilePathsT e f FilePath
joinPath :: forall (f :: * -> *) e. Applicative f => ReadFilePathsT e f String
joinPath =
  forall (f :: * -> *) a e.
Applicative f =>
([String] -> a) -> ReadFilePathsT e f a
liftReadFilePaths [String] -> String
FP.joinPath
{-# INLINE joinPath #-}

splitDirectories ::
  Applicative f =>
  ReadFilePathT e f [FilePath]
splitDirectories :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f [String]
splitDirectories =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> [String]
FP.splitDirectories
{-# INLINE splitDirectories #-}

splitDrive ::
  Applicative f =>
  ReadFilePathT e f (FilePath, FilePath)
splitDrive :: forall (f :: * -> *) e.
Applicative f =>
ReadFilePathT e f (String, String)
splitDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> (String, String)
FP.splitDrive
{-# INLINE splitDrive #-}

joinDrive ::
  Applicative f =>
  FilePath
  -> ReadFilePathT e f FilePath
joinDrive :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
joinDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.joinDrive
{-# INLINE joinDrive #-}

takeDrive ::
  Applicative f =>
  ReadFilePathT e f FilePath
takeDrive :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
takeDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.takeDrive
{-# INLINE takeDrive #-}

hasDrive ::
  Applicative f =>
  ReadFilePathT e f Bool
hasDrive :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
hasDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.hasDrive
{-# INLINE hasDrive #-}

dropDrive ::
  Applicative f =>
  ReadFilePathT e f FilePath
dropDrive :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
dropDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.dropDrive
{-# INLINE dropDrive #-}

isDrive ::
  Applicative f =>
  ReadFilePathT e f Bool
isDrive :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
isDrive =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.isDrive
{-# INLINE isDrive #-}

hasTrailingPathSeparator ::
  Applicative f =>
  ReadFilePathT e f Bool
hasTrailingPathSeparator :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
hasTrailingPathSeparator =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.hasTrailingPathSeparator
{-# INLINE hasTrailingPathSeparator #-}

addTrailingPathSeparator ::
  Applicative f =>
  ReadFilePathT e f FilePath
addTrailingPathSeparator :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
addTrailingPathSeparator =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.addTrailingPathSeparator
{-# INLINE addTrailingPathSeparator #-}

dropTrailingPathSeparator ::
  Applicative f =>
  ReadFilePathT e f FilePath
dropTrailingPathSeparator :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
dropTrailingPathSeparator =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.dropTrailingPathSeparator
{-# INLINE dropTrailingPathSeparator #-}

normalise ::
  Applicative f =>
  ReadFilePathT e f FilePath
normalise :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
normalise =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.normalise
{-# INLINE normalise #-}

equalFilePath ::
  Applicative f =>
  FilePath
  -> ReadFilePathT e f Bool
equalFilePath :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f Bool
equalFilePath =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> Bool
FP.equalFilePath
{-# INLINE equalFilePath #-}

makeRelative ::
  Applicative f =>
  FilePath
  -> ReadFilePathT e f FilePath
makeRelative :: forall (f :: * -> *) e.
Applicative f =>
String -> ReadFilePathT e f String
makeRelative =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> String -> String
FP.makeRelative
{-# INLINE makeRelative #-}

isRelative ::
  Applicative f =>
  ReadFilePathT e f Bool
isRelative :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
isRelative =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.isRelative
{-# INLINE isRelative #-}

isAbsolute ::
  Applicative f =>
  ReadFilePathT e f Bool
isAbsolute :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
isAbsolute =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.isAbsolute
{-# INLINE isAbsolute #-}

isValid ::
  Applicative f =>
  ReadFilePathT e f Bool
isValid :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f Bool
isValid =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> Bool
FP.isValid
{-# INLINE isValid #-}

makeValid ::
  Applicative f =>
  ReadFilePathT e f FilePath
makeValid :: forall (f :: * -> *) e. Applicative f => ReadFilePathT e f String
makeValid =
  forall (f :: * -> *) a e.
Applicative f =>
(String -> a) -> ReadFilePathT e f a
liftReadFilePath String -> String
FP.makeValid
{-# INLINE makeValid #-}