-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/HsShellScript/Misc.chs" #-}
-- #hide
module HsShellScript.Misc where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp



import Control.Exception
import Control.Monad
import Data.Bits
import Data.Typeable
import Foreign
import Foreign.C
import Foreign.C.Error
import Foreign.C.String
import Foreign.Ptr
import GHC.IO hiding (finally, bracket)
import GHC.IO.Exception
import HsShellScript.ProcErr
import Prelude hiding (catch)
import System.Directory
import System.IO
import System.IO.Error hiding (catch)
import System.Posix hiding (removeDirectory)
import System.Random



-- | Format an @Int@ with leading zeros. If the string representation of the @Inŧ@ is longer than the number of
-- characters to fill up, this produces as many characters as needed.
zeros :: Int            -- ^ How many characters to fill up
      -> Int            -- ^ Value to represent as a string
      -> String         -- ^ String representation of the value, using the specified number of characters
zeros :: Int -> Int -> String
zeros Int
stellen Int
z =
   let txt :: String
txt  = Int -> String
forall a. Show a => a -> String
show Int
z
       auff :: Int
auff = Int
stellen Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt
       n :: String
n    = Int -> String -> String
forall a. Int -> [a] -> [a]
take (if Int
auff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
auff else Int
0) (Char -> String
forall a. a -> [a]
repeat Char
'0')
   in  String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
txt


-- |
-- Remove trailing newlines. This is silimar to perl's @chomp@ procedure.
chomp :: String         -- ^ String to be chomped
      -> String         -- ^ Same string, except for no newline characters at the end
chomp :: String -> String
chomp String
"" = String
""
chomp String
"\n" = String
""
chomp [Char
x] = [Char
x]
chomp (Char
x:String
xs) = let xs' :: String
xs' = String -> String
chomp String
xs
               in  if String
xs' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then String
"" else Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs'


{- | Get contents of a file or of @stdin@. This is a simple frontend to @hGetContents@. A file name of @\"-\"@
designates stdin. The contents are read lazily as the string is evaluated.

(The handle which we read from will be in semi-closed state. Once all input has read, it is closed automatically
(Haskell Library Report 11.2.1). Therefore we don't need to return it).

>lazy_contents path = do
>    h   <- if path == "-" then return stdin else openFile path ReadMode
>    hGetContents h
-}
lazy_contents :: String                 -- ^ Either the name of a file, or @\"-\"@
              -> IO String              -- ^ The lazily read contents of the file or @stdin@.
lazy_contents :: String -> IO String
lazy_contents String
path = do
    Handle
h <- if String
path String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-" then Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
stdin else String -> IOMode -> IO Handle
openFile String
path IOMode
ReadMode
    Handle -> IO String
hGetContents Handle
h


-- | Get contents of a file or of @stdin@ eagerly. This is the same as @lazy_contents@, except for the contents
-- being read immediately.

contents :: String              -- ^ either the name of a file, or @\"-\"@ for @stdin@
         -> IO String           -- ^ the contents of the file or of standard input
contents :: String -> IO String
contents String
pfad = do
    String
txt <- String -> IO String
lazy_contents String
pfad
    Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
txt


-- | Test for the existence of a path. This is the disjunction of @Directory.doesDirectoryExist@ and
-- @Directory.doesFileExist@. For an dangling symlink, this will return @False@.
path_exists :: String    -- ^ Path
            -> IO Bool   -- ^ Whether the path exists in the file system
path_exists :: String -> IO Bool
path_exists String
pfad = do
    Bool
de <- String -> IO Bool
doesDirectoryExist String
pfad
    Bool
fe <- String -> IO Bool
doesFileExist String
pfad
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
de Bool -> Bool -> Bool
|| Bool
fe)


-- | Test for the existence of a path. This uses @System.Posix.Files.getFileStatus@ to determine whether the path
-- exists in any form in the file system. For a dangling symlink, the result is @True@.
path_exists' :: String    -- ^ Path
             -> IO Bool   -- ^ Whether the path exists in the file system
