biohazard 0.6.15 → 0.6.16

raw patch · 15 files changed

+150/−579 lines, 15 filesdep −aesondep −bytestring-mmapdep −monad-controldep ~basedep ~base-preludedep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: aeson, bytestring-mmap, monad-control, transformers-base

Dependency ranges changed: base, base-prelude, directory, filepath, text, vector-algorithms

API changes (from Hackage documentation)

Files

• biohazard.cabal +12/−19
• src/Bio/Adna.hs +0/−10
• src/Bio/Bam/Index.hs +3/−3
• src/Bio/Bam/Reader.hs +7/−7
• src/Bio/Iteratee.hs +3/−22
• src/Bio/Iteratee/Base.hs +2/−26
• src/Bio/Iteratee/Exception.hs +2/−1
• src/Bio/Iteratee/IO.hs +63/−70
• src/Bio/Iteratee/IO/Base.hs +0/−105
• src/Bio/Iteratee/IO/Fd.hs +0/−145
• src/Bio/Iteratee/IO/Handle.hs +0/−145
• src/Bio/Iteratee/Iteratee.hs +0/−2
• src/Bio/TwoBit.hs +22/−24
• src/Bio/Util/MMap.hs +26/−0
• src/cbits/mmap.c +10/−0

@@ -1,11 +1,8 @@ Name:                biohazard-Version:             0.6.15+Version:             0.6.16 Synopsis:            bioinformatics support library Description:         This is a collection of modules I separated from-                     various bioinformatics tools.  The hope is to make-                     them reusable and easier to maintain.  Also includes-                     some of these tools and a bunch that work on mitochondrial-                     sequences.+                     various bioinformatics tools. Category:            Bioinformatics  Homepage:            http://github.com/udo-stenzel/biohazard@@ -53,42 +50,36 @@                        Bio.Iteratee.Bytes,                        Bio.Iteratee.Exception,                        Bio.Iteratee.IO,-                       Bio.Iteratee.IO.Base,-                       Bio.Iteratee.IO.Fd,-                       Bio.Iteratee.IO.Handle,                        Bio.Iteratee.Iteratee,                        Bio.Iteratee.List,                        Bio.Iteratee.ZLib,                        Bio.Prelude,                        Bio.TwoBit,+                       Bio.Util.MMap,                        Bio.Util.Numeric,                        Bio.Util.Zlib -  Build-depends:       aeson                    >= 0.7 && < 1.1,-                       async                    >= 2.0 && < 2.2,+  Build-depends:       async                    >= 2.0 && < 2.2,                        attoparsec               >= 0.10 && < 0.14,-                       base                     >= 4.6 && < 4.10,-                       base-prelude             >= 1.0 && < 1.3,+                       base                     >= 4.6 && < 4.11,+                       base-prelude             == 1.0.* || == 1.2.*,                        binary                   >= 0.7 && < 0.9,                        bytestring               >= 0.10.2 && < 0.11,-                       bytestring-mmap          >= 0.2 && < 1.0,                        containers               >= 0.4.1 && < 0.6,-                       directory                >= 1.2 && < 2.0,+                       directory                >= 1.2 && < 1.4,                        exceptions               >= 0.6 && < 0.9,-                       filepath                 >= 1.3 && < 2.0,+                       filepath                 >= 1.3 && < 1.5,                        hashable                 >= 1.0 && < 1.3,-                       monad-control            == 1.0.*,                        primitive                >= 0.5 && < 0.7,                        random                   >= 1.0 && < 1.2,                        scientific               == 0.3.*,                        stm                      == 2.4.*,-                       text                     >= 1.0 && < 2.0,+                       text                     >= 1.0 && < 1.3,                        transformers             >= 0.4.1 && < 0.6,-                       transformers-base        >= 0.4 && < 0.6,                        unix                     >= 2.5 && < 2.8,                        unordered-containers     >= 0.2.3 && < 0.3,                        vector                   >= 0.11 && < 0.13,-                       vector-algorithms        >= 0.3 && < 1.0,+                       vector-algorithms        >= 0.3 && < 0.8,                        vector-th-unbox          == 0.2.*,                        zlib                     == 0.6.* @@ -109,6 +100,7 @@   Other-Extensions:    CPP,                        DeriveGeneric,                        ExistentialQuantification,+                       ForeignFunctionInterface,                        FunctionalDependencies,                        GeneralizedNewtypeDeriving,                        PatternGuards,@@ -123,6 +115,7 @@   Hs-source-dirs:      src   Install-Includes:    src/cbits/myers_align.h   C-sources:           src/cbits/loops.c,+                       src/cbits/mmap.c,                        src/cbits/myers_align.c,                        src/cbits/trim.c   CC-options:          -fPIC

