TOSQUASH

input-output-hk · Mar 7, 2024 · 576a374 · 576a374
1 parent dd23e6c
commit 576a374
Showing 1 changed file with 6 additions and 0 deletions.
diff --git a/fs-api/src-win32/System/FS/IO/Internal.hs b/fs-api/src-win32/System/FS/IO/Internal.hs
@@ -27,6 +27,8 @@ import           Data.ByteString
 import           Data.ByteString.Internal as Internal
 import           Data.Word (Word32, Word64, Word8)
 import           Foreign (Int64, Ptr)
+import qualified GHC.IO.Device as Device
+import           GHC.IO.FD (FD (..))
 import           System.FS.API.Types (AllowExisting (..), FsError (..),
                      FsErrorType (..), OpenMode (..), SeekMode (..))
 import           System.FS.IO.Internal.Handle
@@ -70,6 +72,10 @@ seek :: FHandle -> SeekMode -> Int64 -> IO ()
 seek fh seekMode size = void <$> withOpenHandle "seek" fh $ \h ->
   setFilePointerEx h size (fromSeekMode seekMode)
 
+tell :: FHandle -> IO Word64
+tell h = withOpenHandle "tell" h $ \fd ->
+    fromIntegral <$> Device.tell (FD (coerce fd) 0)
+
 fromSeekMode :: SeekMode -> FilePtrDirection
 fromSeekMode AbsoluteSeek = fILE_BEGIN
 fromSeekMode RelativeSeek = fILE_CURRENT