path_exists' :: String -> IO Bool
path_exists' String
path =
   IO Bool -> (IOException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (do String -> IO FileStatus
getSymbolicLinkStatus String
path
             Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
         (\(IOException
ioe :: IOError) -> 
             if IOException -> Bool
isDoesNotExistError IOException
ioe then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                                        else IOException -> IO Bool
forall a. IOException -> IO a
ioError IOException
ioe)
             

-- | Test if path points to a directory. This will return @True@ for a symlink pointing to a directory. It's a
-- shortcut for @Directory.doesDirectoryExist@.
is_dir :: String        -- ^ Path
       -> IO Bool       -- ^ Whether the path exists and points to a directory.
is_dir :: String -> IO Bool
is_dir = String -> IO Bool
doesDirectoryExist


-- |
-- Test if path points to a file. This is a shortcut for
-- @Directory.doesFileExist@.
is_file :: String       -- ^ Path
        -> IO Bool      -- ^ Whether the path exists and points to a file.
is_file :: String -> IO Bool
is_file = String -> IO Bool
doesFileExist


-- | This is the @System.Posix.Files.getFileStatus@ function from the GHC libraries, with improved error reporting.
-- The GHC function doesn't include the file name in the @IOError@ when the call fails, making error messages much
-- less useful. @getFileStatus\'@ rectifies this.
--
-- See 'System.Posix.Files.getFileStatus'.
getFileStatus' :: FilePath              -- ^ Path of the file, whose status is to be queried
               -> IO FileStatus         -- ^ Status of the file
getFileStatus' :: String -> IO FileStatus
getFileStatus' String
path =
   String -> IO FileStatus
getFileStatus String
path
      IO FileStatus -> (IOException -> IO FileStatus) -> IO FileStatus
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOException
ioe -> IOException -> IO FileStatus
forall a. IOException -> IO a
ioError (IOException
ioe { ioe_filename :: Maybe String
ioe_filename = String -> Maybe String
forall a. a -> Maybe a
Just String
path }))


-- | This is the @System.Posix.Files.fileAccess@ function from the GHC libraries, with improved error reporting.
-- The GHC function doesn't include the file name in the @IOError@ when the call fails, making error messages much
-- less useful. @fileAccess\'@ rectifies this.
--
-- See 'System.Posix.Files.fileAccess'.
fileAccess' :: FilePath -> Bool -> Bool -> Bool -> IO Bool
fileAccess' :: String -> Bool -> Bool -> Bool -> IO Bool
fileAccess' String
p Bool
b Bool
c Bool
d =
   String -> Bool -> Bool -> Bool -> IO Bool
fileAccess String
p Bool
b Bool
c Bool
d
      IO Bool -> (IOException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOException
ioe -> IOException -> IO Bool
forall a. IOException -> IO a
ioError (IOException
ioe { ioe_filename :: Maybe String
ioe_filename = String -> Maybe String
forall a. a -> Maybe a
Just String
p }))


-- | Create a temporary file. This will create a new, empty file, with a path which did not previously exist in the
-- file system. The path consists of the specified prefix, a sequence of random characters (digits and letters),
-- and the specified suffix. The file is created with read-write permissions for the user, and no permissons for
-- the group and others. The ownership is set to the effective user ID of the process. The group ownership is set
-- either to the effective group ID of the process or to the group ID of the parent directory (depending on
-- filesystem type and mount options on Linux - see @open(2)@ for details).
--
-- See 'tmp_file', 'temp_dir', 'with_temp_file'.
temp_file :: Int                        -- ^ Number of random characters to intersperse. Must be large enough,
                                        -- such that most combinations can't already
                                        -- exist.
          -> String                     -- ^ Prefix for the path to generate.
          -> String                     -- ^ Suffix for the path to generate.
          -> IO FilePath                -- ^ Path of the created file.
temp_file :: Int -> String -> String -> IO String
temp_file Int
nr String
prefix String
suffix = do
   (CInt
fd, String
path) <- IO (CInt, String)
-> ((CInt, String) -> IO Bool) -> IO (CInt, String)
forall {m :: * -> *} {b}. Monad m => m b -> (b -> m Bool) -> m b
untilIO (do String
path <- Int -> String -> String -> IO String
temp_path Int
nr String
prefix String
suffix
                             CInt
fd <- String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cpath ->
                                Ptr CChar -> CInt -> CUInt -> IO CInt
hsshellscript_open_nonvariadic Ptr CChar
cpath (CInt
o_CREAT CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
o_EXCL) CUInt
0o600
                             (CInt, String) -> IO (CInt, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
fd, String
path)
                         )
                         (\(CInt
fd, String
path) ->
                             if CInt
fd CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1 then do Errno
errno <- IO Errno
getErrno
                                                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eEXIST) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                                                    String -> Maybe Handle -> Maybe String -> IO ()
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"temp_file" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
                                                 Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                                         else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                         )
   CInt
