    {-# LANGUAGE ScopedTypeVariables, CPP #-}
    {-# OPTIONS_GHC -fno-warn-duplicate-exports #-}

    -- | More IO functions. The functions include ones for reading files with specific encodings,
    --   strictly reading files, and writing files with encodings. There are also some simple
    --   temporary file functions, more advanced alternatives can be found in
    --   the <https://hackage.haskell.org/package/exceptions exceptions> package.
    module System.IO.Extra(
        module System.IO,
        captureOutput,
        withBuffering,
        -- * Read encoding
        readFileEncoding, readFileUTF8, readFileBinary,
        -- * Strict reading
        readFile', readFileEncoding', readFileUTF8', readFileBinary',
        -- * Write with encoding
        writeFileEncoding, writeFileUTF8, writeFileBinary,
        -- * Temporary files
        withTempFile, withTempDir, newTempFile, newTempDir,
        newTempFileWithin, newTempDirWithin,
        -- * File comparison
        fileEq,
        ) where

    import System.IO
    import Control.Concurrent.Extra
    import Control.Monad.Extra
    import Control.Exception.Extra as E
    import GHC.IO.Handle(hDuplicate,hDuplicateTo)
    import System.Directory.Extra
    import System.IO.Error
    import System.IO.Unsafe
    import System.FilePath
    import Data.Char
    import Data.Time.Clock
    import Data.Tuple.Extra
    import Data.IORef
    import Foreign.Ptr
    import Foreign.Marshal.Alloc
    import Foreign.C.Types
    import Data.Functor
    import Prelude

    -- File reading

    -- | Like 'readFile', but setting an encoding.
    readFileEncoding :: TextEncoding -> FilePath -> IO String
    readFileEncoding :: TextEncoding -> FilePath -> IO FilePath
    readFileEncoding TextEncoding
    enc FilePath
    file = do
        h <- FilePath -> IOMode -> IO Handle
    openFile FilePath
    file IOMode
    ReadMode
        hSetEncoding h enc
        hGetContents h

    -- | Like 'readFile', but with the encoding 'utf8'.
    readFileUTF8 :: FilePath -> IO String
    readFileUTF8 :: FilePath -> IO FilePath
    readFileUTF8 = TextEncoding -> FilePath -> IO FilePath
    readFileEncoding TextEncoding
    utf8

    -- | Like 'readFile', but for binary files.
    readFileBinary :: FilePath -> IO String
    readFileBinary :: FilePath -> IO FilePath
    readFileBinary FilePath
    file = do
        h <- FilePath -> IOMode -> IO Handle
    openBinaryFile FilePath
    file IOMode
    ReadMode
        hGetContents h

    -- Strict file reading

    #if __GLASGOW_HASKELL__ < 811
    -- readFile' and hGetContents' were added in GHC 9.0

    -- | A strict version of 'hGetContents'.
    hGetContents' :: Handle -> IO String
    hGetContents' h = do
        s <- hGetContents h
        void $ evaluate $ length s
        pure s

    -- | A strict version of 'readFile'. When the string is produced, the entire
    --   file will have been read into memory and the file handle will have been closed.
    --   Closing the file handle does not rely on the garbage collector.
    --
    -- > \(filter isHexDigit -> s) -> fmap (== s) $ withTempFile $ \file -> do writeFile file s; readFile' file
    readFile' :: FilePath -> IO String
    readFile' file = withFile file ReadMode hGetContents'

    #endif

    -- | A strict version of 'readFileEncoding', see 'readFile'' for details.
    readFileEncoding' :: TextEncoding -> FilePath -> IO String
    readFileEncoding' :: TextEncoding -> FilePath -> IO FilePath
    readFileEncoding' TextEncoding
    e FilePath
    file = FilePath -> IOMode -> (Handle -> IO FilePath) -> IO FilePath
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    file IOMode
    ReadMode ((Handle -> IO FilePath) -> IO FilePath)
    -> (Handle -> IO FilePath) -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    e IO () -> IO FilePath -> IO FilePath
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Handle -> IO FilePath
    hGetContents' Handle
    h

    -- | A strict version of 'readFileUTF8', see 'readFile'' for details.
    readFileUTF8' :: FilePath -> IO String
    readFileUTF8' :: FilePath -> IO FilePath
    readFileUTF8' = TextEncoding -> FilePath -> IO FilePath
    readFileEncoding' TextEncoding
    utf8

    -- | A strict version of 'readFileBinary', see 'readFile'' for details.
    readFileBinary' :: FilePath -> IO String
    readFileBinary' :: FilePath -> IO FilePath
    readFileBinary' FilePath
    file = FilePath -> IOMode -> (Handle -> IO FilePath) -> IO FilePath
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile FilePath
    file IOMode
    ReadMode Handle -> IO FilePath
    hGetContents'

    -- File writing

    -- | Write a file with a particular encoding.
    writeFileEncoding :: TextEncoding -> FilePath -> String -> IO ()
    writeFileEncoding :: TextEncoding -> FilePath -> FilePath -> IO ()
    writeFileEncoding TextEncoding
    enc FilePath
    file FilePath
    x = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    file IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    enc
        Handle -> FilePath -> IO ()
    hPutStr Handle
    h FilePath
    x

    -- | Write a file with the 'utf8' encoding.
    --
    -- > \s -> withTempFile $ \file -> do writeFileUTF8 file s; fmap (== s) $ readFileUTF8' file
    writeFileUTF8 :: FilePath -> String -> IO ()
    writeFileUTF8 :: FilePath -> FilePath -> IO ()
    writeFileUTF8 = TextEncoding -> FilePath -> FilePath -> IO ()
    writeFileEncoding TextEncoding
    utf8

    -- | Write a binary file.
    --
    -- > \(ASCIIString s) -> withTempFile $ \file -> do writeFileBinary file s; fmap (== s) $ readFileBinary' file
    writeFileBinary :: FilePath -> String -> IO ()
    writeFileBinary :: FilePath -> FilePath -> IO ()
    writeFileBinary FilePath
    file FilePath
    x = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile FilePath
    file IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> Handle -> FilePath -> IO ()
    hPutStr Handle
    h FilePath
    x

    -- Console

    -- | Capture the 'stdout' and 'stderr' of a computation.
    --
    -- > captureOutput (print 1) == pure ("1\n",())
    captureOutput :: IO a -> IO (String, a)
    captureOutput :: forall a. IO a -> IO (FilePath, a)
    captureOutput IO a
    act = (FilePath -> IO (FilePath, a)) -> IO (FilePath, a)
    forall a. (FilePath -> IO a) -> IO a
    withTempFile ((FilePath -> IO (FilePath, a)) -> IO (FilePath, a))
    -> (FilePath -> IO (FilePath, a)) -> IO (FilePath, a)
    forall a b. (a -> b) -> a -> b
    $ \FilePath
    file ->
        FilePath
    -> IOMode -> (Handle -> IO (FilePath, a)) -> IO (FilePath, a)
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withFile FilePath
    file IOMode
    ReadWriteMode ((Handle -> IO (FilePath, a)) -> IO (FilePath, a))
    -> (Handle -> IO (FilePath, a)) -> IO (FilePath, a)
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
            res <- Handle -> Handle -> IO a -> IO a
    forall {b}. Handle -> Handle -> IO b -> IO b
    clone Handle
    stdout Handle
    h (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ Handle -> Handle -> IO a -> IO a
    forall {b}. Handle -> Handle -> IO b -> IO b
    clone Handle
    stderr Handle
    h (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
                Handle -> IO ()
    hClose Handle
    h
                IO a
    act
            out <- readFile' file
            pure (out, res)
        where
            clone :: Handle -> Handle -> IO b -> IO b
    clone Handle
    out Handle
    h IO b
    act = do
                buf <- Handle -> IO BufferMode
    hGetBuffering Handle
    out
                out2 <- hDuplicate out
                hDuplicateTo h out
                act `finally` do
                    hDuplicateTo out2 out
                    hClose out2
                    hSetBuffering out buf

    -- | Execute an action with a custom 'BufferMode', a wrapper around
    --   'hSetBuffering'.
    withBuffering :: Handle -> BufferMode -> IO a -> IO a
    withBuffering :: forall a. Handle -> BufferMode -> IO a -> IO a
    withBuffering Handle
    h BufferMode
    m IO a
    act = IO BufferMode
    -> (BufferMode -> IO ()) -> (BufferMode -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Handle -> IO BufferMode
    hGetBuffering Handle
    h) (Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    h) ((BufferMode -> IO a) -> IO a) -> (BufferMode -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ IO a -> BufferMode -> IO a
    forall a b. a -> b -> a
    const (IO a -> BufferMode -> IO a) -> IO a -> BufferMode -> IO a
    forall a b. (a -> b) -> a -> b
    $ do
        Handle -> BufferMode -> IO ()
    hSetBuffering Handle
    h BufferMode
    m
        IO a
    act

    ---------------------------------------------------------------------
    -- TEMPORARY FILE
    -- We don't use GHC's temp file code, because its buggy, see:
    -- https://ghc.haskell.org/trac/ghc/ticket/10731

    {-# NOINLINE tempRef #-}
    tempRef :: IORef Int
    tempRef :: IORef Int
    tempRef = IO (IORef Int) -> IORef Int
    forall a. IO a -> a
    unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
    forall a b. (a -> b) -> a -> b
    $ do
        rand :: Integer <- (UTCTime -> Integer) -> IO UTCTime -> IO Integer
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FilePath -> Integer
    forall a. Read a => FilePath -> a
    read (FilePath -> Integer)
    -> (UTCTime -> FilePath) -> UTCTime -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> FilePath
    forall a. [a] -> [a]
    reverse (FilePath -> FilePath)
    -> (UTCTime -> FilePath) -> UTCTime -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> FilePath -> FilePath
    forall a. (a -> Bool) -> [a] -> [a]
    filter Char -> Bool
    isDigit (FilePath -> FilePath)
    -> (UTCTime -> FilePath) -> UTCTime -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DiffTime -> FilePath
    forall a. Show a => a -> FilePath
    show (DiffTime -> FilePath)
    -> (UTCTime -> DiffTime) -> UTCTime -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> DiffTime
    utctDayTime) IO UTCTime
    getCurrentTime
        newIORef $ fromIntegral rand

    tempUnique :: IO Int
    tempUnique :: IO Int
    tempUnique = IORef Int -> (Int -> (Int, Int)) -> IO Int
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Int
    tempRef ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Int
    forall a. Enum a => a -> a
    succ (Int -> Int) -> (Int -> Int) -> Int -> (Int, Int)
    forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
    &&& Int -> Int
    forall a. Enum a => a -> a
    succ

    -- | Provide a function to create a temporary file, and a way to delete a
    --   temporary file. Most users should use 'withTempFile' which
    --   combines these operations.
    newTempFile :: IO (FilePath, IO ())
    newTempFile :: IO (FilePath, IO ())
    newTempFile = FilePath -> IO (FilePath, IO ())
    newTempFileWithin (FilePath -> IO (FilePath, IO ()))
    -> IO FilePath -> IO (FilePath, IO ())
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO FilePath
    getTemporaryDirectory

    -- | Like 'newTempFile' but using a custom temporary directory.
    newTempFileWithin :: FilePath -> IO (FilePath, IO ())
    newTempFileWithin :: FilePath -> IO (FilePath, IO ())
    newTempFileWithin FilePath
    tmpdir = do
            file <- IO FilePath
    create
            del <- once $ ignore $ removeFile file
            pure (file, del)
        where
            create :: IO FilePath
    create = do
                val <- IO Int
    tempUnique
                (file, h) <- retryBool (\(IOError
    _ :: IOError) -> Bool
    True) 5 $ openTempFile tmpdir $ "extra-file-" ++ show val ++ "-"
                hClose h
                pure file

    -- | Create a temporary file in the temporary directory. The file will be deleted
    --   after the action completes (provided the file is not still open).
    --   The 'FilePath' will not have any file extension, will exist, and will be zero bytes long.
    --   If you require a file with a specific name, use 'withTempDir'.
    --
    -- > withTempFile doesFileExist == pure True
    -- > (doesFileExist =<< withTempFile pure) == pure False
    -- > withTempFile readFile' == pure ""
    withTempFile :: (FilePath -> IO a) -> IO a
    withTempFile :: forall a. (FilePath -> IO a) -> IO a
    withTempFile FilePath -> IO a
    act = do
        (file, del) <- IO (FilePath, IO ())
    newTempFile
        act file `finally` del

    -- | Provide a function to create a temporary directory, and a way to delete a
    --   temporary directory. Most users should use 'withTempDir' which
    --   combines these operations.
    newTempDir :: IO (FilePath, IO ())
    newTempDir :: IO (FilePath, IO ())
    newTempDir = FilePath -> IO (FilePath, IO ())
    newTempDirWithin (FilePath -> IO (FilePath, IO ()))
    -> IO FilePath -> IO (FilePath, IO ())
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO FilePath
    getTemporaryDirectory

    -- | Like 'newTempDir' but using a custom temporary directory.
    newTempDirWithin :: FilePath -> IO (FilePath, IO ())
    newTempDirWithin :: FilePath -> IO (FilePath, IO ())
    newTempDirWithin FilePath
    tmpdir = do
            dir <- (IOError -> Bool) -> Int -> IO FilePath -> IO FilePath
    forall e a. Exception e => (e -> Bool) -> Int -> IO a -> IO a
    retryBool (\(IOError
    _ :: IOError) -> Bool
    True) Int
    5 (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    create FilePath
    tmpdir
            del <- once $ ignore $ removeDirectoryRecursive dir
            pure (dir, del)
        where
            create :: FilePath -> IO FilePath
    create FilePath
    tmpdir = do
                v <- IO Int
    tempUnique
                let dir = FilePath
    tmpdir FilePath -> FilePath -> FilePath
    </> FilePath
    "extra-dir-" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    v
                catchBool isAlreadyExistsError
                    (createDirectoryPrivate dir >> pure dir) $
                    \IOError
    _ -> FilePath -> IO FilePath
    create FilePath
    tmpdir

    -- | Create a temporary directory inside the system temporary directory.
    --   The directory will be deleted after the action completes.
    --
    -- > withTempDir doesDirectoryExist == pure True
    -- > (doesDirectoryExist =<< withTempDir pure) == pure False
    -- > withTempDir listFiles == pure []
    withTempDir :: (FilePath -> IO a) -> IO a
    withTempDir :: forall a. (FilePath -> IO a) -> IO a
    withTempDir FilePath -> IO a
    act = do
        (dir,del) <- IO (FilePath, IO ())
    newTempDir
        act dir `finally` del

    -- | Returns 'True' when both files have the same size.
    sameSize :: Handle -> Handle -> IO Bool
    sameSize :: Handle -> Handle -> IO Bool
    sameSize Handle
    h1 Handle
    h2 = (Integer -> Integer -> Bool) -> IO Integer -> IO Integer -> IO Bool
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Handle -> IO Integer
    hFileSize Handle
    h1) (Handle -> IO Integer
    hFileSize Handle
    h2)

    foreign import ccall unsafe "string.h memcmp" memcmp
        :: Ptr CUChar -> Ptr CUChar -> CSize -> IO CInt

    -- | Returns 'True' when the contents of both files is the same.
    sameContent :: Handle -> Handle -> IO Bool
    sameContent :: Handle -> Handle -> IO Bool
    sameContent Handle
    h1 Handle
    h2 = Handle -> Handle -> IO Bool
    sameSize Handle
    h1 Handle
    h2 IO Bool -> IO Bool -> IO Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    &&^ (Ptr CUChar -> IO Bool) -> IO Bool
    forall {a} {b}. (Ptr a -> IO b) -> IO b
    withb (\Ptr CUChar
    b1 -> (Ptr CUChar -> IO Bool) -> IO Bool
    forall {a} {b}. (Ptr a -> IO b) -> IO b
    withb ((Ptr CUChar -> IO Bool) -> IO Bool)
    -> (Ptr CUChar -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr CUChar
    b2 -> Ptr CUChar -> Ptr CUChar -> IO Bool
    eq Ptr CUChar
    b1 Ptr CUChar
    b2)
        where eq :: Ptr CUChar -> Ptr CUChar -> IO Bool
    eq Ptr CUChar
    b1 Ptr CUChar
    b2 = do
                r1 <- Handle -> Ptr CUChar -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBuf Handle
    h1 Ptr CUChar
    b1 Int
    bufsz
                r2 <- hGetBuf h2 b2 bufsz
                if r1 == 0
                    then pure $ r2 == 0
                    else pure (r1 == r2) &&^ bufeq b1 b2 r1 &&^ eq b1 b2
              bufeq :: Ptr CUChar -> Ptr CUChar -> a -> IO Bool
    bufeq Ptr CUChar
    b1 Ptr CUChar
    b2 a
    s = (CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    ==CInt
    0) (CInt -> Bool) -> IO CInt -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ptr CUChar -> Ptr CUChar -> CSize -> IO CInt
    memcmp Ptr CUChar
    b1 Ptr CUChar
    b2 (a -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    s)
              withb :: (Ptr a -> IO b) -> IO b
    withb = Int -> Int -> (Ptr a -> IO b) -> IO b
    forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAligned Int
    bufsz Int
    4096
              bufsz :: Int
    bufsz = Int
    64Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    1024

    -- | Returns 'True' if both files have the same content.
    --   Raises an error if either file is missing.
    --
    -- > fileEq "does_not_exist1" "does_not_exist2" == undefined
    -- > fileEq "does_not_exist" "does_not_exist" == undefined
    -- > withTempFile $ \f1 -> fileEq "does_not_exist" f1 == undefined
    -- > withTempFile $ \f1 -> withTempFile $ \f2 -> fileEq f1 f2
    -- > withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "a" >> fileEq f1 f2
    -- > withTempFile $ \f1 -> withTempFile $ \f2 -> writeFile f1 "a" >> writeFile f2 "b" >> notM (fileEq f1 f2)
    fileEq :: FilePath -> FilePath -> IO Bool
    fileEq :: FilePath -> FilePath -> IO Bool
    fileEq FilePath
    p1 FilePath
    p2 = FilePath -> (Handle -> IO Bool) -> IO Bool
    forall {r}. FilePath -> (Handle -> IO r) -> IO r
    withH FilePath
    p1 ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h1 -> FilePath -> (Handle -> IO Bool) -> IO Bool
    forall {r}. FilePath -> (Handle -> IO r) -> IO r
    withH FilePath
    p2 ((Handle -> IO Bool) -> IO Bool) -> (Handle -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h2 -> Handle -> Handle -> IO Bool
    sameContent Handle
    h1 Handle
    h2
        where withH :: FilePath -> (Handle -> IO r) -> IO r
    withH FilePath
    p = FilePath -> IOMode -> (Handle -> IO r) -> IO r
    forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile FilePath
    p IOMode
    ReadMode