Feature/vrtdataset (#15)

* VRTDataset and minor breaking changes. OverviewResampling -> Resampling since not only overview use it * getSrcDstWin * ColorInterp for HSRasterBand. Fixed typo * getters and setters for scale, offset and unittype * toGDALDataset returns a Dataset instead of a handle
albertov · Aug 9, 2018 · 1bc49ec · 1bc49ec
1 parent c3313ac
commit 1bc49ec
Show file tree

Hide file tree

Showing 12 changed files with 547 additions and 50 deletions.
diff --git a/bindings-gdal.cabal b/bindings-gdal.cabal
@@ -50,6 +50,7 @@ library
                    , GDAL
                    , GDAL.Algorithms
                    , GDAL.Warper
+                   , GDAL.VRT
 
                    , GDAL.Internal.Types
                    , GDAL.Internal.Types.Value
@@ -74,6 +75,7 @@ library
                    , GDAL.Internal.Warper
                    , GDAL.Internal.HSDataset
                    , GDAL.Internal.HSDriver
+                   , GDAL.Internal.VRT
   build-depends:     base                              >= 4.5     && < 5
                    , ghc-prim                          >= 0.3.1   && < 0.6
                    , bytestring                        >= 0.10.4  && < 0.11
@@ -112,7 +114,7 @@ library
   install-includes: bindings.h
   default-language: Haskell2010
   include-dirs:    include cbits
-  cc-options:      -Wall -O3 -g
+  cc-options:      -Wall -g
   c-sources:       cbits/errorhandler.c
                  , cbits/contourwriter.c
                  , cbits/driver.cpp
@@ -160,11 +162,12 @@ test-suite spec
                   , OGRGeometrySpec
                   , GDAL.AlgorithmsSpec
                   , GDAL.WarperSpec
+                  , GDAL.VRTSpec
                   , Paths_bindings_gdal
                   , TestUtils
                   , Arbitrary
   default-language: Haskell2010
-  ghc-options:     -Wall -rtsopts -threaded -with-rtsopts=-N -O
+  ghc-options:     -Wall -rtsopts -threaded -with-rtsopts=-N
   if flag(static)
     ghc-options: -optl-static -optl-static-libstdc++ -optl-static-libgcc -pgml=g++
   include-dirs:    src/GDAL/Internal/

diff --git a/cbits/hsdataset.cpp b/cbits/hsdataset.cpp
@@ -52,9 +52,12 @@ class HSRasterBand : public GDALRasterBand
 
   virtual CPLErr IReadBlock( int, int, void * );
   virtual double GetNoDataValue( int *pbSuccess = NULL );
+  virtual CPLErr SetColorInterpretation(GDALColorInterp);
+  virtual GDALColorInterp GetColorInterpretation();
 
 private:
   const HsStablePtr state;
+  GDALColorInterp colorInterp;
   const double noDataValue;
   const bool hasNodata;
   int (*const pfnReadBlock)(const HsStablePtr, const int, const int, void*);
@@ -157,6 +160,7 @@ HSRasterBand::HSRasterBand( HSDataset *poDS, int nBand,
   this->nBlockXSize  = impl.nBlockXSize;
   this->nBlockYSize  = impl.nBlockYSize;
   this->eDataType    = impl.eDataType;
+  this->colorInterp  = impl.colorInterp;
 }
 
 /************************************************************************/
@@ -189,7 +193,19 @@ double HSRasterBand::GetNoDataValue( int *pbSuccess )
     return this->noDataValue;
 }
 
+/************************************************************************/
+/*                     HSRasterBand::GetColorInterpretation()           */
+/************************************************************************/
+GDALColorInterp HSRasterBand::GetColorInterpretation()
+{
+  return this->colorInterp;
+}
 
+CPLErr HSRasterBand::SetColorInterpretation(GDALColorInterp colorInterp)
+{
+  this->colorInterp = colorInterp;
+  return CE_None;
+}
 
 /************************************************************************/
 /*                         hs_gdal_create_dataset                       */

diff --git a/cbits/hsdataset.h b/cbits/hsdataset.h
@@ -12,6 +12,7 @@ typedef struct hsRasterBandImpl {
   GDALDataType eDataType;
   double nodata;
   int hasNodata;
+  GDALColorInterp colorInterp;
   int (*readBlock)( HsStablePtr, int, int, void* );
 }* HSRasterBandImpl;
 