res <- CInt -> IO CInt
c_close CInt
fd
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Handle -> Maybe String -> IO ()
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"temp_file" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
   String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path

-- | Create a temporary directory. This will create a new directory, with a path which did not previously exist in
-- the file system. The path consists of the specified prefix, a sequence of random characters (digits and
-- letters), and the specified suffix. The directory is normally created with read-write-execute permissions for
-- the user, and no permissons for the group and others. But this may be further restricted by the process's umask
-- in the usual way.
--
-- The newly created directory will be owned by the effective uid of the process. If the directory containing the
-- it has the set group id bit set, or if the filesystem is mounted with BSD group semantics, the new directory
-- will inherit the group ownership from its parent; otherwise it will be owned by the effective gid of the
-- process. (See @mkdir(2)@)
--
-- See 'tmp_dir', 'temp_file', 'with_temp_dir'.
temp_dir :: Int                        -- ^ Number of random characters to intersperse. Must be large enough,
                                       -- such that most combinations can't already exist.
         -> String                     -- ^ Prefix for the path to generate.
         -> String                     -- ^ Suffix for the path to generate.
         -> IO FilePath                -- ^ Generated path.
temp_dir :: Int -> String -> String -> IO String
temp_dir Int
nr String
prefix String
suffix = do
   (CInt
_, String
path) <- IO (CInt, String)
-> ((CInt, String) -> IO Bool) -> IO (CInt, String)
forall {m :: * -> *} {b}. Monad m => m b -> (b -> m Bool) -> m b
untilIO (do String
path <- Int -> String -> String -> IO String
temp_path Int
nr String
prefix String
suffix
                            CInt
ret <- String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cpath -> Ptr CChar -> CUInt -> IO CInt
c_mkdir Ptr CChar
cpath CUInt
0o700
                            (CInt, String) -> IO (CInt, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
ret, String
path)
                        )
                        (\(CInt
ret, String
path) ->
                            if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1 then do Errno
errno <- IO Errno
getErrno
                                                 Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
/= Errno
eEXIST) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                                                    String -> Maybe Handle -> Maybe String -> IO ()
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"temp_dir" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
                                                 Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                                         else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        )
   String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
path

