1 {- |
    2    Utility module, with various useful stuff.
    3 -}
    4 
    5 module Bio.Util (lines, splitWhen, countIO, sequence', mylines) where
    6 
    7 import Prelude hiding (lines)
    8 import System.IO        (stderr, hPutStr, hFlush)
    9 import System.IO.Unsafe (unsafeInterleaveIO)
   10 import Data.List        (groupBy)
   11 import qualified Data.ByteString.Lazy.Char8 as B
   12 
   13 -- | Workaround, the current "Data.ByteString.Lazy.Char8" contains a bug in 'Data.ByteString.Lazy.Char8.lines'.
   14 lines, mylines :: B.ByteString -> [B.ByteString]
   15 lines = case length (B.lines $ B.pack "\n") of 1 -> B.lines
   16                                                0 -> mylines
   17 mylines s = case B.elemIndex '\n' s of
   18               Nothing -> if B.null s then [] else [s]
   19               Just i  -> B.take i s : mylines (B.drop (i+1) s)
   20 
   21 -- | Break a list of bytestrings on a predicate.
   22 splitWhen :: (B.ByteString -> Bool) -> [B.ByteString] -> [[B.ByteString]]
   23 splitWhen p = groupBy (\_ y -> B.null y || not (p y))
   24 
   25 -- | Output (to stderr) progress while evaluating a lazy list.
   26 --   Useful for generating output while (conceptually, at least) in pure code
   27 countIO :: String -> String -> Int -> [a] -> IO [a]
   28 countIO msg post step xs = sequence' $ map unsafeInterleaveIO ((blank >> outmsg (0::Int) >> c):cs)
   29    where (c:cs) = ct 0 xs
   30          output   = hPutStr stderr
   31          blank    = output ('\r':take 70 (repeat ' '))
   32          outmsg x = output ('\r':msg++show x) >> hFlush stderr
   33          ct s ys = let (a,b) = splitAt (step-1) ys
   34                        next  = s+step
   35                    in case b of [b1] -> map return a ++ [outmsg (s+step) >> hPutStr stderr post >> return b1]
   36                                 []   -> map return (init a) ++ [outmsg (s+length a) >> hPutStr stderr post >> return (last a)]
   37                                 _ -> map return a ++ [outmsg s >> return (head b)] ++ ct next (tail b)
   38 
   39 -- | A lazier version of 'Control.Monad.sequence' in "Control.Monad", needed by 'countIO' above.
   40 sequence' :: [IO a] -> IO [a]
   41 sequence' ms = foldr k (return []) ms
   42     where k m m' = do { x <- m; xs <- unsafeInterleaveIO m'; return (x:xs) }