@@ -34,7 +34,6 @@ import Bio.Bam import Bio.Prelude import Bio.TwoBit-import Data.Aeson  import qualified Data.Vector                    as V import qualified Data.Vector.Generic            as G@@ -59,15 +58,6 @@  newtype Mat44D = Mat44D (U.Vector Double) deriving (Show, Generic) newtype MMat44D = MMat44D (UM.IOVector Double)--instance ToJSON Mat44D where-    toJSON (Mat44D v) = Array $ V.fromListN 4-                      [ toJSON $ U.slice i 4 v-                      | i <- [0, 4, 8, 12] ]--instance FromJSON Mat44D where-    parseJSON = withArray "matrix" $-                fmap Mat44D . fmap U.concat . mapM parseJSON . V.toList  -- | A 'DamageModel' is a function that gives substitution matrices for -- each position in a read.  The 'DamageModel' can depend on whether the

@@ -149,13 +149,13 @@ -- two, and finally in the file itself.  The first file that exists and -- can actually be parsed, is used. readBamIndex :: FilePath -> IO (BamIndex ())-readBamIndex fp | takeExtension fp == ".bai" = fileDriver readBaiIndex fp-                | takeExtension fp == ".csi" = fileDriver readBaiIndex fp+readBamIndex fp | takeExtension fp == ".bai" = enumFile defaultBufSize fp readBaiIndex >>= run+                | takeExtension fp == ".csi" = enumFile defaultBufSize fp readBaiIndex >>= run                 | otherwise = tryIx               (fp <.> "bai") $                               tryIx (dropExtension fp <.> "bai") $                               tryIx               (fp <.> "csi") $                               tryIx (dropExtension fp <.> "csi") $-                              fileDriver readBaiIndex fp+                              enumFile defaultBufSize fp readBaiIndex >>= run   where     tryIx f k = do e <- doesFileExist f                    if e then do r <- enumFile defaultBufSize f readBaiIndex >>= tryRun

@@ -212,11 +212,11 @@ concatDefaultInputs it0 = liftIO getArgs >>= \fs -> concatInputs fs it0  concatInputs :: (MonadIO m, MonadMask m) => [FilePath] -> Enumerator' BamMeta [BamRaw] m a-concatInputs [        ] = \k -> enumHandle defaultBufSize stdin (decodeAnyBam k) >>= run+concatInputs [        ] = \k -> enumFd defaultBufSize stdInput (decodeAnyBam k) >>= run concatInputs (fp0:fps0) = \k -> enum1 fp0 k >>= go fps0   where-    enum1 "-" k1 = enumHandle defaultBufSize stdin (decodeAnyBam k1) >>= run-    enum1  fp k1 = enumFile   defaultBufSize    fp (decodeAnyBam k1) >>= run+    enum1 "-" k1 = enumFd   defaultBufSize stdInput (decodeAnyBam k1) >>= run+    enum1  fp k1 = enumFile defaultBufSize fp       (decodeAnyBam k1) >>= run      go [       ] = return     go (fp1:fps) = enum1 fp1 . const >=> go fps@@ -229,11 +229,11 @@ mergeInputs :: (MonadIO m, MonadMask m)     => (BamMeta -> Enumeratee [BamRaw] [BamRaw] (Iteratee [BamRaw] m) a)     -> [FilePath] -> Enumerator' BamMeta [BamRaw] m a-mergeInputs  _  [        ] = \k -> enumHandle defaultBufSize stdin (decodeAnyBam k) >>= run+mergeInputs  _  [        ] = \k -> enumFd defaultBufSize stdInput (decodeAnyBam k) >>= run mergeInputs (?) (fp0:fps0) = go fp0 fps0   where-    enum1 "-" k1 = enumHandle defaultBufSize stdin (decodeAnyBam k1) >>= run-    enum1  fp k1 = enumFile defaultBufSize fp (decodeAnyBam k1) >>= run+    enum1 "-" k1 = enumFd   defaultBufSize stdInput (decodeAnyBam k1) >>= run+    enum1  fp k1 = enumFile defaultBufSize fp       (decodeAnyBam k1) >>= run      go fp [       ] = enum1 fp     go fp (fp1:fps) = mergeEnums' (go fp1 fps) (enum1 fp) (?)@@ -258,7 +258,7 @@                      refs <- liftBlock get_ref_array                      convStream getBamRaw $ inner $! mmerge meta refs   where-    get_bam_header  = do magic <- iGetString 4 +    get_bam_header  = do magic <- iGetString 4                          when (magic /= "BAM\SOH") $ do                                 s <- iGetString 10                                 fail $ "BAM signature not found: " ++ show magic ++ " " ++ show s