-- | Create a temporary file. This will create a new, empty file, with read-write permissions for the user, and no
-- permissons for the group and others. The path consists of the specified prefix, a dot, and six random characters
-- (digits and letters).
--
-- @tmp_file prefix = temp_file 6 (prefix ++ \".\") \"\"@
--
-- See 'temp_file', 'tmp_dir', 'with_tmp_file'.
tmp_file :: String                     -- ^ Prefix for the path to generate.
         -> IO FilePath                -- ^ Path of the created file.
tmp_file :: String -> IO String
tmp_file String
prefix = Int -> String -> String -> IO String
temp_file Int
6 (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String
""


-- | Create a temporary directory. This will create a new directory, with read-write-execute permissions for the
-- user (unless further restricted by the process's umask), and no permissons for the group and others. The path
-- consists of the specified prefix, a dot, and six random characters (digits and letters).
--
-- @tmp_dir prefix = temp_dir 6 (prefix ++ \".\") \"\"@
--
-- See 'temp_dir', 'tmp_file', 'with_tmp_dir'.
tmp_dir :: String                     -- ^ Prefix for the path to generate.
        -> IO FilePath                -- ^ Path of the created directory.
tmp_dir :: String -> IO String
tmp_dir String
prefix = Int -> String -> String -> IO String
temp_dir Int
6 (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String
""


-- | Create and open a temporary file, perform some action with it, and delete it afterwards. This is a front end
-- to the 'temp_file' function. The file and its path are created in the same way. The IO action is passed a handle
-- of the new file. When it finishes - normally or with an exception - the file is deleted.
--
-- See 'temp_file', 'with_tmp_file', 'with_temp_dir'.
with_temp_file :: Int                        -- ^ Number of random characters to intersperse. Must be large enough,
                                             -- such that most combinations can't
                                             -- already exist.
               -> String                     -- ^ Prefix for the path to generate.
               -> String                     -- ^ Suffix for the path to generate.
               -> (Handle -> IO a)           -- ^ Action to perform.
               -> IO a                       -- ^ Returns the value returned by the action.
with_temp_file :: forall a. Int -> String -> String -> (Handle -> IO a) -> IO a
with_temp_file Int
nr String
prefix String
suffix Handle -> IO a
io =
   IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do String
path <- Int -> String -> String -> IO String
temp_file Int
nr String
prefix String
suffix
               Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
ReadWriteMode
               (String, Handle) -> IO (String, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
path, Handle
h)
           )
           (\(String
path,Handle
h) -> do
               Handle -> IO ()
hClose Handle
h
               String -> IO ()
removeFile String
path
           )
           (\(String
path,Handle
h) ->
               Handle -> IO a
io Handle
h
           )



-- | Create a temporary directory, perform some action with it, and delete it afterwards. This is a front end to
-- the 'temp_dir' function. The directory and its path are created in the same way. The IO action is passed the
-- path of the new directory. When it finishes - normally or with an exception - the directory is deleted.
--
-- The action must clean up any files it creates inside the directory by itself. @with_temp_dir@ doesn't delete any
-- files inside, so the directory could be removed. If the directory isn't empty, an @IOError@ results (with the
-- path filled in). When the action throws an exception, and the temporary directory cannot be removed, then the
-- exception is passed through, rather than replacing it with the IOError. (This is because it's probably exactly
-- because of that exception that the directory isn't empty and can't be removed).
--
-- See 'temp_dir', 'with_tmp_dir', 'with_temp_file'.
with_temp_dir :: Int                        -- ^ Number of random characters to intersperse. Must be large enough,
                                            --   such that most combinations can't already exist.
              -> String                     -- ^ Prefix for the path to generate.
              -> String                     -- ^ Suffix for the path to generate.
              -> (FilePath -> IO a)         -- ^ Action to perform.
              -> IO a                       -- ^ Returns the value returned by the action.
with_temp_dir :: forall a. Int -> String -> String -> (String -> IO a) -> IO a
with_temp_dir Int
nr String
prefix String
suffix String -> IO a
io = 
   do  String
path <- Int -> String -> String -> IO String
temp_dir Int
nr String
prefix String
suffix
       a
a <- IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> IO a
io String
path)
                  (\SomeException
e -> do String -> IO ()
remove String
path IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
e::SomeException) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                            SomeException -> IO a
forall a e. Exception e => e -> a
throw (SomeException
e :: SomeException)
                  )
       String -> IO ()
remove String
path
       a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
   where
      remove :: String -> IO ()
remove String
path = String -> IO ()
removeDirectory String
path
                    IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOException
ioe -> IOException -> IO ()
forall a. IOException -> IO a
ioError (IOException
ioe { ioe_filename :: Maybe String
ioe_filename = String -> Maybe String
forall a. a -> Maybe a
Just String
path }))


-- | Create and open a temporary file, perform some action with it, and delete it afterwards. This is a front end
-- to the 'tmp_file' function. The file and its path are created in the same way. The IO action is passed a handle
-- of the new file. When it finishes - normally or with an exception - the file is deleted.
--
-- See 'tmp_file', 'with_temp_file', 'with_tmp_dir'.
with_tmp_file :: String                     -- ^ Prefix for the path to generate.
              -> (Handle -> IO a)           -- ^ Action to perform.
              -> IO a                       -- ^ Returns the value returned by the action.
