never executed always true always false

    1 {-# LANGUAGE QuasiQuotes #-}
    2 {-# LANGUAGE TemplateHaskell #-}
    3 
    4 module OpenCV.ImgCodecs
    5     ( ImreadMode(..)
    6     , imdecode
    7     , imdecodeM
    8 
    9     , OutputFormat(..)
   10     , JpegParams(..), defaultJpegParams
   11     , PngStrategy(..)
   12     , PngParams(..), defaultPngParams
   13     , imencode
   14     , imencodeM
   15     ) where
   16 
   17 import "base" Control.Exception ( mask_ )
   18 import "base" Data.Int ( Int32 )
   19 import "base" Foreign.C.String ( withCString )
   20 import "base" Foreign.C.Types
   21 import "base" Foreign.Marshal.Alloc ( alloca )
   22 import "base" Foreign.Ptr ( Ptr, nullPtr, castPtr )
   23 import "base" Foreign.Storable ( peek )
   24 import "base" System.IO.Unsafe ( unsafePerformIO )
   25 import "bytestring" Data.ByteString ( ByteString )
   26 import qualified "bytestring" Data.ByteString.Unsafe as BU
   27 import qualified "inline-c" Language.C.Inline as C
   28 import qualified "inline-c-cpp" Language.C.Inline.Cpp as C
   29 import "primitive" Control.Monad.Primitive ( PrimMonad, PrimState )
   30 import "this" OpenCV.Core.Types.Mat
   31 import "this" OpenCV.Internal.C.Inline ( openCvCtx )
   32 import "this" OpenCV.Internal.C.Types
   33 import "this" OpenCV.Internal.Core.Types.Mat
   34 import "this" OpenCV.Internal.Exception
   35 import "this" OpenCV.Internal.ImgCodecs
   36 import "this" OpenCV.Internal.Mutable
   37 import "this" OpenCV.TypeLevel
   38 import "transformers" Control.Monad.Trans.Except
   39 
   40 
   41 --------------------------------------------------------------------------------
   42 
   43 C.context openCvCtx
   44 
   45 C.include "<vector>"
   46 C.include "opencv2/core.hpp"
   47 C.include "opencv2/imgcodecs.hpp"
   48 C.using "namespace cv"
   49 
   50 
   51 --------------------------------------------------------------------------------
   52 
   53 -- | Reads an image from a buffer in memory.
   54 --
   55 -- The function reads an image from the specified buffer in the
   56 -- memory. If the buffer is too short or contains invalid data, the
   57 -- empty matrix/image is returned.
   58 --
   59 -- <http://docs.opencv.org/3.0-last-rst/modules/imgcodecs/doc/reading_and_writing_images.html#imdecode OpenCV Sphinx doc>
   60 imdecode
   61     :: ImreadMode
   62     -> ByteString
   63     -> Mat ('S ['D, 'D]) 'D 'D
   64 imdecode imreadMode hbuf = unsafeCoerceMat $ unsafePerformIO $ fromPtr
   65     [C.block|Mat * {
   66       cv::_InputArray cbuf = cv::_InputArray($bs-ptr:hbuf, $bs-len:hbuf);
   67       return new cv::Mat(cv::imdecode(cbuf, $(int32_t c'imreadMode)));
   68     }|]
   69   where
   70     c'imreadMode = marshalImreadMode imreadMode
   71 
   72 imdecodeM
   73     :: (PrimMonad m)
   74     => ImreadMode
   75     -> ByteString
   76     -> m (Mut (Mat ('S ['D, 'D]) 'D 'D) (PrimState m))
   77 imdecodeM imreadMode hbuf = unsafeThaw $ imdecode imreadMode hbuf
   78 
   79 --------------------------------------------------------------------------------
   80 
   81 -- | Encodes an image into a memory buffer.
   82 --
   83 -- __WARNING:__ This function is not thread safe!
   84 --
   85 -- <http://docs.opencv.org/3.0-last-rst/modules/imgcodecs/doc/reading_and_writing_images.html#imencode OpenCV Sphinx doc>
   86 imencode
   87     :: OutputFormat
   88     -> Mat shape channels depth
   89     -> CvExcept ByteString
   90 imencode format mat = unsafeWrapException $
   91     withPtr mat $ \matPtr ->
   92     withCString ext $ \extPtr ->
   93     alloca $ \(bufPtrPtr :: Ptr (Ptr CUChar)) ->
   94     alloca $ \(vecPtrPtr :: Ptr (Ptr ())) ->
   95     alloca $ \(c'bufSizePtr :: Ptr Int32) -> mask_ $ do
   96       ptrException <- [cvExcept|
   97         const int * const paramsPtr = $vec-ptr:(int * params);
   98         std::vector<uchar> * vec = new std::vector<uchar>();
   99         *$(void * * vecPtrPtr) = reinterpret_cast<void *>(vec);
  100         std::vector<int> params(paramsPtr, paramsPtr + $vec-len:params);
  101         cv::imencode( $(char * extPtr)
  102                     , *$(Mat * matPtr)
  103                     , *vec
  104                     , params
  105                     );
  106         *$(int32_t * c'bufSizePtr) = vec->size();
  107         *$(unsigned char * * bufPtrPtr) = &((*vec)[0]);
  108       |]
  109       vecPtr <- peek vecPtrPtr
  110       if ptrException /= nullPtr
  111       then do
  112         freeVec vecPtr
  113         Left . BindingException <$> fromPtr (pure ptrException)
  114       else do
  115         bufSize <- peek c'bufSizePtr
  116         bufPtr  <- peek bufPtrPtr
  117         bs <- BU.unsafePackCStringFinalizer
  118                 (castPtr bufPtr)
  119                 (fromIntegral bufSize)
  120                 (freeVec vecPtr)
  121         pure $ Right bs
  122   where
  123     (ext, params) = marshalOutputFormat format
  124 
  125     freeVec :: Ptr () -> IO ()
  126     freeVec vecPtr = [C.exp|void { delete reinterpret_cast< std::vector<uchar> * >($(void * vecPtr)) }|]
  127 
  128 -- | Encodes an image into a memory buffer.
  129 --
  130 -- See 'imencode'
  131 imencodeM
  132     :: (PrimMonad m)
  133     => OutputFormat
  134     -> Mut (Mat shape channels depth) (PrimState m)
  135     -> CvExceptT m ByteString
  136 imencodeM format matM =
  137     ExceptT . pure . runExcept =<< (imencode format <$> unsafeFreeze matM)