@@ -3,7 +3,6 @@  module Bio.Iteratee (     iGetString,-    iterGet,     iterLoop,     iLookAhead, @@ -63,7 +62,6 @@ import Control.Monad.Catch                  ( MonadMask(..) ) import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Data.Binary.Get import System.IO                            ( hIsTerminalDevice )  import qualified Control.Monad.Catch            as CMC@@ -102,23 +100,6 @@ iterLoop it a = do e <- isFinished                    if e then return a                         else it a >>= iterLoop it---- | Convert a 'Get' into an 'Iteratee'.  The 'Get' is applied once, the--- decoded data is returned, unneded input remains in the stream.-iterGet :: Get a -> Iteratee S.ByteString m a-iterGet = go . runGetIncremental-  where-    go (Fail  _ _ err) = throwErr (iterStrExc err)-    go (Done rest _ a) = idone a (Chunk rest)-    go (Partial   dec) = liftI $ \ck -> case ck of-        Chunk s -> go (dec $ Just s)-        EOF  mx -> case dec Nothing of-            Fail  _ _ err -> throwErr (iterStrExc err)-            Partial     _ -> throwErr (iterStrExc "<partial>")-            Done rest _ a | S.null rest -> idone a (EOF mx)-                          | otherwise   -> idone a (Chunk rest)-- infixl 1 $== {-# INLINE ($==) #-} -- | Compose an 'Enumerator\'' with an 'Enumeratee', giving a new@@ -147,15 +128,15 @@ type Enumeratee' h ei eo m b = (h -> Iteratee eo m b) -> Iteratee ei m (Iteratee eo m b)  enumAuxFile :: (MonadIO m, MonadMask m) => FilePath -> Iteratee S.ByteString m a -> m a-enumAuxFile fp it = liftIO (findAuxFile fp) >>= fileDriver it+enumAuxFile fp it = liftIO (findAuxFile fp) >>= \f -> enumFile defaultBufSize f it >>= run  enumDefaultInputs :: (MonadIO m, MonadMask m) => Enumerator S.ByteString m a enumDefaultInputs it0 = liftIO getArgs >>= flip enumInputs it0  enumInputs :: (MonadIO m, MonadMask m) => [FilePath] -> Enumerator S.ByteString m a-enumInputs [] = enumHandle defaultBufSize stdin+enumInputs [] = enumFd defaultBufSize stdInput enumInputs xs = go xs-  where go ("-":fs) = enumHandle defaultBufSize stdin >=> go fs+  where go ("-":fs) = enumFd defaultBufSize stdInput >=> go fs         go ( f :fs) = enumFile defaultBufSize f >=> go fs         go [      ] = return 

@@ -35,11 +35,9 @@ import Bio.Iteratee.Exception import Bio.Prelude -import Control.Monad.Base import Control.Monad.Catch as CIO import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.Trans.Control  import qualified Control.Exception    as E import qualified Data.ByteString      as B@@ -170,8 +168,8 @@ instance NullPoint s => MonadTrans (Iteratee s) where   lift m = Iteratee $ \onDone _ -> m >>= flip onDone (Chunk emptyP) -instance (MonadBase b m, Nullable s, NullPoint s) => MonadBase b (Iteratee s m) where-  liftBase = lift . liftBase+-- instance (MonadBase b m, Nullable s, NullPoint s) => MonadBase b (Iteratee s m) where+  -- liftBase = lift . liftBase  instance (MonadIO m, Nullable s, NullPoint s) => MonadIO (Iteratee s m) where   liftIO = lift . liftIO@@ -188,28 +186,6 @@ instance (MonadMask m, Nullable s, NullPoint s) => MonadMask (Iteratee s m) where     mask q      = Iteratee $ \od oc -> CIO.mask $ \u -> runIter (q $ ilift u) od oc     uninterruptibleMask q = Iteratee $ \od oc -> CIO.uninterruptibleMask $ \u -> runIter (q $ ilift u) od oc---instance forall s. (NullPoint s, Nullable s) => MonadTransControl (Iteratee s) where-  type StT (Iteratee s) x = Either (x, Stream s) (Maybe SomeException)--  liftWith f = lift $ f $ \t ->-      (runIter t (\x s -> return $ Left (x,s))-                 (\_ e -> return $ Right e) )-  restoreT = join . lift . liftM-               (either (uncurry idone)-                       (te . fromMaybe (iterStrExc-                          "iteratee: error in MonadTransControl instance")))-    where-      te :: SomeException -> Iteratee s m a-      te e = icont (const (te e)) (Just e)-  {-# INLINE liftWith #-}-  {-# INLINE restoreT #-}--instance (MonadBaseControl b m, Nullable s) => MonadBaseControl b (Iteratee s m) where-  type StM (Iteratee s m) a = ComposeSt (Iteratee s) m a-  liftBaseWith = defaultLiftBaseWith-  restoreM     = defaultRestoreM   -- |Send 'EOF' to the @Iteratee@ and disregard the unconsumed part of the

@@ -41,6 +41,7 @@   -- * Exception types   IFException (..)   ,Exception (..)             -- from Control.Exception+  ,FileOffset                 -- from System.Posix.Types   -- ** Enumerator exceptions   ,EnumException (..)   ,DivergentException (..)@@ -61,10 +62,10 @@ ) where -import Bio.Iteratee.IO.Base import Control.Exception import Data.Data import Prelude+import System.Posix.Types ( FileOffset )   -- ----------------------------------------------

@@ -1,39 +1,26 @@-{-# LANGUAGE ConstraintKinds #-}---- |Random and Binary IO with generic Iteratees.+-- |Random and Binary IO with generic Iteratees, using File Descriptors for IO.+-- when available, these are the preferred functions for performing IO as they+-- run in constant space and function properly with sockets, pipes, etc.  module Bio.Iteratee.IO(   -- * Data-  defaultBufSize,+  defaultBufSize   -- * File enumerators-  -- ** Handle-based enumerators-  H.enumHandle,-  H.enumHandleRandom,-  enumFile,-  enumFileRandom,-  -- ** FileDescriptor based enumerators-  FD.enumFd,-  FD.enumFdRandom,-  -- * Iteratee drivers-  --   These are FileDescriptor-based on POSIX systems, otherwise they are-  --   Handle-based.  The Handle-based drivers are accessible on POSIX systems-  --   at Data.Iteratee.IO.Handle-  fileDriver,-  fileDriverVBuf,-  fileDriverRandom,-  fileDriverRandomVBuf,+  ,enumFile+  ,enumFileRandom+  -- * FileDescriptor based enumerators for monadic iteratees+  ,enumFd+  ,enumFdCatch+  ,enumFdRandom )- where  import Bio.Iteratee.Iteratee-import Bio.Prelude+import Bio.Prelude hiding ( bracket ) import Control.Monad.Catch import Control.Monad.IO.Class--import qualified Bio.Iteratee.IO.Handle as H-import qualified Bio.Iteratee.IO.Fd as FD-+import Data.ByteString.Internal (createAndTrim)+import System.IO (SeekMode(..))  -- | Default buffer size in elements.  This was 1024 in "Data.Iteratee", -- which is obviously too small.  Since we often want to merge many@@ -42,54 +29,60 @@ defaultBufSize :: Int defaultBufSize = 2*1024*1024 +-- ------------------------------------------------------------------------+-- Binary Random IO enumerators --- If Posix is available, use the fileDriverRandomFd as fileDriverRandom.  Otherwise, use a handle-based variant.-enumFile-  :: (MonadIO m, MonadMask m) =>-     Int-     -> FilePath-     -> Enumerator Bytes m a-enumFile = FD.enumFile+makefdCallback :: MonadIO m => Int -> Fd -> st -> m (Either SomeException ((Bool, st), Bytes))+makefdCallback bufsize fd st = do+  s <- liftIO . createAndTrim bufsize $ \p ->+       fromIntegral <$> fdReadBuf fd (castPtr p) (fromIntegral bufsize)+  return $ Right ((True, st), s) -enumFileRandom-  :: (MonadIO m, MonadMask m) =>-     Int-     -> FilePath-     -> Enumerator Bytes m a-enumFileRandom = FD.enumFileRandom+-- |The enumerator of a POSIX File Descriptor.  This version enumerates+-- over the entire contents of a file, in order, unless stopped by+-- the iteratee.  In particular, seeking is not supported.+enumFd :: MonadIO m => Int -> Fd -> Enumerator Bytes m a+enumFd bufsize fd = enumFromCallback (makefdCallback bufsize fd) () --- |Process a file using the given Iteratee.  This function wraps--- enumFd as a convenience.-fileDriver-  :: (MonadIO m, MonadMask m) =>-     Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriver = FD.fileDriverFd defaultBufSize+-- |A variant of enumFd that catches exceptions raised by the @Iteratee@.+enumFdCatch+ :: (IException e, MonadIO m)+    => Int+    -> Fd+    -> (e -> m (Maybe EnumException))+    -> Enumerator Bytes m a+enumFdCatch bufsize fd handler = enumFromCallbackCatch (makefdCallback bufsize fd) handler () --- |A version of fileDriver with a user-specified buffer size (in elements).-fileDriverVBuf-  :: (MonadIO m, MonadMask m) =>-     Int-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverVBuf = FD.fileDriverFd+-- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that+-- supports RandomIO (seek requests).+enumFdRandom :: MonadIO m => Int -> Fd -> Enumerator Bytes m a+enumFdRandom bs fd iter = enumFdCatch bs fd handler iter+  where+    handler (SeekException off) =+        Nothing <$ (liftIO . fdSeek fd AbsoluteSeek $ fromIntegral off) --- |Process a file using the given Iteratee.  This function wraps--- enumFdRandom as a convenience.-fileDriverRandom-  :: (MonadIO m, MonadMask m) =>-     Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverRandom = FD.fileDriverRandomFd defaultBufSize+enumFile' :: (MonadIO m, MonadMask m) =>+  (Int -> Fd -> Enumerator s m a)+  -> Int -- ^Buffer size+  -> FilePath+  -> Enumerator s m a+enumFile' enumf bufsize filepath iter = bracket+  (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)+  (liftIO . closeFd)+  (flip (enumf bufsize) iter) -fileDriverRandomVBuf-  :: (MonadIO m, MonadMask m) =>-     Int-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverRandomVBuf = FD.fileDriverRandomFd+enumFile ::+  (MonadIO m, MonadMask m)+  => Int                 -- ^Buffer size+  -> FilePath+  -> Enumerator Bytes m a+enumFile = enumFile' enumFd++enumFileRandom ::+  (MonadIO m, MonadMask m)+  => Int                 -- ^Buffer size+  -> FilePath+  -> Enumerator Bytes m a+enumFileRandom = enumFile' enumFdRandom+ 

@@ -1,105 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, CPP #-}---- Low-level IO operations--- These operations are either missing from the GHC run-time library,--- or implemented suboptimally or heavy-handedly--module Bio.Iteratee.IO.Base (-  FileOffset,-  myfdRead,-  myfdSeek,-  Errno(..),-  select'read'pending-)--where--import Control.Monad-import Data.Bits                        -- for select-import Foreign.C-import Foreign.Marshal.Array            -- for select-import Foreign.Ptr-import Prelude-import System.IO (SeekMode(..))-import System.Posix---- |Alas, GHC provides no function to read from Fd to an allocated buffer.--- The library function fdRead is not appropriate as it returns a string--- already. I'd rather get data from a buffer.--- Furthermore, fdRead (at least in GHC) allocates a new buffer each--- time it is called. This is a waste. Yet another problem with fdRead--- is in raising an exception on any IOError or even EOF. I'd rather--- avoid exceptions altogether.--myfdRead :: Fd -> Ptr CChar -> ByteCount -> IO (Either Errno ByteCount)-myfdRead (Fd fd) ptr n = do-  n' <- cRead fd ptr n-  if n' == -1 then liftM Left getErrno-     else return . Right . fromIntegral $ n'--foreign import ccall unsafe "unistd.h read" cRead-  :: CInt -> Ptr CChar -> CSize -> IO CInt---- |The following fseek procedure throws no exceptions.-myfdSeek:: Fd -> SeekMode -> FileOffset -> IO (Either Errno FileOffset)-myfdSeek (Fd fd) mode off = do-  n' <- cLSeek fd off (mode2Int mode)-  if n' == -1 then liftM Left getErrno-     else return . Right  $ n'- where mode2Int :: SeekMode -> CInt     -- From GHC source-       mode2Int AbsoluteSeek = 0-       mode2Int RelativeSeek = 1-       mode2Int SeekFromEnd  = 2--foreign import ccall unsafe "unistd.h lseek" cLSeek-  :: CInt -> FileOffset -> CInt -> IO FileOffset----- Darn! GHC doesn't provide the real select over several descriptors!--- We have to implement it ourselves--type FDSET = CUInt-type TIMEVAL = CLong -- Two longs-foreign import ccall "unistd.h select" c_select-  :: CInt -> Ptr FDSET -> Ptr FDSET -> Ptr FDSET -> Ptr TIMEVAL -> IO CInt---- Convert a file descriptor to an FDSet (for use with select)--- essentially encode a file descriptor in a big-endian notation-fd2fds :: CInt -> [FDSET]-fd2fds fd = replicate nb 0 ++ [setBit 0 off]-  where-    (nb,off) = quotRem (fromIntegral fd) bitSize_FDSET--bitSize_FDSET :: Int-#if MIN_VERSION_base(4,7,0)-bitSize_FDSET = finiteBitSize (undefined::FDSET)-#else-bitSize_FDSET = bitSize (undefined::FDSET)-#endif--fds2mfd :: [FDSET] -> [CInt]-fds2mfd fds = [fromIntegral (j+i*bitSize_FDSET) |-               (afds,i) <- zip fds [0..], j <- [0..bitSize_FDSET],-               testBit afds j]--unFd :: Fd -> CInt-unFd (Fd x) = x---- |poll if file descriptors have something to read--- Return the list of read-pending descriptors-select'read'pending :: [Fd] -> IO (Either Errno [Fd])-select'read'pending mfd =-    withArray ([0,1]::[TIMEVAL]) $ \_timeout ->-      withArray fds $ \readfs -> do-          rc <- c_select (fdmax+1) readfs nullPtr nullPtr nullPtr-          if rc == -1-            then liftM Left getErrno-            -- because the wait was indefinite, rc must be positive!-            else liftM (Right . map Fd . fds2mfd) (peekArray (length fds) readfs)-  where-    fds :: [FDSET]-    fds  = foldr ormax [] (map (fd2fds . unFd) mfd)-    fdmax = maximum $ map fromIntegral mfd-    ormax [] x = x-    ormax x [] = x-    ormax (a:ar) (b:br) = (a .|. b) : ormax ar br

@@ -1,145 +0,0 @@--- |Random and Binary IO with generic Iteratees, using File Descriptors for IO.--- when available, these are the preferred functions for performing IO as they--- run in constant space and function properly with sockets, pipes, etc.--module Bio.Iteratee.IO.Fd(-  -- * File enumerators-  -- ** FileDescriptor based enumerators for monadic iteratees-  enumFd-  ,enumFdCatch-  ,enumFdRandom-  ,enumFile-  ,enumFileRandom-  -- * Iteratee drivers-  ,fileDriverFd-  ,fileDriverRandomFd-)--where--import Bio.Iteratee.IO.Base-import Bio.Iteratee.Iteratee-import Bio.Prelude-import Control.Monad.Catch as CIO-import Control.Monad.IO.Class-import Data.ByteString (packCStringLen)-import Foreign.Marshal.Alloc-import System.IO (SeekMode(..))----- --------------------------------------------------------------------------- Binary Random IO enumerators--makefdCallback ::-  MonadIO m =>-  Ptr el-  -> ByteCount-  -> Fd-  -> st-  -> m (Either SomeException ((Bool, st), Bytes))-makefdCallback p bufsize fd st = do-  n <- liftIO $ myfdRead fd (castPtr p) bufsize-  case n of-    Left  _  -> return $ Left (error "myfdRead failed")-    Right 0  -> liftIO yield >> return (Right ((False, st), emptyP))-    Right n' -> liftM (\s -> Right ((True, st), s)) $-                  readFromPtr p (fromIntegral n')-  where-    readFromPtr buf l = liftIO $ packCStringLen (castPtr buf, l)---- |The enumerator of a POSIX File Descriptor.  This version enumerates--- over the entire contents of a file, in order, unless stopped by--- the iteratee.  In particular, seeking is not supported.-enumFd-  :: (MonadIO m, MonadMask m) =>-     Int-     -> Fd-     -> Enumerator Bytes m a-enumFd bufsize fd iter =-  CIO.bracket (liftIO $ mallocBytes bufsize)-              (liftIO . free)-              (\p -> enumFromCallback (makefdCallback p (fromIntegral bufsize) fd) () iter)---- |A variant of enumFd that catches exceptions raised by the @Iteratee@.-enumFdCatch- :: (IException e, MonadIO m, MonadMask m)-    => Int-    -> Fd-    -> (e -> m (Maybe EnumException))-    -> Enumerator Bytes m a-enumFdCatch bufsize fd handler iter =-  CIO.bracket (liftIO $ mallocBytes bufsize)-              (liftIO . free)-              (\p -> enumFromCallbackCatch (makefdCallback p (fromIntegral bufsize) fd) handler () iter)----- |The enumerator of a POSIX File Descriptor: a variation of @enumFd@ that--- supports RandomIO (seek requests).-enumFdRandom- :: (MonadIO m, MonadMask m) =>-    Int-    -> Fd-    -> Enumerator Bytes m a-enumFdRandom bs fd iter = enumFdCatch bs fd handler iter-  where-    handler (SeekException off) =-      liftM (either-             (const . Just $ enStrExc "Error seeking within file descriptor")-             (const Nothing))-            . liftIO . myfdSeek fd AbsoluteSeek $ fromIntegral off--fileDriver-  :: (MonadIO m, MonadMask m) =>-     (Int -> Fd -> Enumerator s m a)-     -> Int-     -> Iteratee s m a-     -> FilePath-     -> m a-fileDriver enumf bufsize iter filepath = CIO.bracket-  (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)-  (liftIO . closeFd)-  (run <=< flip (enumf bufsize) iter)---- |Process a file using the given @Iteratee@.-fileDriverFd-  :: (MonadIO m, MonadMask m) =>-     Int -- ^Buffer size (number of elements)-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverFd = fileDriver enumFd---- |A version of fileDriverFd that supports seeking.-fileDriverRandomFd-  :: (MonadIO m, MonadMask m) =>-     Int-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverRandomFd = fileDriver enumFdRandom--enumFile' :: (MonadIO m, MonadMask m) =>-  (Int -> Fd -> Enumerator s m a)-  -> Int -- ^Buffer size-  -> FilePath-  -> Enumerator s m a-enumFile' enumf bufsize filepath iter = CIO.bracket-  (liftIO $ openFd filepath ReadOnly Nothing defaultFileFlags)-  (liftIO . closeFd)-  (flip (enumf bufsize) iter)--enumFile ::-  (MonadIO m, MonadMask m)-  => Int                 -- ^Buffer size-  -> FilePath-  -> Enumerator Bytes m a-enumFile = enumFile' enumFd--enumFileRandom ::-  (MonadIO m, MonadMask m)-  => Int                 -- ^Buffer size-  -> FilePath-  -> Enumerator Bytes m a-enumFileRandom = enumFile' enumFdRandom--

@@ -1,145 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE ScopedTypeVariables #-}---- |Random and Binary IO with generic Iteratees.  These functions use Handles--- for IO operations, and are provided for compatibility.  When available,--- the File Descriptor based functions are preferred as these wastefully--- allocate memory rather than running in constant space.--module Bio.Iteratee.IO.Handle(-  -- * File enumerators-  enumHandle-  ,enumHandleCatch-  ,enumHandleRandom-  ,enumFile-  ,enumFileRandom-  -- * Iteratee drivers-  ,fileDriverHandle-  ,fileDriverRandomHandle-)--where--import Bio.Iteratee.Iteratee-import Bio.Prelude-import Control.Monad.Catch as CIO-import Control.Monad.IO.Class-import Data.ByteString (packCStringLen)-import Foreign.Marshal.Alloc-import System.IO---- --------------------------------------------------------------------------- Binary Random IO enumerators--makeHandleCallback ::-  MonadIO m =>-  Ptr Word8-  -> Int-  -> Handle-  -> st-  -> m (Either SomeException ((Bool, st), Bytes))-makeHandleCallback p bsize h st = do-  n' <- liftIO (CIO.try $ hGetBuf h p bsize :: IO (Either SomeException Int))-  case n' of-    Left e -> return $ Left e-    Right 0 -> return $ Right ((False, st), emptyP)-    Right n -> liftM (\s -> Right ((True, st), s)) $-                 readFromPtr p (fromIntegral n)-  where-    readFromPtr buf l = liftIO $ packCStringLen (castPtr buf, l)----- |The (monadic) enumerator of a file Handle.  This version enumerates--- over the entire contents of a file, in order, unless stopped by--- the iteratee.  In particular, seeking is not supported.--- Data is read into a buffer of the specified size.-enumHandle ::-  (MonadIO m, MonadMask m) =>-  Int -- ^Buffer size (number of elements per read)-  -> Handle-  -> Enumerator Bytes m a-enumHandle bufsize h i =-  CIO.bracket (liftIO $ mallocBytes bufsize)-              (liftIO . free)-              (\p -> enumFromCallback (makeHandleCallback p bufsize h) () i)---- |An enumerator of a file handle that catches exceptions raised by--- the Iteratee.-enumHandleCatch- ::- forall e m a.(IException e,-               MonadIO m, MonadMask m) =>-  Int -- ^Buffer size (number of elements per read)-  -> Handle-  -> (e -> m (Maybe EnumException))-  -> Enumerator Bytes m a-enumHandleCatch bufsize h handler i =-  CIO.bracket (liftIO $ mallocBytes bufsize)-              (liftIO . free)-              (\p -> enumFromCallbackCatch (makeHandleCallback p bufsize h) handler () i)----- |The enumerator of a Handle: a variation of enumHandle that--- supports RandomIO (seek requests).--- Data is read into a buffer of the specified size.-enumHandleRandom ::- forall m a.(MonadIO m, MonadMask m) =>-  Int -- ^ Buffer size (number of elements per read)-  -> Handle-  -> Enumerator Bytes m a-enumHandleRandom bs h i = enumHandleCatch bs h handler i-  where-    handler (SeekException off) =-       liftM (either-              (Just . EnumException :: IOException -> Maybe EnumException)-              (const Nothing))-             . liftIO . CIO.try $ hSeek h AbsoluteSeek $ fromIntegral off---- ------------------------------------------------- File Driver wrapper functions.--enumFile' :: (MonadIO m, MonadMask m) =>-  (Int -> Handle -> Enumerator s m a)-  -> Int -- ^Buffer size-  -> FilePath-  -> Enumerator s m a-enumFile' enumf bufsize filepath iter = CIO.bracket-  (liftIO $ openBinaryFile filepath ReadMode)-  (liftIO . hClose)-  (flip (enumf bufsize) iter)--enumFile ::-  (MonadIO m, MonadMask m)-  => Int                 -- ^Buffer size-  -> FilePath-  -> Enumerator Bytes m a-enumFile = enumFile' enumHandle--enumFileRandom ::-  (MonadIO m, MonadMask m)-  => Int                 -- ^Buffer size-  -> FilePath-  -> Enumerator Bytes m a-enumFileRandom = enumFile' enumHandleRandom---- |Process a file using the given @Iteratee@.  This function wraps--- @enumHandle@ as a convenience.-fileDriverHandle-  :: (MonadIO m, MonadMask m) =>-     Int                      -- ^Buffer size (number of elements)-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverHandle bufsize iter filepath =-  enumFile bufsize filepath iter >>= run---- |A version of @fileDriverHandle@ that supports seeking.-fileDriverRandomHandle-  :: (MonadIO m, MonadMask m) =>-     Int                      -- ^ Buffer size (number of elements)-     -> Iteratee Bytes m a-     -> FilePath-     -> m a-fileDriverRandomHandle bufsize iter filepath =-  enumFileRandom bufsize filepath iter >>= run-

@@ -62,13 +62,11 @@   ,(<><)   -- * Misc.   ,seek-  ,FileOffset   -- * Classes   ,module Bio.Iteratee.Base ) where -import Bio.Iteratee.IO.Base import Bio.Iteratee.Base import Bio.Prelude hiding (loop) import Control.Monad.IO.Class

@@ -23,15 +23,13 @@     ) where  import           Bio.Prelude hiding ( left, right, chr )+import           Bio.Util.MMap import           Data.Binary.Get-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L--- can't use Data.IntMap.Strict to remain compatible with--- containers-0.4.1 and therefore ghc 7.4  :-(-import qualified Data.IntMap as I-import qualified Data.HashMap.Lazy as M-import qualified Data.Vector.Unboxed as U-import           System.IO.Posix.MMap+import qualified Data.ByteString                as B+import qualified Data.ByteString.Lazy           as L+import qualified Data.IntMap                    as I+import qualified Data.HashMap.Lazy              as M+import qualified Data.Vector.Unboxed            as U import           System.Random  -- ^ Would you believe it?  The 2bit format stores blocks of Ns in a table at@@ -62,25 +60,25 @@ -- not work on streams that are not actual files.  It's also unsafe if -- the file is modified in any way. openTwoBit :: FilePath -> IO TwoBitFile-openTwoBit fp = do raw <- unsafeMMapFile fp-                   return $ flip runGet (L.fromChunks [raw]) $ do-                            sig <- getWord32be-                            getWord32 <- case sig of-                                    0x1A412743 -> return $ fromIntegral `fmap` getWord32be-                                    0x4327411A -> return $ fromIntegral `fmap` getWord32le-                                    _          -> fail $ "invalid .2bit signature " ++ showHex sig []--                            version <- getWord32-                            unless (version == 0) $ fail $ "wrong .2bit version " ++ show version+openTwoBit fp = do+        raw <- unsafeMMapFile fp+        return $ flip runGet (L.fromChunks [raw]) $ do+                    sig <- getWord32be+                    getWord32 <- case sig of+                            0x1A412743 -> return $ fromIntegral `fmap` getWord32be+                            0x4327411A -> return $ fromIntegral `fmap` getWord32le+                            _          -> fail $ "invalid .2bit signature " ++ showHex sig [] -                            nseqs <- getWord32-                            _reserved <- getWord32+                    version <- getWord32+                    unless (version == 0) $ fail $ "wrong .2bit version " ++ show version -                            TBF raw <$> foldM (\ix _ -> do !key <- getWord8 >>= getByteString . fromIntegral-                                                           !off <- getWord32-                                                           return $! M.insert key (mkBlockIndex raw getWord32 off) ix-                                              ) M.empty [1..nseqs]+                    nseqs <- getWord32+                    _reserved <- getWord32 +                    TBF raw <$> foldM (\ix _ -> do !key <- getWord8 >>= getByteString . fromIntegral+                                                   !off <- getWord32+                                                   return $! M.insert key (mkBlockIndex raw getWord32 off) ix+                                      ) M.empty [1..nseqs]  mkBlockIndex :: B.ByteString -> Get Int -> Int -> TwoBitSequence mkBlockIndex raw getWord32 ofs = runGet getBlock $ L.fromChunks [B.drop ofs raw]