with_tmp_file :: forall a. String -> (Handle -> IO a) -> IO a
with_tmp_file String
prefix Handle -> IO a
io =
   IO (String, Handle)
-> ((String, Handle) -> IO ())
-> ((String, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do String
path <- String -> IO String
tmp_file String
prefix
               Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
ReadWriteMode
               (String, Handle) -> IO (String, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
path, Handle
h)
           )
           (\(String
path,Handle
h) -> do
               Handle -> IO ()
hClose Handle
h
               String -> IO ()
removeFile String
path
           )
           (\(String
path,Handle
h) -> do
               a
e <- Handle -> IO a
io Handle
h
               a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e
          )

-- | Create a temporary directory, perform some action with it, and delete it afterwards. This is a front end to
-- the 'tmp_dir' function. The directory and its path are created in the same way. The IO action is passed the path
-- of the new directory. When it finishes - normally or with an exception - the directory is deleted.
--
-- The action must clean up any files it creates inside the directory by itself. @with_temp_dir@ doesn't delete any
-- files inside, so the directory could be removed. If the directory isn't empty, an @IOError@ results (with the
-- path filled in). When the action throws an exception, and the temporary directory cannot be removed, then the
-- exception is passed through, rather than replacing it with the IOError. (This is because it's probably exactly
-- because of that exception that the directory isn't empty and can't be removed).
--
-- >with_tmp_dir prefix io = with_temp_dir 6 (prefix ++ ".") "" io
--
-- See 'tmp_dir', 'with_temp_dir', 'with_tmp_file'.
with_tmp_dir :: String                     -- ^ Prefix for the path to generate.
             -> (FilePath -> IO a)         -- ^ Action to perform.
             -> IO a                       -- ^ Returns the value returned by the action.
