{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ScopedTypeVariables #-}
#if !(defined(mingw32_HOST_OS) || defined(mingw32_TARGET_OS) || defined(__MINGW32__))
#define __HSH_POSIX__
#else
#define __HSH_WINDOWS__
#endif
module HSH.ShellEquivs(
abspath,
appendTo,
basename,
bracketCD,
catFrom,
catBytes,
catBytesFrom,
catTo,
#ifdef __HSH_POSIX__
catToFIFO,
#endif
cd,
cut,
cutR,
dirname,
discard,
echo,
exit,
glob,
grep,
grepV,
egrep,
egrepV,
joinLines,
lower,
upper,
mkdir,
numberLines,
pwd,
#ifdef __HSH_POSIX__
readlink,
readlinkabs,
#endif
rev,
revW,
HSH.Command.setenv,
space,
unspace,
tac,
tee,
#ifdef __HSH_POSIX__
teeFIFO,
#endif
tr,
trd,
wcW,
wcL,
HSH.Command.unsetenv,
uniq,
) where
import Data.List (genericLength, intersperse, isInfixOf, nub)
import Data.Char (toLower, toUpper)
import Text.Regex (matchRegex, mkRegex)
import Text.Printf (printf)
import Control.Monad (foldM)
import System.Directory hiding (createDirectory, isSymbolicLink)
import qualified Control.Exception as E
#ifdef __HSH_POSIX__
import System.Posix.Files (getFileStatus, isSymbolicLink, readSymbolicLink)
import System.Posix.User (getEffectiveUserName, getUserEntryForName, homeDirectory)
import System.Posix.Directory (createDirectory)
import System.Posix.Types (FileMode())
import System.Posix.IO
import System.Posix.Error
#endif
import System.Path (absNormPath, bracketCWD)
import System.Exit
import System.IO
import System.Process
import qualified System.Directory as SD
import qualified System.Path.Glob as Glob (glob)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS
import System.IO.Unsafe(unsafeInterleaveIO)
import HSH.Channel
import HSH.Command(setenv, unsetenv)
abspath :: FilePath -> IO FilePath
abspath :: FilePath -> IO FilePath
abspath FilePath
inp =
do FilePath
p <- IO FilePath
pwd
case FilePath -> FilePath -> Maybe FilePath
absNormPath FilePath
p FilePath
inp of
Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot make " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
inp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" absolute within " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
p
Just FilePath
x -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
basename :: FilePath -> FilePath
basename :: FilePath -> FilePath
basename = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitpath
dirname :: FilePath -> FilePath
dirname :: FilePath -> FilePath
dirname = (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)
splitpath
bracketCD :: FilePath -> IO a -> IO a
bracketCD :: FilePath -> IO a -> IO a
bracketCD = FilePath -> IO a -> IO a
forall a. FilePath -> IO a -> IO a
bracketCWD
catFrom :: [FilePath] -> Channel -> IO Channel
catFrom :: [FilePath] -> Channel -> IO Channel
catFrom [FilePath]
fplist Channel
ichan =
do ByteString
r <- (ByteString -> FilePath -> IO ByteString)
-> ByteString -> [FilePath] -> IO ByteString
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ByteString -> FilePath -> IO ByteString
foldfunc ByteString
BSL.empty [FilePath]
fplist
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Channel
forall a. Channelizable a => a -> Channel
toChannel ByteString
r)
where foldfunc :: ByteString -> FilePath -> IO ByteString
foldfunc ByteString
accum FilePath
fp =
case FilePath
fp of
FilePath
"-" -> do ByteString
c <- Channel -> IO ByteString
chanAsBSL Channel
ichan
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BSL.append ByteString
accum ByteString
c)
FilePath
fn -> do ByteString
c <- FilePath -> IO ByteString
BSL.readFile FilePath
fn
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BSL.append ByteString
accum ByteString
c)
catBytes :: (Maybe Integer)
-> Channel
-> IO Channel
catBytes :: Maybe Integer -> Channel -> IO Channel
catBytes Maybe Integer
count Channel
hr = Channel -> Maybe Integer -> Channel -> IO Channel
catBytesFrom Channel
hr Maybe Integer
count Channel
hr
catBytesFrom :: Channel
-> (Maybe Integer)
-> Channel
-> IO Channel
catBytesFrom :: Channel -> Maybe Integer -> Channel -> IO Channel
catBytesFrom (ChanHandle Handle
hr) Maybe Integer
count Channel
cignore =
case Maybe Integer
count of
Maybe Integer
Nothing -> Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Channel
ChanHandle Handle
hr)
Just Integer
m -> do ByteString
c <- Handle -> Int -> IO ByteString
BSL.hGet Handle
hr (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m)
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Channel
ChanBSL ByteString
c)
catBytesFrom Channel
cinput Maybe Integer
count Channel
cignore =
case Maybe Integer
count of
Maybe Integer
Nothing -> Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return Channel
cinput
Just Integer
m -> do ByteString
r <- Channel -> IO ByteString
chanAsBSL Channel
cinput
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Channel
ChanBSL (Int64 -> ByteString -> ByteString
BSL.take (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) ByteString
r))
catTo :: FilePath -> Channel -> IO Channel
catTo :: FilePath -> Channel -> IO Channel
catTo FilePath
fp Channel
ichan =
do Handle
ofile <- FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode
Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
True Channel
ichan Handle
ofile
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Channel
ChanString FilePath
"")
#ifdef __HSH_POSIX__
catToFIFO :: FilePath -> Channel -> IO Channel
catToFIFO :: FilePath -> Channel -> IO Channel
catToFIFO FilePath
fp Channel
ichan =
do Handle
h <- FilePath -> IO Handle
fifoOpen FilePath
fp
Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
True Channel
ichan Handle
h
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Channel
ChanString FilePath
"")
fifoOpen :: FilePath -> IO Handle
fifoOpen :: FilePath -> IO Handle
fifoOpen FilePath
fp =
do Fd
fd <- (Fd -> Bool) -> FilePath -> FilePath -> IO Fd -> IO Fd
forall a. (a -> Bool) -> FilePath -> FilePath -> IO a -> IO a
throwErrnoPathIf (Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
< Fd
0) FilePath
"HSH fifoOpen" FilePath
fp (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$
FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd FilePath
fp OpenMode
WriteOnly Maybe FileMode
forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
Fd -> IO Handle
fdToHandle Fd
fd
#endif
appendTo :: FilePath -> String -> IO String
appendTo :: FilePath -> FilePath -> IO FilePath
appendTo FilePath
fp FilePath
inp =
do FilePath -> FilePath -> IO ()
appendFile FilePath
fp FilePath
inp
FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
""
cd :: FilePath -> IO ()
cd :: FilePath -> IO ()
cd = FilePath -> IO ()
setCurrentDirectory
cut :: Integer -> Char -> String -> String
cut :: Integer -> Char -> FilePath -> FilePath
cut Integer
pos = [Integer] -> Char -> FilePath -> FilePath
cutR [Integer
pos]
discard :: Channel -> IO Channel
discard :: Channel -> IO Channel
discard Channel
inh =
do ByteString
c <- Channel -> IO ByteString
chanAsBSL Channel
inh
Int64 -> IO Int64
forall a. a -> IO a
E.evaluate (ByteString -> Int64
BSL.length ByteString
c)
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Channel
ChanString FilePath
"")
cutR :: [Integer] -> Char -> String -> String
cutR :: [Integer] -> Char -> FilePath -> FilePath
cutR [Integer]
nums Char
delim FilePath
z = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Char
delimChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
x | (FilePath
x, Integer
y) <- [FilePath] -> [Integer] -> [(FilePath, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
string [Integer
0..], Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Integer
y [Integer]
nums]
where string :: [FilePath]
string = Char -> FilePath -> [FilePath]
split Char
delim FilePath
z
echo :: Channelizable a => a -> Channel -> IO Channel
echo :: a -> Channel -> IO Channel
echo a
inp Channel
_ = Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel -> IO Channel) -> (a -> Channel) -> a -> IO Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Channel
forall a. Channelizable a => a -> Channel
toChannel (a -> IO Channel) -> a -> IO Channel
forall a b. (a -> b) -> a -> b
$ a
inp
egrep :: String -> [String] -> [String]
egrep :: FilePath -> [FilePath] -> [FilePath]
egrep FilePath
pat = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Regex -> FilePath -> Bool
ismatch Regex
regex)
where regex :: Regex
regex = FilePath -> Regex
mkRegex FilePath
pat
ismatch :: Regex -> FilePath -> Bool
ismatch Regex
r FilePath
inp = case Regex -> FilePath -> Maybe [FilePath]
matchRegex Regex
r FilePath
inp of
Maybe [FilePath]
Nothing -> Bool
False
Just [FilePath]
_ -> Bool
True
egrepV :: String -> [String] -> [String]
egrepV :: FilePath -> [FilePath] -> [FilePath]
egrepV FilePath
pat = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> FilePath -> Bool
ismatch Regex
regex)
where regex :: Regex
regex = FilePath -> Regex
mkRegex FilePath
pat
ismatch :: Regex -> FilePath -> Bool
ismatch Regex
r FilePath
inp = case Regex -> FilePath -> Maybe [FilePath]
matchRegex Regex
r FilePath
inp of
Maybe [FilePath]
Nothing -> Bool
False
Just [FilePath]
_ -> Bool
True
exit :: Int -> IO a
exit :: Int -> IO a
exit Int
code
| Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
| Bool
otherwise = ExitCode -> IO a
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
code)
glob :: FilePath -> IO [FilePath]
glob :: FilePath -> IO [FilePath]
glob inp :: FilePath
inp@(Char
'~':FilePath
remainder) =
IO [FilePath] -> (SomeException -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch IO [FilePath]
expanduser (\(SomeException
e::E.SomeException) -> FilePath -> IO [FilePath]
Glob.glob FilePath
rest)
where (FilePath
username, FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') FilePath
remainder
#ifdef __HSH_POSIX__
expanduser :: IO [FilePath]
expanduser =
do FilePath
lookupuser <-
if FilePath
username FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
""
then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
username
else IO FilePath
getEffectiveUserName
UserEntry
ue <- FilePath -> IO UserEntry
getUserEntryForName FilePath
lookupuser
FilePath -> IO [FilePath]
Glob.glob (UserEntry -> FilePath
homeDirectory UserEntry
ue FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
rest)
#else
expanduser = fail "non-posix; will be caught above"
#endif
glob FilePath
x = FilePath -> IO [FilePath]
Glob.glob FilePath
x
grep :: String -> [String] -> [String]
grep :: FilePath -> [FilePath] -> [FilePath]
grep = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> Bool) -> [FilePath] -> [FilePath])
-> (FilePath -> FilePath -> Bool)
-> FilePath
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf
grepV :: String -> [String] -> [String]
grepV :: FilePath -> [FilePath] -> [FilePath]
grepV FilePath
needle = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf FilePath
needle)
joinLines :: [String] -> [String]
joinLines :: [FilePath] -> [FilePath]
joinLines = FilePath -> [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
#ifdef __HSH_POSIX__
mkdir :: FilePath -> FileMode -> IO ()
mkdir :: FilePath -> FileMode -> IO ()
mkdir = FilePath -> FileMode -> IO ()
createDirectory
#else
mkdir :: FilePath -> a -> IO ()
mkdir fp _ = SD.createDirectory fp
#endif
numberLines :: [String] -> [String]
numberLines :: [FilePath] -> [FilePath]
numberLines = (Int -> FilePath -> FilePath) -> [Int] -> [FilePath] -> [FilePath]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (FilePath -> Int -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%3d %s") [(Int
1::Int)..]
pwd :: IO FilePath
pwd :: IO FilePath
pwd = IO FilePath
getCurrentDirectory
#ifdef __HSH_POSIX__
readlink :: FilePath -> IO FilePath
readlink :: FilePath -> IO FilePath
readlink FilePath
fp =
do Bool
issym <- (FilePath -> IO FileStatus
getFileStatus FilePath
fp IO FileStatus -> (FileStatus -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (FileStatus -> Bool) -> FileStatus -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
isSymbolicLink)
if Bool
issym
then FilePath -> IO FilePath
readSymbolicLink FilePath
fp
else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp
readlinkabs :: FilePath -> IO FilePath
readlinkabs :: FilePath -> IO FilePath
readlinkabs FilePath
inp =
do Bool
issym <- (FilePath -> IO FileStatus
getFileStatus FilePath
inp IO FileStatus -> (FileStatus -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (FileStatus -> Bool) -> FileStatus -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> Bool
isSymbolicLink)
if Bool
issym
then do FilePath
rl <- FilePath -> IO FilePath
readlink FilePath
inp
case FilePath -> FilePath -> Maybe FilePath
absNormPath (FilePath -> FilePath
dirname FilePath
inp) FilePath
rl of
Maybe FilePath
Nothing -> FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot make " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
rl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" absolute within " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> FilePath
dirname FilePath
inp)
Just FilePath
x -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
x
else FilePath -> IO FilePath
abspath FilePath
inp
#endif
rev, revW :: [String] -> [String]
rev :: [FilePath] -> [FilePath]
rev = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
forall a. [a] -> [a]
reverse
revW :: [FilePath] -> [FilePath]
revW = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ([FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words)
tac :: [String] -> [String]
tac :: [FilePath] -> [FilePath]
tac = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse
tee :: [FilePath] -> Channel -> IO Channel
tee :: [FilePath] -> Channel -> IO Channel
tee [FilePath]
fplist Channel
inp = (FilePath -> IO Handle) -> [FilePath] -> Channel -> IO Channel
teeBSGeneric (\FilePath
fp -> FilePath -> IOMode -> IO Handle
openFile FilePath
fp IOMode
WriteMode) [FilePath]
fplist Channel
inp
#ifdef __HSH_POSIX__
teeFIFO :: [FilePath] -> Channel -> IO Channel
teeFIFO :: [FilePath] -> Channel -> IO Channel
teeFIFO [FilePath]
fplist Channel
inp = (FilePath -> IO Handle) -> [FilePath] -> Channel -> IO Channel
teeBSGeneric FilePath -> IO Handle
fifoOpen [FilePath]
fplist Channel
inp
#endif
teeBSGeneric :: (FilePath -> IO Handle)
-> [FilePath]
-> Channel -> IO Channel
teeBSGeneric :: (FilePath -> IO Handle) -> [FilePath] -> Channel -> IO Channel
teeBSGeneric FilePath -> IO Handle
openfunc [FilePath]
fplist Channel
ichan =
do [Handle]
handles <- (FilePath -> IO Handle) -> [FilePath] -> IO [Handle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO Handle
openfunc [FilePath]
fplist
ByteString
inp <- Channel -> IO ByteString
chanAsBSL Channel
ichan
[ByteString]
resultChunks <- [Handle] -> [ByteString] -> IO [ByteString]
hProcChunks [Handle]
handles (ByteString -> [ByteString]
BSL.toChunks ByteString
inp)
Channel -> IO Channel
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Channel
ChanBSL (ByteString -> Channel) -> ByteString -> Channel
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BSL.fromChunks [ByteString]
resultChunks)
where hProcChunks :: [Handle] -> [BS.ByteString] -> IO [BS.ByteString]
hProcChunks :: [Handle] -> [ByteString] -> IO [ByteString]
hProcChunks [Handle]
handles [ByteString]
chunks = IO [ByteString] -> IO [ByteString]
forall a. IO a -> IO a
unsafeInterleaveIO (IO [ByteString] -> IO [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$
case [ByteString]
chunks of
[] -> do (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
hClose [Handle]
handles
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString
BS.empty]
(ByteString
x:[ByteString]
xs) -> do (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Handle
h -> Handle -> ByteString -> IO ()
BS.hPutStr Handle
h ByteString
x) [Handle]
handles
[ByteString]
remainder <- [Handle] -> [ByteString] -> IO [ByteString]
hProcChunks [Handle]
handles [ByteString]
xs
[ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
remainder)
tr :: Char -> Char -> String -> String
tr :: Char -> Char -> FilePath -> FilePath
tr Char
a Char
b = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a then Char
b else Char
x)
trd :: Char -> String -> String
trd :: Char -> FilePath -> FilePath
trd = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> FilePath -> FilePath)
-> (Char -> Char -> Bool) -> Char -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
uniq :: String -> String
uniq :: FilePath -> FilePath
uniq = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
space :: [String] -> [String]
space :: [FilePath] -> [FilePath]
space = FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
""
unspace :: [String] -> [String]
unspace :: [FilePath] -> [FilePath]
unspace = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
lower :: String -> String
lower :: FilePath -> FilePath
lower = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
upper :: String -> String
upper :: FilePath -> FilePath
upper = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
wcL :: [String] -> [String]
wcL :: [FilePath] -> [FilePath]
wcL [FilePath]
inp = [Integer -> FilePath
forall a. Show a => a -> FilePath
show ([FilePath] -> Integer
forall i a. Num i => [a] -> i
genericLength [FilePath]
inp :: Integer)]
wcW :: [String] -> [String]
wcW :: [FilePath] -> [FilePath]
wcW [FilePath]
inp = [Integer -> FilePath
forall a. Show a => a -> FilePath
show (([FilePath] -> Integer
forall i a. Num i => [a] -> i
genericLength ([FilePath] -> Integer) -> [FilePath] -> Integer
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
inp) :: Integer)]
split :: Char -> String -> [String]
split :: Char -> FilePath -> [FilePath]
split Char
c FilePath
s = case FilePath
rest of
[] -> [FilePath
chunk]
Char
_:FilePath
rst -> FilePath
chunk FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Char -> FilePath -> [FilePath]
split Char
c FilePath
rst
where (FilePath
chunk, FilePath
rest) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) FilePath
s
splitpath :: String -> (String, String)
splitpath :: FilePath -> (FilePath, FilePath)
splitpath FilePath
"" = (FilePath
".", FilePath
".")
splitpath FilePath
"/" = (FilePath
"/", FilePath
"/")
splitpath FilePath
p
| FilePath -> Char
forall a. [a] -> a
last FilePath
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = FilePath -> (FilePath, FilePath)
splitpath (FilePath -> FilePath
forall a. [a] -> [a]
init FilePath
p)
| Bool -> Bool
not (Char
'/' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
p) = (FilePath
".", FilePath
p)
| FilePath -> Char
forall a. [a] -> a
head FilePath
p Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
&& FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
p) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (FilePath
"/", FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
p)
| Bool
otherwise = (\(FilePath
base, FilePath
dir) -> (FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath
forall a. [a] -> [a]
tail FilePath
dir), FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
base))
((Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
p))