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