FastIO.hs

-- 
-- Copyright (c) 2005-2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2019, 2020 Galen Huntington
-- 
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 2 of
-- the License, or (at your option) any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
-- 

-- | ByteString versions of some common IO functions

module FastIO where

import Base

import Syntax                   (Pretty(ppr))

import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B

import System.Posix.Files.ByteString
import System.Posix.Directory.ByteString

import System.IO                (hFlush)

------------------------------------------------------------------------

--  Use every nth frame.  1 for no dropping.
dropRate :: Int
dropRate = 4   -- used to be 10, but computers are faster

-- | Packed string version of basename
basenameP :: ByteString -> ByteString
basenameP fps = case P.elemIndexEnd '/' fps of
    Nothing -> fps
    Just i  -> P.drop (i+1) fps
{-# INLINE basenameP #-}

dirnameP :: ByteString -> ByteString
dirnameP fps = case P.elemIndexEnd '/' fps of
    Nothing -> "."
    Just i  -> P.take i fps
{-# INLINE dirnameP #-}

-- | Packed version of listDirectory
packedGetDirectoryContents :: ByteString -> IO [ByteString]
packedGetDirectoryContents fp = bracket (openDirStream fp) closeDirStream
    $ \ds -> fmap (filter (\p -> p/="." && p/=".."))
        $ sequenceWhile (not . P.null) $ repeat $ readDirStream ds

doesFileExist :: ByteString -> IO Bool
doesFileExist fp = catch @SomeException
   (not . isDirectory <$> getFileStatus fp)
   (\_ -> pure False)

doesDirectoryExist :: ByteString -> IO Bool
doesDirectoryExist fp = catch @SomeException
   (isDirectory <$> getFileStatus fp)
   (\_ -> pure False)

packedFileNameEndClean :: ByteString -> ByteString
packedFileNameEndClean name =
  case P.unsnoc name of
    Just (name', ec) | ec == '\\' || ec == '/'
         -> packedFileNameEndClean name'
    _    -> name

-- ---------------------------------------------------------------------

data FiltHandle = FiltHandle { filtHandle :: !Handle, frameCount :: !(IORef Int) }

newFiltHandle :: Handle -> IO FiltHandle
newFiltHandle h = FiltHandle h <$> newIORef 0

-- | Read a line from a file stream connected to an external prcoess,
-- Returning a ByteString.
getPacket :: FiltHandle -> IO ByteString
getPacket (FiltHandle fp _) = B.hGetLine fp

-- | Check if it's one of every dropRate packets.
-- We don't need to process all since there are so many.
checkF :: FiltHandle -> IO Bool
checkF (FiltHandle _ ir) = do
  modifyIORef' ir (\x -> (x+1) `mod` dropRate)
  i <- readIORef ir
  pure $ dropRate==1 || i==1

-- ---------------------------------------------------------------------

isReadable :: ByteString -> IO Bool
isReadable fp = fileAccess fp True False False

-- ---------------------------------------------------------------------
-- | Send a msg over the channel to the decoder
send :: Pretty a => Handle -> a -> IO ()
send h m = P.hPut h (ppr m) >> P.hPut h "\n" >> hFlush h

------------------------------------------------------------------------ 

-- | 'dropSpaceEnd' efficiently returns the 'ByteString' argument with
-- white space removed from the end. I.e.,
-- 
-- > reverse . (dropWhile isSpace) . reverse == dropSpaceEnd
dropSpaceEnd :: ByteString -> ByteString
{-# INLINE dropSpaceEnd #-}
dropSpaceEnd bs = P.take (P.length bs - count) bs where
    count = B.foldl' go 0 bs
    go n c = if B.isSpaceWord8 c then n+1 else 0