@@ -0,0 +1,26 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Bio.Util.MMap where++import Bio.Prelude hiding ( left, right, chr )+import Data.ByteString.Internal ( fromForeignPtr )+import Foreign.C.Types++unsafeMMapFile :: FilePath -> IO Bytes+unsafeMMapFile fp =+    bracket (openFd fp ReadOnly Nothing defaultFileFlags) closeFd $ \fd -> do+        stat <- getFdStatus fd+        let size = fromIntegral (fileSize stat)+        if size <= 0+            then return mempty+            else do+                ptr <- c_mmap size (fromIntegral fd)+                if ptr == nullPtr+                    then error "unable to mmap file"+                    else do+                          fptr <- newForeignPtrEnv c_munmap (intPtrToPtr $ fromIntegral size) ptr+                          return $ fromForeignPtr fptr 0 (fromIntegral size)++foreign import ccall unsafe  "my_mmap"   c_mmap   :: CSize -> CInt -> IO (Ptr Word8)+foreign import ccall unsafe "&my_munmap" c_munmap :: FunPtr (Ptr () -> Ptr Word8 -> IO ())++

@@ -0,0 +1,10 @@+#include <sys/mman.h>++unsigned char *my_mmap(size_t len, int fd) {+        void *result = mmap(0, len, PROT_READ, MAP_SHARED, fd, 0);+        return (unsigned char*)( result == MAP_FAILED ? 0 : result );+}++void my_munmap(void *len, unsigned char *p) {+        munmap( p, (size_t)len ) ; +}