with_tmp_dir :: forall a. String -> (String -> IO a) -> IO a
with_tmp_dir String
prefix String -> IO a
io = Int -> String -> String -> (String -> IO a) -> IO a
forall a. Int -> String -> String -> (String -> IO a) -> IO a
with_temp_dir Int
6 (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") String
"" String -> IO a
io


-- | Create a temporary path. This will generate a path which does not yet exist in the file system. It consists of
-- the specified prefix, a sequence of random characters (digits and letters), and the specified suffix.
--
-- /Avoid relying on the generated path not to exist in the file system./ Or else you'll get a potential race
-- condition, since some other process might create the path after @temp_path@, before you use it. This is a
-- security risk. The global random number generator (@Random.randomRIO@) is used to generate the random
-- characters. These might not be that random after all, and could potentially be guessed. Rather use @temp_file@
-- or @temp_dir@.
--
-- See 'temp_file', 'temp_dir'.
temp_path :: Int                        -- ^ Number of random characters to intersperse. Must be large enough,
                                        -- such that most combinations can't already exist.
          -> String                     -- ^ Prefix for the path to generate.
          -> String                     -- ^ Suffix for the path to generate.
          -> IO FilePath                -- ^ Generated path.
temp_path :: Int -> String -> String -> IO String
temp_path Int
nr String
prefix String
suffix = do
   IO String -> (String -> IO Bool) -> IO String
forall {m :: * -> *} {b}. Monad m => m b -> (b -> m Bool) -> m b
untilIO (do String
rand <- [IO Char] -> IO String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Int -> [IO Char] -> [IO Char]
forall a. Int -> [a] -> [a]
take Int
nr (IO Char -> [IO Char]
forall a. a -> [a]
repeat ((Int -> Char) -> IO Int -> IO Char
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Char
char ((Int, Int) -> IO Int
forall a. Random a => (a, a) -> IO a
randomRIO (Int
0, Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))))
               String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rand String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix)
           )
           (\String
path -> (Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (String -> IO Bool
path_exists' String
path))

   where char :: Int -> Char
char Int
nr = String
"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
nr


-- Execute action until condition is met.
untilIO :: m b -> (b -> m Bool) -> m b
untilIO m b
io b -> m Bool
cond = do
   b
res <- m b
io
   Bool
u <- b -> m Bool
cond b
res
   if Bool
u then b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
        else m b -> (b -> m Bool) -> m b
untilIO m b
io b -> m Bool
cond


{- | One entry of mount information. This is the same as @struct mntent@ from @\<mntent.h\>@. A list of these is
returned by the functions which read mount information.

See 'read_mounts', 'read_mtab', 'read_fstab'.
-}
data Mntent = Mntent { Mntent -> String
mnt_fsname :: String        -- ^ Device file (\"name of mounted file system\")
                     , Mntent -> String
mnt_dir :: String           -- ^ Mount point
                     , Mntent -> String
mnt_type :: String          -- ^ Which kind of file system (\"see mntent.h\")
                     , Mntent -> String
mnt_opts :: String          -- ^ Mount options (\"see mntent.h\")
                     , Mntent -> Int
mnt_freq :: Int             -- ^ Dump frequency in days
                     , Mntent -> Int
mnt_passno :: Int           -- ^ \"Pass number on parallel fsck\"
                     }
   deriving (ReadPrec [Mntent]
ReadPrec Mntent
Int -> ReadS Mntent
ReadS [Mntent]
(Int -> ReadS Mntent)
-> ReadS [Mntent]
-> ReadPrec Mntent
-> ReadPrec [Mntent]
-> Read Mntent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Mntent
readsPrec :: Int -> ReadS Mntent
$creadList :: ReadS [Mntent]
readList :: ReadS [Mntent]
$creadPrec :: ReadPrec Mntent
readPrec :: ReadPrec Mntent
$creadListPrec :: ReadPrec [Mntent]
readListPrec :: ReadPrec [Mntent]
Read, Int -> Mntent -> String -> String
[Mntent] -> String -> String
Mntent -> String
(Int -> Mntent -> String -> String)
-> (Mntent -> String)
-> ([Mntent] -> String -> String)
-> Show Mntent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Mntent -> String -> String
showsPrec :: Int -> Mntent -> String -> String
$cshow :: Mntent -> String
show :: Mntent -> String
$cshowList :: [Mntent] -> String -> String
showList :: [Mntent] -> String -> String
Show, Typeable, Mntent -> Mntent -> Bool
(Mntent -> Mntent -> Bool)
-> (Mntent -> Mntent -> Bool) -> Eq Mntent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mntent -> Mntent -> Bool
== :: Mntent -> Mntent -> Bool
$c/= :: Mntent -> Mntent -> Bool
/= :: Mntent -> Mntent -> Bool
Eq)

{- | Read mount information. This is a front end to the @setmntent(3)@, @getmntent(3)@, @endmntent(3)@ system
library functions.

When the @setmntent@ call fails, the @errno@ value is converted to an @IOError@ and thrown.

See 'read_mtab', 'read_fstab'.
-}
read_mounts :: String                           -- ^ File to read (typically @\/etc\/mtab@ or @\/etc\/fstab@)
            -> IO [Mntent]                      -- ^ Mount information in that file
read_mounts :: String -> IO [Mntent]
read_mounts String
path = do
   Ptr ()
h <- String -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path ((Ptr CChar -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cpath ->
      String -> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
"r" ((Ptr CChar -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr CChar -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
r ->
         Ptr CChar -> Ptr CChar -> IO (Ptr ())
setmntent Ptr CChar
cpath Ptr CChar
r
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
h Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> Maybe Handle -> Maybe String -> IO ()
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"setmntent(3) in read_mounts" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
   [Mntent]
mntent <- Ptr () -> [Mntent] -> IO [Mntent]
getmntent Ptr ()
h []
   Ptr () -> IO CInt
endmntent Ptr ()
h
   [Mntent] -> IO [Mntent]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Mntent]
mntent

   where
      getmntent :: Ptr () -> [Mntent] -> IO [Mntent]
getmntent Ptr ()
h [Mntent]
l = do
         Ptr ()
ptr <- Ptr () -> IO (Ptr ())
c_getmntent Ptr ()
h
         if (Ptr ()
ptr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr) then [Mntent] -> IO [Mntent]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Mntent]
l
                             else do String
mnt_fsname_str <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr ()
ptr IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
                                     String
mnt_dir_str <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
8 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr ()
ptr IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
                                     String
mnt_type_str <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
16 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr ()
ptr IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
                                     String
mnt_opts_str <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
24 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) Ptr ()
ptr IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
                                     Int
mnt_freq_int <- (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
32 :: IO C2HSImp.CInt}) Ptr ()
ptr
                                     Int
mnt_passno_int <- (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a. Enum a => a -> Int
fromEnum (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ (\Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
36 :: IO C2HSImp.CInt}) Ptr ()
ptr
                                     Ptr () -> [Mntent] -> IO [Mntent]
getmntent Ptr ()
h ([Mntent]
l [Mntent] -> [Mntent] -> [Mntent]
forall a. [a] -> [a] -> [a]
++ [Mntent { mnt_fsname :: String
mnt_fsname = String
mnt_fsname_str
                                                               , mnt_dir :: String
mnt_dir = String
mnt_dir_str
                                                               , mnt_type :: String
mnt_type = String
mnt_type_str
                                                               , mnt_opts :: String
mnt_opts = String
mnt_opts_str
                                                               , mnt_freq :: Int
mnt_freq = Int
mnt_freq_int
                                                               , mnt_passno :: Int
mnt_passno = Int
mnt_passno_int
                                                               }])

{- | Get the currently mounted file systems.

>read_mtab = read_mounts "/etc/mtab"

See 'read_mounts'.
-}
read_mtab :: IO [Mntent]
read_mtab :: IO [Mntent]
read_mtab = String -> IO [Mntent]
read_mounts String
"/etc/mtab"


{- | Get the system wide file system table.

>read_fstab = read_mounts "/etc/fstab"

See 'read_mounts'.
-}
read_fstab :: IO [Mntent]
read_fstab :: IO [Mntent]
read_fstab = String -> IO [Mntent]
read_mounts String
"/etc/fstab"


-- Taken from the source code of the GHC 6 libraries (in System.Posix.Internals). It isn't exported from there.
-- "HsBase.h" belongs to the files which are visible to users of GHC, but it isn't documented. The comment at the
-- beginning says "Definitions for package `base' which are visible in Haskell land.".
foreign import ccall unsafe "HsBase.h __hscore_o_creat"  o_CREAT  :: CInt
foreign import ccall unsafe "HsBase.h __hscore_o_excl"   o_EXCL   :: CInt



-- | This is an interface to the POSIX @glob@ function, which does wildcard expansion
-- in paths. The sorted list of matched paths is returned. It's empty
-- for no match (rather than the original pattern). In case anything goes wrong
-- (such as permission denied), an IOError is thrown.
--
-- This does /not/ do tilde expansion, which is done (among many unwanted other
-- things) by @wordexp@. The only flag used for the call to @glob@ is @GLOB_ERR@.
--
-- The behaviour in case of non-existing path components is inconsistent in the
-- GNU version of the underlying @glob@ function. @glob "\/doesnt_exist\/foo"@ will return
-- the empty list, whereas @glob "\/doesnt_exist\/*"@ causes a "No such file or directory"
-- IOError.
--
-- Note that it isn't clear if dangling symlinks are matched by glob. From the
-- web: "Compared to other glob implementation (*BSD, bash, musl, and other
-- shells as well), GLIBC seems the be the only one that does not match dangling
-- symlinks. ... POSIX does not have any strict specification for dangling
-- symlinks". 
--
-- You will have to work around this problem, probably using
-- System.Directory.getDirectoryContents. 
-- 
-- See man pages @glob(3)@ and @wordexp(3)@.
glob :: String                  -- ^ Pattern
     -> IO [String]             -- ^ Sorted list of matching paths
glob :: String -> IO [String]
glob String
pattern = do
   String -> (Ptr CChar -> IO [String]) -> IO [String]
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
pattern ((Ptr CChar -> IO [String]) -> IO [String])
-> (Ptr CChar -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
pattern_ptr ->
      Int -> (Ptr () -> IO [String]) -> IO [String]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
72 ((Ptr () -> IO [String]) -> IO [String])
-> (Ptr () -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr ()
buf_ptr ->
         do CInt
res <- Ptr () -> Ptr CChar -> IO CInt
do_glob Ptr ()
buf_ptr Ptr CChar
pattern_ptr
            case CInt
res of
               CInt
0 -> -- success
                    do Ptr (Ptr CChar)
pptr <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr (Ptr CChar))
forall b. Ptr b -> Int -> IO (Ptr (Ptr CChar))
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
8 :: IO (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))}) Ptr ()
buf_ptr
                       Int
len <- Ptr CChar -> Ptr (Ptr CChar) -> IO Int
forall a. (Storable a, Eq a) => a -> Ptr a -> IO Int
lengthArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
pptr
                       [Ptr CChar]
cstrs <- Int -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len Ptr (Ptr CChar)
pptr
                       (Ptr CChar -> IO String) -> [Ptr CChar] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO String
peekCString [Ptr CChar]
cstrs
               CInt
1 -> -- GLOB_ABORTED
                    String -> Maybe Handle -> Maybe String -> IO [String]
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"glob" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
pattern)
               CInt
2 -> -- GLOB_NOSPACE
                    IOException -> IO [String]
forall a. IOException -> IO a
ioError (IOException -> String -> IOException
ioeSetErrorString (IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
ResourceExhausted String
"glob" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
pattern))
                                               String
"Out of memory")
               CInt