diff --git a/src/GDAL.hs b/src/GDAL.hs
@@ -30,9 +30,10 @@ module GDAL (
   , isInterruptedException
 
   , ColorInterp(..)
+  , Georeference (..)
   , Geotransform (..)
   , GroundControlPoint (..)
-  , OverviewResampling (..)
+  , Resampling (..)
   , Driver
   , DriverName
   , Dataset
@@ -127,8 +128,8 @@ module GDAL (
   , setDatasetGCPs
   , datasetBandCount
 
-  , bandColorInterpretaion
-  , setBandColorInterpretaion
+  , bandColorInterpretation
+  , setBandColorInterpretation
   , bandDataType
   , bandProjection
   , bandGeotransform
@@ -142,6 +143,12 @@ module GDAL (
   , sizeLen
   , bandNodataValue
   , setBandNodataValue
+  , bandOffset
+  , setBandOffset
+  , bandScale
+  , setBandScale
+  , bandUnitType
+  , setBandUnitType
   , addBand
   , getBand
   , readDatasetRGBA

diff --git a/src/GDAL/Internal/CPLError.chs b/src/GDAL/Internal/CPLError.chs
@@ -14,6 +14,7 @@ module GDAL.Internal.CPLError (
   , throwBindingException
   , bindingExceptionToException
   , bindingExceptionFromException
+  , cplError
   , checkCPLError
   , checkGDALCall
   , checkGDALCall_
@@ -40,8 +41,8 @@ import Foreign.Ptr (Ptr, FunPtr, nullPtr)
 import Foreign.Storable (peek)
 import Foreign.Marshal.Utils (with)
 
-import GDAL.Internal.Util (toEnumC, runBounded)
-import GDAL.Internal.CPLString (peekEncodedCString)
+import GDAL.Internal.Util (fromEnumC, toEnumC, runBounded)
+import GDAL.Internal.CPLString (peekEncodedCString, useAsEncodedCString)
 
 #include "cpl_error.h"
 #include "errorhandler.h"
@@ -151,5 +152,9 @@ withQuietErrorHandler a = runBounded ((pushIt >> a) `finally` popIt)
     popIt  = {#call unsafe CPLPopErrorHandler as ^#}
 
 
+cplError :: ErrorType -> ErrorNum -> Text -> IO ()
+cplError err errNum msg = useAsEncodedCString msg $
+  {#call unsafe CPLError as ^#} (fromEnumC err) (fromEnumC errNum)
+
 foreign import ccall "cpl_error.h &CPLQuietErrorHandler"
   c_quietErrorHandler :: FunPtr (CInt -> CInt -> Ptr CChar -> IO ())
diff --git a/src/GDAL/Internal/DataType.hs b/src/GDAL/Internal/DataType.hs
@@ -27,6 +27,7 @@ module GDAL.Internal.DataType (
 
   , sizeOfDataType
   , hsDataType
+  , dataTypeK
 ) where
 
 import GDAL.Internal.Types (Pair(..), pFst)
@@ -39,6 +40,7 @@ import Data.Coerce (coerce)
 
 import Foreign.Storable (Storable(sizeOf))
 import Foreign.C.Types (CDouble(..))
+import GHC.TypeLits
 
 
 data DataType :: * -> * where
@@ -80,7 +82,9 @@ class ( Storable a
       , Show a
       , Num a
       , Typeable a
+      , KnownNat (SizeOf a)
       ) => GDALType a where
+  type SizeOf a :: Nat
   dataType    :: DataType a
   toCDouble   :: a -> CDouble
   fromCDouble :: CDouble -> a
@@ -114,6 +118,7 @@ hsDataType _ = dataTypeK (dataType :: DataType a)
 ------------------------------------------------------------------------------
 
 instance GDALType Word8 where
+  type SizeOf Word8 = 1
   dataType    = GDT_Byte
   toCDouble   = fromIntegral
   fromCDouble = truncate
@@ -122,6 +127,7 @@ instance GDALType Word8 where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Word16 where
+  type SizeOf Word16 = 2
   dataType    = GDT_UInt16
   toCDouble   = fromIntegral
   fromCDouble = truncate
@@ -130,6 +136,7 @@ instance GDALType Word16 where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Word32 where
+  type SizeOf Word32 = 4
   dataType    = GDT_UInt32
   toCDouble   = fromIntegral
   fromCDouble = truncate
@@ -138,6 +145,7 @@ instance GDALType Word32 where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Int16 where
+  type SizeOf Int16 = 2
   dataType    = GDT_Int16
   toCDouble   = fromIntegral
   fromCDouble = truncate
@@ -146,6 +154,7 @@ instance GDALType Int16 where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Int32 where
+  type SizeOf Int32 = 4
   dataType    = GDT_Int32
   toCDouble   = fromIntegral
   fromCDouble = truncate
@@ -154,6 +163,7 @@ instance GDALType Int32 where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Float where
+  type SizeOf Float = 4
   dataType    = GDT_Float32
   toCDouble   = realToFrac
   fromCDouble = realToFrac
@@ -162,6 +172,7 @@ instance GDALType Float where
   {-# INLINE fromCDouble #-}
 
 instance GDALType Double where
+  type SizeOf Double = 8
   dataType    = GDT_Float64
   -- We use coerce to work around https://ghc.haskell.org/trac/ghc/ticket/3676
   toCDouble   = coerce
@@ -171,6 +182,7 @@ instance GDALType Double where
   {-# INLINE fromCDouble #-}
 
 instance GDALType (Pair Int16) where
+  type SizeOf (Pair Int16) = 4
   dataType    = GDT_CInt16
   toCDouble   = fromIntegral . pFst
   fromCDouble = (:+: 0) . truncate
@@ -179,6 +191,7 @@ instance GDALType (Pair Int16) where
   {-# INLINE fromCDouble #-}
 
 instance GDALType (Pair Int32) where
+  type SizeOf (Pair Int32) = 8
   dataType    = GDT_CInt32
   toCDouble   = fromIntegral . pFst
   fromCDouble = (:+: 0) . truncate
@@ -187,6 +200,7 @@ instance GDALType (Pair Int32) where
   {-# INLINE fromCDouble #-}
 
 instance GDALType (Pair Float) where
+  type SizeOf (Pair Float) = 8
   dataType    = GDT_CFloat32
   toCDouble   = realToFrac . pFst
   fromCDouble = (:+: 0) . realToFrac
@@ -195,6 +209,7 @@ instance GDALType (Pair Float) where
   {-# INLINE fromCDouble #-}
 
 instance GDALType (Pair Double) where
+  type SizeOf (Pair Double) = 16
   dataType    = GDT_CFloat64
   toCDouble   = coerce . pFst
   fromCDouble = (:+: 0) . coerce