{-# LANGUAGE CPP, ScopedTypeVariables #-}
module System.Plugins.Utils (
Arg,
hWrite,
mkUnique,
hMkUnique,
mkUniqueIn,
hMkUniqueIn,
findFile,
mkTemp, mkTempIn,
replaceSuffix,
outFilePath,
dropSuffix,
mkModid,
changeFileExt,
joinFileExt,
splitFileExt,
isSublistOf,
dirname,
basename,
(</>), (<.>), (<+>), (<>),
newer,
encode,
decode,
EncodedString,
panic
) where
#include "config.h"
import System.Plugins.Env ( isLoaded )
import System.Plugins.Consts ( objSuf, hiSuf, tmpDir )
import Foreign.C (CInt(..), CString, withCString)
import Foreign.C.Error (Errno, eEXIST, getErrno, errnoToIOError)
import System.Posix.Internals
import System.Posix.Types (CMode)
import Control.Exception (IOException, catch)
import Data.Bits
import Data.Char
import Data.List
import Prelude hiding (catch)
import System.IO hiding (openBinaryTempFile, openTempFile)
import System.Random (randomRIO)
import GHC.IO.Encoding (getLocaleEncoding)
import GHC.IO.Handle.FD
import qualified GHC.IO.FD as FD
import System.Environment ( getEnv )
import System.Directory ( doesFileExist, getModificationTime, removeFile )
import System.FilePath (pathSeparator)
type Arg = String
panic :: String -> IO a
panic String
s = IOError -> IO a
forall a. IOError -> IO a
ioError ( String -> IOError
userError String
s )
hWrite :: Handle -> String -> IO ()
hWrite :: Handle -> String -> IO ()
hWrite Handle
hdl String
src = Handle -> String -> IO ()
hPutStr Handle
hdl String
src IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
hdl IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
openTempFile :: FilePath
-> String
-> String
-> IO (FilePath, Handle)
openTempFile :: String -> String -> String -> IO (String, Handle)
openTempFile String
tmp_dir String
pfx String
sfx
= String
-> String
-> String
-> String
-> Bool
-> CMode
-> IO (String, Handle)
openTempFile' String
"openTempFile" String
tmp_dir String
pfx String
sfx Bool
False CMode
0o600
openBinaryTempFile :: FilePath -> String -> String -> IO (FilePath, Handle)
openBinaryTempFile :: String -> String -> String -> IO (String, Handle)
openBinaryTempFile String
tmp_dir String
pfx String
sfx
= String
-> String
-> String
-> String
-> Bool
-> CMode
-> IO (String, Handle)
openTempFile' String
"openBinaryTempFile" String
tmp_dir String
pfx String
sfx Bool
True CMode
0o600
openTempFileWithDefaultPermissions :: FilePath -> String -> String
-> IO (FilePath, Handle)
openTempFileWithDefaultPermissions :: String -> String -> String -> IO (String, Handle)
openTempFileWithDefaultPermissions String
tmp_dir String
pfx String
sfx
= String
-> String
-> String
-> String
-> Bool
-> CMode
-> IO (String, Handle)
openTempFile' String
"openTempFileWithDefaultPermissions" String
tmp_dir String
pfx String
sfx Bool
False CMode
0o666
openBinaryTempFileWithDefaultPermissions :: FilePath -> String -> String
-> IO (FilePath, Handle)
openBinaryTempFileWithDefaultPermissions :: String -> String -> String -> IO (String, Handle)
openBinaryTempFileWithDefaultPermissions String
tmp_dir String
pfx String
sfx
= String
-> String
-> String
-> String
-> Bool
-> CMode
-> IO (String, Handle)
openTempFile' String
"openBinaryTempFileWithDefaultPermissions" String
tmp_dir String
pfx String
sfx Bool
True CMode
0o666
badfnmsg :: String
badfnmsg :: String
badfnmsg = String
"openTempFile': Template string must not contain path separator characters: "
openTempFile' :: String -> FilePath -> String -> String -> Bool -> CMode
-> IO (FilePath, Handle)
openTempFile' :: String
-> String
-> String
-> String
-> Bool
-> CMode
-> IO (String, Handle)
openTempFile' String
loc String
tmp_dir String
pfx String
sfx Bool
binary CMode
mode
| Char
pathSeparator Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
pfx
= String -> IO (String, Handle)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
badfnmsgString -> String -> String
forall a. [a] -> [a] -> [a]
++String
pfx
| Char
pathSeparator Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
sfx
= String -> IO (String, Handle)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
badfnmsgString -> String -> String
forall a. [a] -> [a] -> [a]
++String
sfx
| Bool
otherwise = IO (String, Handle)
findTempName
where
findTempName :: IO (String, Handle)
findTempName = do
String
filename <- String -> String -> String -> IO String
mkTempFileName String
tmp_dir String
pfx String
sfx
OpenNewFileResult
r <- String -> Bool -> CMode -> IO OpenNewFileResult
openNewFile String
filename Bool
binary CMode
mode
case OpenNewFileResult
r of
OpenNewFileResult
FileExists -> IO (String, Handle)
findTempName
OpenNewError Errno
errno -> IOError -> IO (String, Handle)
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
loc Errno
errno Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
tmp_dir))
NewFileCreated CInt
fd -> do
(FD
fD,IODeviceType
fd_type) <- CInt
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD CInt
fd IOMode
ReadWriteMode Maybe (IODeviceType, CDev, CIno)
forall a. Maybe a
Nothing
Bool
False
Bool
True
TextEncoding
enc <- IO TextEncoding
getLocaleEncoding
Handle
h <- FD
-> IODeviceType
-> String
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fD IODeviceType
fd_type String
filename IOMode
ReadWriteMode Bool
False (TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
enc)
(String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
filename, Handle
h)
mkTempFileName :: FilePath -> String -> String -> IO String
mkTempFileName :: String -> String -> String -> IO String
mkTempFileName String
dir String
pfx String
sfx = do
let rs :: String
rs = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum [Char
'0'..Char
'z']
maxInd :: Int
maxInd = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
rchoose :: IO Char
rchoose = do
Int
i <- (Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Int
maxInd)
Char -> IO Char
forall (m :: * -> *) a. Monad m => a -> m a
return (String
rs String -> Int -> Char
forall a. [a] -> Int -> a
!! Int
i)
String
rnd <- [IO Char] -> IO String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO Char] -> IO String) -> [IO Char] -> IO String
forall a b. (a -> b) -> a -> b
$ Int -> IO Char -> [IO Char]
forall a. Int -> a -> [a]
replicate Int
6 IO Char
rchoose
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
pfx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rnd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sfx
data OpenNewFileResult
= NewFileCreated CInt
| FileExists
| OpenNewError Errno
openNewFile :: FilePath -> Bool -> CMode -> IO OpenNewFileResult
openNewFile :: String -> Bool -> CMode -> IO OpenNewFileResult
openNewFile String
filepath Bool
binary CMode
mode = do
let oflags1 :: CInt
oflags1 = CInt
rw_flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_EXCL
binary_flags :: CInt
binary_flags
| Bool
binary = CInt
o_BINARY
| Bool
otherwise = CInt
0
oflags :: CInt
oflags = CInt
oflags1 CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
binary_flags
CInt
fd <- String -> (CString -> IO CInt) -> IO CInt
forall a. String -> (CString -> IO a) -> IO a
withFilePath String
filepath ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
f ->
CString -> CInt -> CMode -> IO CInt
c_open CString
f CInt
oflags CMode
mode
if CInt
fd CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then do
Errno
errno <- IO Errno
getErrno
case Errno
errno of
Errno
_ | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eEXIST -> OpenNewFileResult -> IO OpenNewFileResult
forall (m :: * -> *) a. Monad m => a -> m a
return OpenNewFileResult
FileExists
#ifdef mingw32_HOST_OS
_ | errno == eACCES -> do
withCString filepath $ \path -> do
exists <- c_fileExists path
return $ if exists
then FileExists
else OpenNewError errno
#endif
Errno
_ -> OpenNewFileResult -> IO OpenNewFileResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Errno -> OpenNewFileResult
OpenNewError Errno
errno)
else OpenNewFileResult -> IO OpenNewFileResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> OpenNewFileResult
NewFileCreated CInt
fd)
#ifdef mingw32_HOST_OS
foreign import ccall "file_exists" c_fileExists :: CString -> IO Bool
#endif
std_flags, output_flags, rw_flags :: CInt
std_flags :: CInt
std_flags = CInt
o_NONBLOCK CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_NOCTTY
output_flags :: CInt
output_flags = CInt
std_flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_CREAT
rw_flags :: CInt
rw_flags = CInt
output_flags CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_RDWR
mkTemp :: IO (String,Handle)
mkTemp :: IO (String, Handle)
mkTemp = do String
tmpd <- IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> IO String
getEnv String
"TMPDIR") (\ (IOError
_ :: IOException) -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
tmpDir)
String -> IO (String, Handle)
mkTempIn String
tmpd
mkTempIn :: String -> IO (String, Handle)
mkTempIn :: String -> IO (String, Handle)
mkTempIn String
tmpd = do
(String
tmpf, Handle
hdl) <- String -> String -> String -> IO (String, Handle)
openTempFile String
tmpd String
"Hsplugins" String
".hs"
let modname :: String
modname = String -> String
mkModid String
tmpf
if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') String
modname
then (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
tmpf,Handle
hdl)
else String -> IO (String, Handle)
forall a. String -> IO a
panic (String -> IO (String, Handle)) -> String -> IO (String, Handle)
forall a b. (a -> b) -> a -> b
$ String
"Illegal characters in temp file: `"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
tmpfString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
mkUnique :: IO FilePath
mkUnique :: IO String
mkUnique = do (String
t,Handle
h) <- IO (String, Handle)
hMkUnique
Handle -> IO ()
hClose Handle
h IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
t
hMkUnique :: IO (FilePath,Handle)
hMkUnique :: IO (String, Handle)
hMkUnique = do (String
t,Handle
h) <- IO (String, Handle)
mkTemp
Bool
alreadyLoaded <- String -> IO Bool
isLoaded String
t
if Bool
alreadyLoaded
then Handle -> IO ()
hClose Handle
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removeFile String
t IO () -> IO (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (String, Handle)
hMkUnique
else (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
t,Handle
h)
mkUniqueIn :: FilePath -> IO FilePath
mkUniqueIn :: String -> IO String
mkUniqueIn String
dir = do (String
t,Handle
h) <- String -> IO (String, Handle)
hMkUniqueIn String
dir
Handle -> IO ()
hClose Handle
h IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
t
hMkUniqueIn :: FilePath -> IO (FilePath,Handle)
hMkUniqueIn :: String -> IO (String, Handle)
hMkUniqueIn String
dir = do (String
t,Handle
h) <- String -> IO (String, Handle)
mkTempIn String
dir
Bool
alreadyLoaded <- String -> IO Bool
isLoaded String
t
if Bool
alreadyLoaded
then Handle -> IO ()
hClose Handle
h IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
removeFile String
t IO () -> IO (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO (String, Handle)
hMkUniqueIn String
dir
else (String, Handle) -> IO (String, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
t,Handle
h)
findFile :: [String] -> FilePath -> IO (Maybe FilePath)
findFile :: [String] -> String -> IO (Maybe String)
findFile [] String
_ = Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
findFile (String
ext:[String]
exts) String
file
= do let l :: String
l = String -> String -> String
changeFileExt String
file String
ext
Bool
b <- String -> IO Bool
doesFileExist String
l
if Bool
b then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
l
else [String] -> String -> IO (Maybe String)
findFile [String]
exts String
file
infixr 6 </>
infixr 6 <.>
(</>), (<.>), (<+>) :: FilePath -> FilePath -> FilePath
[] </> :: String -> String -> String
</> String
b = String
b
String
a </> String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
[] <.> :: String -> String -> String
<.> String
b = String
b
String
a <.> String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
[] <+> :: String -> String -> String
<+> String
b = String
b
String
a <+> String
b = String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b
dirname :: FilePath -> FilePath
dirname :: String -> String
dirname String
p =
let x :: [Int]
x = (Char -> Bool) -> String -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') String
p
y :: [Int]
y = (Char -> Bool) -> String -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
p
in
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
x
then if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
y
then if ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
y) then Char -> String -> String
dirname' Char
'\\' String
p else Char -> String -> String
dirname' Char
'/' String
p
else Char -> String -> String
dirname' Char
'\\' String
p
else Char -> String -> String
dirname' Char
'/' String
p
where
dirname' :: Char -> String -> String
dirname' Char
chara String
pa =
case String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
chara) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
pa of
[] -> String
"."
String
pa' -> String
pa'
basename :: FilePath -> FilePath
basename :: String -> String
basename String
p =
let x :: [Int]
x = (Char -> Bool) -> String -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\') String
p
y :: [Int]
y = (Char -> Bool) -> String -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
findIndices (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') String
p
in
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
x
then if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
y
then if ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
y) then Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
basename' Char
'\\' String
p else Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
basename' Char
'/' String
p
else Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
basename' Char
'\\' String
p
else Char -> String -> String
forall a. Eq a => a -> [a] -> [a]
basename' Char
'/' String
p
where
basename' :: a -> [a] -> [a]
basename' a
chara [a]
pa = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
chara) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
pa
dropSuffix :: FilePath -> FilePath
dropSuffix :: String -> String
dropSuffix String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
f
mkModid :: String -> String
mkModid :: String -> String
mkModid = ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
x -> (Char
'/'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
x) Bool -> Bool -> Bool
&& (Char
'\\' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
x))) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
changeFileExt :: FilePath
-> String
-> FilePath
changeFileExt :: String -> String -> String
changeFileExt String
fpath String
ext = String -> String -> String
joinFileExt String
name String
ext
where
(String
name,String
_) = String -> (String, String)
splitFileExt String
fpath
joinFileExt :: String -> String -> FilePath
joinFileExt :: String -> String -> String
joinFileExt String
fpath String
"" = String
fpath
joinFileExt String
fpath String
ext = String
fpath String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
ext
splitFileExt :: FilePath -> (String, String)
splitFileExt :: String -> (String, String)
splitFileExt String
p =
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
fname of
(suf :: String
suf@(Char
_:String
_),Char
_:String
pre) -> (String -> String
forall a. [a] -> [a]
reverse (String
preString -> String -> String
forall a. [a] -> [a] -> [a]
++String
fpath), String -> String
forall a. [a] -> [a]
reverse String
suf)
(String, String)
_ -> (String
p, [])
where
(String
fname,String
fpath) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator (String -> String
forall a. [a] -> [a]
reverse String
p)
isPathSeparator :: Char -> Bool
isPathSeparator :: Char -> Bool
isPathSeparator Char
ch =
#if defined(CYGWIN) || defined(__MINGW32__)
ch == '/' || ch == '\\'
#else
Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/'
#endif
replaceSuffix :: FilePath -> String -> FilePath
replaceSuffix :: String -> String -> String
replaceSuffix [] String
_ = []
replaceSuffix String
f String
suf =
case String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
f of
[] -> String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
String
f' -> String
f' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
tail String
suf
outFilePath :: FilePath -> [Arg] -> (FilePath,FilePath)
outFilePath :: String -> [String] -> (String, String)
outFilePath String
src [String]
args =
let objs :: [String]
objs = [String] -> [String]
find_o [String]
args
paths :: [String]
paths = [String] -> [String]
find_p [String]
args
in case () of { ()
_
| Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
objs)
-> let obj :: String
obj = [String] -> String
forall a. [a] -> a
last [String]
objs in (String
obj, String -> String
mk_hi String
obj)
| Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
paths)
-> let obj :: String
obj = [String] -> String
forall a. [a] -> a
last [String]
paths String -> String -> String
</> String -> String
mk_o (String -> String
basename String
src) in (String
obj, String -> String
mk_hi String
obj)
| Bool
otherwise
-> (String -> String
mk_o String
src, String -> String
mk_hi String
src)
}
where
outpath :: String
outpath = String
"-o"
outdir :: String
outdir = String
"-odir"
mk_hi :: String -> String
mk_hi String
s = String -> String -> String
replaceSuffix String
s String
hiSuf
mk_o :: String -> String
mk_o String
s = String -> String -> String
replaceSuffix String
s String
objSuf
find_o :: [String] -> [String]
find_o [] = []
find_o (String
f:String
f':[String]
fs) | String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
outpath = [String
f']
| Bool
otherwise = [String] -> [String]
find_o ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$! String
f'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
fs
find_o [String]
_ = []
find_p :: [String] -> [String]
find_p [] = []
find_p (String
f:String
f':[String]
fs) | String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
outdir = [String
f']
| Bool
otherwise = [String] -> [String]
find_p ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$! String
f'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
fs
find_p [String]
_ = []
newer :: FilePath -> FilePath -> IO Bool
newer :: String -> String -> IO Bool
newer String
a String
b = do
UTCTime
a_t <- String -> IO UTCTime
getModificationTime String
a
Bool
b_exists <- String -> IO Bool
doesFileExist String
b
if Bool -> Bool
not Bool
b_exists
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do UTCTime
b_t <- String -> IO UTCTime
getModificationTime String
b
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ( UTCTime
a_t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
b_t )
type EncodedString = String
encode :: String -> EncodedString
encode :: String -> String
encode [] = []
encode (Char
c:String
cs) = Char -> String
encode_ch Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
encode String
cs
unencodedChar :: Char -> Bool
unencodedChar :: Char -> Bool
unencodedChar Char
'Z' = Bool
False
unencodedChar Char
'z' = Bool
False
unencodedChar Char
c = Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9'
decode :: EncodedString -> String
decode :: String -> String
decode [] = []
decode (Char
'Z' : Char
d : String
rest) | Char -> Bool
isDigit Char
d = Char -> String -> String
decode_tuple Char
d String
rest
| Bool
otherwise = Char -> Char
decode_upper Char
d Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decode String
rest
decode (Char
'z' : Char
d : String
rest) | Char -> Bool
isDigit Char
d = Char -> String -> String
decode_num_esc Char
d String
rest
| Bool
otherwise = Char -> Char
decode_lower Char
d Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decode String
rest
decode (Char
c : String
rest) = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decode String
rest
decode_upper, decode_lower :: Char -> Char
decode_upper :: Char -> Char
decode_upper Char
'L' = Char
'('
decode_upper Char
'R' = Char
')'
decode_upper Char
'M' = Char
'['
decode_upper Char
'N' = Char
']'
decode_upper Char
'C' = Char
':'
decode_upper Char
'Z' = Char
'Z'
decode_upper Char
ch = String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"decode_upper can't handle this char `"String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
ch]String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
decode_lower :: Char -> Char
decode_lower Char
'z' = Char
'z'
decode_lower Char
'a' = Char
'&'
decode_lower Char
'b' = Char
'|'
decode_lower Char
'c' = Char
'^'
decode_lower Char
'd' = Char
'$'
decode_lower Char
'e' = Char
'='
decode_lower Char
'g' = Char
'>'
decode_lower Char
'h' = Char
'#'
decode_lower Char
'i' = Char
'.'
decode_lower Char
'l' = Char
'<'
decode_lower Char
'm' = Char
'-'
decode_lower Char
'n' = Char
'!'
decode_lower Char
'p' = Char
'+'
decode_lower Char
'q' = Char
'\''
decode_lower Char
'r' = Char
'\\'
decode_lower Char
's' = Char
'/'
decode_lower Char
't' = Char
'*'
decode_lower Char
'u' = Char
'_'
decode_lower Char
'v' = Char
'%'
decode_lower Char
ch = String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"decode_lower can't handle this char `"String -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
ch]String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
decode_num_esc :: Char -> [Char] -> String
decode_num_esc :: Char -> String -> String
decode_num_esc Char
d String
cs
= Int -> String -> String
go (Char -> Int
digitToInt Char
d) String
cs
where
go :: Int -> String -> String
go Int
n (Char
c : String
rest) | Char -> Bool
isDigit Char
c = Int -> String -> String
go (Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) String
rest
go Int
n (Char
'U' : String
rest) = Int -> Char
chr Int
n Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
decode String
rest
go Int
_ String
other = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"decode_num_esc can't handle this: \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
otherString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\""
encode_ch :: Char -> EncodedString
encode_ch :: Char -> String
encode_ch Char
c | Char -> Bool
unencodedChar Char
c = [Char
c]
encode_ch Char
'(' = String
"ZL"
encode_ch Char
')' = String
"ZR"
encode_ch Char
'[' = String
"ZM"
encode_ch Char
']' = String
"ZN"
encode_ch Char
':' = String
"ZC"
encode_ch Char
'Z' = String
"ZZ"
encode_ch Char
'z' = String
"zz"
encode_ch Char
'&' = String
"za"
encode_ch Char
'|' = String
"zb"
encode_ch Char
'^' = String
"zc"
encode_ch Char
'$' = String
"zd"
encode_ch Char
'=' = String
"ze"
encode_ch Char
'>' = String
"zg"
encode_ch Char
'#' = String
"zh"
encode_ch Char
'.' = String
"zi"
encode_ch Char
'<' = String
"zl"
encode_ch Char
'-' = String
"zm"
encode_ch Char
'!' = String
"zn"
encode_ch Char
'+' = String
"zp"
encode_ch Char
'\'' = String
"zq"
encode_ch Char
'\\' = String
"zr"
encode_ch Char
'/' = String
"zs"
encode_ch Char
'*' = String
"zt"
encode_ch Char
'_' = String
"zu"
encode_ch Char
'%' = String
"zv"
encode_ch Char
c = Char
'z' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String -> String
forall a. Show a => a -> String -> String
shows (Char -> Int
ord Char
c) String
"U"
decode_tuple :: Char -> EncodedString -> String
decode_tuple :: Char -> String -> String
decode_tuple Char
d String
cs
= Int -> String -> String
go (Char -> Int
digitToInt Char
d) String
cs
where
go :: Int -> String -> String
go Int
n (Char
c : String
rest) | Char -> Bool
isDigit Char
c = Int -> String -> String
go (Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
c) String
rest
go Int
0 [Char
'T'] = String
"()"
go Int
n [Char
'T'] = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
go Int
1 [Char
'H'] = String
"(# #)"
go Int
n [Char
'H'] = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'#' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Char
',' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"#)"
go Int
_ String
other = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"decode_tuple \'"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
otherString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'"
isSublistOf :: Eq a => [a] -> [a] -> Bool
isSublistOf :: [a] -> [a] -> Bool
isSublistOf [] [a]
_ = Bool
True
isSublistOf [a]
_ [] = Bool
False
isSublistOf [a]
x y :: [a]
y@(a
_:[a]
ys)
| [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
x [a]
y = Bool
True
| Bool
otherwise = [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSublistOf [a]
x [a]
ys