3 -> -- GLOB_NOMATCH
                    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
         IO [String] -> IO () -> IO [String]
forall a b. IO a -> IO b -> IO a
`finally`
            (do Ptr (Ptr CChar)
pptr <- (\Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr (Ptr CChar))
forall b. Ptr b -> Int -> IO (Ptr (Ptr CChar))
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr Int
8 :: IO (C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar))}) Ptr ()
buf_ptr
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr (Ptr CChar)
pptr Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr (Ptr CChar)
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                   Ptr () -> IO ()
globfree Ptr ()
buf_ptr
            )


-- |
-- Quote special characters for use with the @glob@ function.
--
-- The characters @*@, @?@, @[@ and @\\@ must be quoted by preceding
-- backslashs, when they souldn't have their special meaning. The @glob_quote@
-- function does this.
-- 
-- You can't use @quote@ or @shell_quote@.
--
-- See 'glob', 'HsShellScript.Shell.quote', 'HsShellScript.Shell.shell_quote'
glob_quote :: String
           -> String
glob_quote :: String -> String
glob_quote String
path = 
   case String
path of
      []          -> []
      (Char
'*':String
rest)  -> (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'*'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
glob_quote String
rest)
      (Char
'?':String
rest)  -> (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'?'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
glob_quote String
rest)
      (Char
'[':String
rest)  -> (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'['Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
glob_quote String
rest)
      (Char
'\\':String
rest) -> (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
glob_quote String
rest)
      (Char
ch:String
rest)   -> Char
ch Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
glob_quote String
rest




foreign import ccall safe "HsShellScript/Misc.chs.h hsshellscript_open_nonvariadic"
  hsshellscript_open_nonvariadic :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "HsShellScript/Misc.chs.h close"
  c_close :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "HsShellScript/Misc.chs.h mkdir"
  c_mkdir :: ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "HsShellScript/Misc.chs.h setmntent"
  setmntent :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "HsShellScript/Misc.chs.h endmntent"
  endmntent :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "HsShellScript/Misc.chs.h getmntent"
  c_getmntent :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "HsShellScript/Misc.chs.h do_glob"
  do_glob :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "HsShellScript/Misc.chs.h globfree"
  globfree :: ((C2HSImp.Ptr ()) -> (IO ()))