{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}

module System.FS.API.Strict (
    -- * API
    module API
    -- * Strict functions
  , hPutAllStrict
  ) where

import qualified Data.ByteString as BS
import           Data.Word
import           System.FS.API as API
import           System.FS.CallStack

-- | This function makes sure that the whole 'BS.ByteString' is written.
hPutAllStrict :: forall m h
              .  (HasCallStack, Monad m)
              => HasFS m h
              -> Handle h
              -> BS.ByteString
              -> m Word64
hPutAllStrict :: forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> ByteString -> m Word64
hPutAllStrict HasFS m h
hasFS Handle h
h = Word64 -> ByteString -> m Word64
go Word64
0
  where
    go :: Word64 -> BS.ByteString -> m Word64
    go :: Word64 -> ByteString -> m Word64
go !Word64
written ByteString
bs = do
      Word64
n <- HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hPutSome HasFS m h
hasFS Handle h
h ByteString
bs
      let bs' :: ByteString
bs'      = Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) ByteString
bs
          written' :: Word64
written' = Word64
written Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n
      if ByteString -> Bool
BS.null ByteString
bs'
        then Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
written'
        else Word64 -> ByteString -> m Word64
go Word64
written' ByteString
bs'