{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Database.Postgis.Trivial.Internal where
import GHC.Base hiding ( foldr )
import GHC.Num ( Num(..) )
import GHC.Show ( Show(show) )
import GHC.Real ( fromIntegral, Integral )
import System.Endian ( getSystemEndianness, Endianness(..) )
import Foreign ( Int64, Bits((.&.), (.|.)) )
import Control.Applicative ( (<$>) )
import Control.Monad (void )
import Control.Monad.Reader ( ReaderT(runReaderT), asks, MonadTrans(lift) )
import Control.Exception ( throw )
import Data.Foldable ( Foldable(..) )
import Data.ByteString.Lex.Integral ( packHexadecimal, readHexadecimal )
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BC
import Data.Binary ( Word8, Word32, Word64, Get, Put, byteSwap32, byteSwap64,
Binary(get, put) )
import Data.Binary.Get ( getLazyByteString, lookAhead )
import Data.Binary.Put ( putLazyByteString )
import Data.Maybe ( isJust )
import Data.Binary.IEEE754 ( wordToDouble, doubleToWord )
import Database.Postgis.Trivial.PGISConst
import Database.Postgis.Trivial.Types
type = Getter Header
newtype ByteOrder = ByteOrder Endianness deriving Int -> ByteOrder -> ShowS
[ByteOrder] -> ShowS
ByteOrder -> String
(Int -> ByteOrder -> ShowS)
-> (ByteOrder -> String)
-> ([ByteOrder] -> ShowS)
-> Show ByteOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteOrder -> ShowS
showsPrec :: Int -> ByteOrder -> ShowS
$cshow :: ByteOrder -> String
show :: ByteOrder -> String
$cshowList :: [ByteOrder] -> ShowS
showList :: [ByteOrder] -> ShowS
Show
data = {
Header -> ByteOrder
_byteOrder :: ByteOrder
, Header -> Word32
_geoType :: Word32
, Header -> SRID
_srid :: SRID
} deriving Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> String
show :: Header -> String
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show
instance Binary ByteOrder where
get :: Get ByteOrder
get = ByteString -> ByteOrder
forall a. Serializable a => ByteString -> a
fromBin (ByteString -> ByteOrder) -> Get ByteString -> Get ByteOrder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int64 -> Get ByteString
getLazyByteString Int64
2
put :: ByteOrder -> Put
put = ByteString -> Put
putLazyByteString (ByteString -> Put)
-> (ByteOrder -> ByteString) -> ByteOrder -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOrder -> ByteString
forall a. Serializable a => a -> ByteString
toBin
instance Binary Header where
get :: Get Header
get = Get Header
getHeader
put :: Header -> Put
put (Header ByteOrder
bo Word32
gt SRID
s) =
ByteOrder -> Put
forall t. Binary t => t -> Put
put ByteOrder
bo Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Putter Int
putInt Putter Int -> (Word32 -> Int) -> Word32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Word32
gt Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SRID -> Putter Int -> Put
forall a. Maybe a -> Putter a -> Put
putMaybe SRID
s Putter Int
putInt
class Serializable a where
toBin :: a -> BL.ByteString
fromBin :: BL.ByteString -> a
instance Serializable ByteOrder where
toBin :: ByteOrder -> ByteString
toBin (ByteOrder Endianness
BigEndian) = ByteString
"00" :: BL.ByteString
toBin (ByteOrder Endianness
LittleEndian) = ByteString
"01" :: BL.ByteString
fromBin :: ByteString -> ByteOrder
fromBin ByteString
bo = case ByteString -> Word8
forall a. Integral a => ByteString -> a
_fromBin ByteString
bo :: Word8 of
Word8
0 -> Endianness -> ByteOrder
ByteOrder Endianness
BigEndian
Word8
1 -> Endianness -> ByteOrder
ByteOrder Endianness
LittleEndian
Word8
_ -> GeometryError -> ByteOrder
forall a e. Exception e => e -> a
throw (GeometryError -> ByteOrder) -> GeometryError -> ByteOrder
forall a b. (a -> b) -> a -> b
$ String -> GeometryError
GeometryError (String -> GeometryError) -> String -> GeometryError
forall a b. (a -> b) -> a -> b
$ String
"Incorrect ByteOrder " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bo
instance Serializable Word32 where
toBin :: Word32 -> ByteString
toBin = Int -> Word32 -> ByteString
forall a. Integral a => Int -> a -> ByteString
_toBin Int
8
fromBin :: ByteString -> Word32
fromBin = ByteString -> Word32
forall a. Integral a => ByteString -> a
_fromBin
instance Serializable Word64 where
toBin :: Word64 -> ByteString
toBin = Int -> Word64 -> ByteString
forall a. Integral a => Int -> a -> ByteString
_toBin Int
16
fromBin :: ByteString -> Word64
fromBin = ByteString -> Word64
forall a. Integral a => ByteString -> a
_fromBin
_toBin :: Integral a => Int -> a -> BL.ByteString
_toBin :: forall a. Integral a => Int -> a -> ByteString
_toBin Int
l a
w = case Maybe ByteString
bsRes of
Just ByteString
s -> [ByteString] -> ByteString
BL.fromChunks [Int -> ByteString -> ByteString
pad Int
l ByteString
s]
Maybe ByteString
Nothing -> GeometryError -> ByteString
forall a e. Exception e => e -> a
throw (GeometryError -> ByteString) -> GeometryError -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> GeometryError
GeometryError String
"toBin: cannot convert word"
where
bsRes :: Maybe ByteString
bsRes = a -> Maybe ByteString
forall a. Integral a => a -> Maybe ByteString
packHexadecimal a
w
pad :: Int -> ByteString -> ByteString
pad Int
l' ByteString
bs' = ByteString -> ByteString -> ByteString
BS.append (Int -> Char -> ByteString
BC.replicate (Int
l' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
bs') Char
'0') ByteString
bs'
_fromBin :: Integral a => BL.ByteString -> a
_fromBin :: forall a. Integral a => ByteString -> a
_fromBin ByteString
bs = case Maybe (a, ByteString)
hexRes of
Just (a
v, ByteString
_) -> a
v
Maybe (a, ByteString)
Nothing -> GeometryError -> a
forall a e. Exception e => e -> a
throw (GeometryError -> a) -> GeometryError -> a
forall a b. (a -> b) -> a -> b
$ String -> GeometryError
GeometryError String
"fromBin: cannot parse hexadecimal"
where
hexRes :: Maybe (a, ByteString)
hexRes = ByteString -> Maybe (a, ByteString)
forall a. Integral a => ByteString -> Maybe (a, ByteString)
readHexadecimal (ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
{-# INLINE byteSwapFn #-}
byteSwapFn :: ByteOrder -> (a -> a) -> a -> a
byteSwapFn :: forall a. ByteOrder -> (a -> a) -> a -> a
byteSwapFn ByteOrder
bo a -> a
f = case ByteOrder
bo of
ByteOrder Endianness
BigEndian -> a -> a
forall a. a -> a
id
ByteOrder Endianness
LittleEndian -> a -> a
f
makeHeader :: SRID -> Word32 -> (Bool, Bool) -> Header
SRID
srid Word32
geoType (Bool
hasM, Bool
hasZ) =
ByteOrder -> Word32 -> SRID -> Header
Header (Endianness -> ByteOrder
ByteOrder Endianness
getSystemEndianness) Word32
gt SRID
srid where
wOr :: a -> (Bool, a) -> a
wOr a
acc (Bool
p, a
h) = if Bool
p then a
h a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
acc else a
acc
gt :: Word32
gt = (Word32 -> (Bool, Word32) -> Word32)
-> Word32 -> [(Bool, Word32)] -> Word32
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word32 -> (Bool, Word32) -> Word32
forall {a}. Bits a => a -> (Bool, a) -> a
wOr Word32
geoType
[(Bool
hasM, Word32
wkbM), (Bool
hasZ, Word32
wkbZ), (SRID -> Bool
forall a. Maybe a -> Bool
isJust SRID
srid, Word32
wkbSRID)]
{-# INLINE lookupType #-}
lookupType :: Header -> Word32
lookupType :: Header -> Word32
lookupType Header
h = Header -> Word32
_geoType Header
h Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
ewkbTypeOffset
putDouble :: Putter Double
putDouble :: Putter Double
putDouble = ByteString -> Put
putLazyByteString (ByteString -> Put) -> (Double -> ByteString) -> Putter Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
forall a. Serializable a => a -> ByteString
toBin (Word64 -> ByteString)
-> (Double -> Word64) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteOrder -> (Word64 -> Word64) -> Word64 -> Word64
forall a. ByteOrder -> (a -> a) -> a -> a
byteSwapFn (Endianness -> ByteOrder
ByteOrder Endianness
getSystemEndianness) Word64 -> Word64
byteSwap64 (Word64 -> Word64) -> (Double -> Word64) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word64
doubleToWord
putInt :: Putter Int
putInt :: Putter Int
putInt = ByteString -> Put
putLazyByteString (ByteString -> Put) -> (Int -> ByteString) -> Putter Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ByteString
forall a. Serializable a => a -> ByteString
toBin (Word32 -> ByteString) -> (Int -> Word32) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteOrder -> (Word32 -> Word32) -> Word32 -> Word32
forall a. ByteOrder -> (a -> a) -> a -> a
byteSwapFn (Endianness -> ByteOrder
ByteOrder Endianness
getSystemEndianness) Word32 -> Word32
byteSwap32 (Word32 -> Word32) -> (Int -> Word32) -> Int -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE putMaybe #-}
putMaybe :: Maybe a -> Putter a -> Put
putMaybe :: forall a. Maybe a -> Putter a -> Put
putMaybe Maybe a
mi = case Maybe a
mi of
Just a
i -> (Putter a -> Putter a
forall a b. (a -> b) -> a -> b
$ a
i)
Maybe a
Nothing -> \Putter a
_ -> () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE putChainLen #-}
putChainLen :: Putter Int
putChainLen :: Putter Int
putChainLen = Putter Int
putInt
putHeader :: SRID -> Word32 -> (Bool, Bool) -> Put
SRID
s Word32
geoType (Bool
hasMBool, Bool
hasZBool) =
Header -> Put
forall t. Binary t => t -> Put
put (Header -> Put) -> Header -> Put
forall a b. (a -> b) -> a -> b
$ SRID -> Word32 -> (Bool, Bool) -> Header
makeHeader SRID
s Word32
geoType (Bool
hasMBool, Bool
hasZBool)
putPoint :: Putter (Double, Double, Maybe Double, Maybe Double)
putPoint :: Putter (Double, Double, Maybe Double, Maybe Double)
putPoint (Double
x, Double
y, Maybe Double
Nothing, Maybe Double
Nothing) = Putter Double
putDouble Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
y
putPoint (Double
x, Double
y, Just Double
z, Maybe Double
Nothing) = Putter Double
putDouble Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
y Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
z
putPoint (Double
x, Double
y, Maybe Double
Nothing, Just Double
m) = Putter Double
putDouble Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
y Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
m
putPoint (Double
x, Double
y, Just Double
z, Just Double
m) = Putter Double
putDouble Double
x Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
y Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
z
Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Putter Double
putDouble Double
m
{-# INLINE putPointND #-}
putPointND :: PointND a => Putter a
putPointND :: forall a. PointND a => Putter a
putPointND a
a = Putter (Double, Double, Maybe Double, Maybe Double)
putPoint Putter (Double, Double, Maybe Double, Maybe Double)
-> Putter (Double, Double, Maybe Double, Maybe Double)
forall a b. (a -> b) -> a -> b
$ a -> (Double, Double, Maybe Double, Maybe Double)
forall a.
PointND a =>
a -> (Double, Double, Maybe Double, Maybe Double)
components a
a
getHeader :: Get Header
= do
ByteOrder
bo <- Get ByteOrder
forall t. Binary t => Get t
get
Word32
t <- Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Get Int -> Get Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteOrder -> Get Int
_getInt ByteOrder
bo
SRID
s <- if Word32
t Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
wkbSRID Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then Int -> SRID
forall a. a -> Maybe a
Just (Int -> SRID) -> (Int -> Int) -> Int -> SRID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SRID) -> Get Int -> Get SRID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteOrder -> Get Int
_getInt ByteOrder
bo
else SRID -> Get SRID
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return SRID
forall a. Maybe a
Nothing
Header -> Get Header
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ ByteOrder -> Word32 -> SRID -> Header
Header ByteOrder
bo Word32
t SRID
s
{-# INLINE skipHeader #-}
skipHeader :: HeaderGetter ()
= ReaderT Header Get Header -> HeaderGetter ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Get Header -> ReaderT Header Get Header
forall (m :: * -> *) a. Monad m => m a -> ReaderT Header m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Get Header
getHeader)
{-# INLINE getHeaderPre #-}
getHeaderPre :: Get Header
= Get Header -> Get Header
forall a. Get a -> Get a
lookAhead Get Header
forall t. Binary t => Get t
get
getPoint :: HeaderGetter (Double, Double, Maybe Double, Maybe Double)
getPoint :: HeaderGetter (Double, Double, Maybe Double, Maybe Double)
getPoint = do
Word32
gt <- (Header -> Word32) -> ReaderT Header Get Word32
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Header -> Word32
_geoType
let hasM :: Bool
hasM = (Word32
gt Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
wkbM) Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
hasZ :: Bool
hasZ = (Word32
gt Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
wkbZ) Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
Double
x <- HeaderGetter Double
getDouble
Double
y <- HeaderGetter Double
getDouble
Maybe Double
zMb <- if Bool
hasZ then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> HeaderGetter Double -> ReaderT Header Get (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeaderGetter Double
getDouble else Maybe Double -> ReaderT Header Get (Maybe Double)
forall a. a -> ReaderT Header Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
Maybe Double
mMb <- if Bool
hasM then Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double)
-> HeaderGetter Double -> ReaderT Header Get (Maybe Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeaderGetter Double
getDouble else Maybe Double -> ReaderT Header Get (Maybe Double)
forall a. a -> ReaderT Header Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
(Double, Double, Maybe Double, Maybe Double)
-> HeaderGetter (Double, Double, Maybe Double, Maybe Double)
forall a. a -> ReaderT Header Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
x, Double
y, Maybe Double
zMb, Maybe Double
mMb)
{-# INLINE getPointND #-}
getPointND :: PointND a => HeaderGetter a
getPointND :: forall a. PointND a => HeaderGetter a
getPointND = do
(Double
x, Double
y, Maybe Double
zMb, Maybe Double
mMb) <- HeaderGetter (Double, Double, Maybe Double, Maybe Double)
getPoint
a -> HeaderGetter a
forall a. a -> ReaderT Header Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> HeaderGetter a) -> a -> HeaderGetter a
forall a b. (a -> b) -> a -> b
$ (Double, Double, Maybe Double, Maybe Double) -> a
forall a.
PointND a =>
(Double, Double, Maybe Double, Maybe Double) -> a
fromComponents (Double
x, Double
y, Maybe Double
zMb, Maybe Double
mMb)
{-# INLINE getNumber #-}
getNumber :: (Serializable a) => (a -> a) -> Int64 -> ByteOrder -> Get a
getNumber :: forall a. Serializable a => (a -> a) -> Int64 -> ByteOrder -> Get a
getNumber a -> a
f Int64
l ByteOrder
bo = do
ByteString
bs <- Int64 -> Get ByteString
getLazyByteString Int64
l
case ByteOrder
bo of
ByteOrder Endianness
BigEndian -> a -> Get a
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> a -> Get a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall a. Serializable a => ByteString -> a
fromBin ByteString
bs
ByteOrder Endianness
LittleEndian -> a -> Get a
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Get a) -> (ByteString -> a) -> ByteString -> Get a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> a) -> (ByteString -> a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. Serializable a => ByteString -> a
fromBin (ByteString -> Get a) -> ByteString -> Get a
forall a b. (a -> b) -> a -> b
$ ByteString
bs
_getInt :: ByteOrder -> Get Int
_getInt :: ByteOrder -> Get Int
_getInt = (Word32 -> Int) -> Get Word32 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> Get Int)
-> (ByteOrder -> Get Word32) -> ByteOrder -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word32) -> Int64 -> ByteOrder -> Get Word32
forall a. Serializable a => (a -> a) -> Int64 -> ByteOrder -> Get a
getNumber Word32 -> Word32
byteSwap32 Int64
8
getInt :: HeaderGetter Int
getInt :: HeaderGetter Int
getInt = (Header -> ByteOrder) -> ReaderT Header Get ByteOrder
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Header -> ByteOrder
_byteOrder ReaderT Header Get ByteOrder
-> (ByteOrder -> HeaderGetter Int) -> HeaderGetter Int
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get Int -> HeaderGetter Int
forall (m :: * -> *) a. Monad m => m a -> ReaderT Header m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Get Int -> HeaderGetter Int)
-> (ByteOrder -> Get Int) -> ByteOrder -> HeaderGetter Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOrder -> Get Int
_getInt
_getDouble :: ByteOrder -> Get Double
_getDouble :: ByteOrder -> Get Double
_getDouble = (Word64 -> Double) -> Get Word64 -> Get Double
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Double
wordToDouble (Get Word64 -> Get Double)
-> (ByteOrder -> Get Word64) -> ByteOrder -> Get Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64) -> Int64 -> ByteOrder -> Get Word64
forall a. Serializable a => (a -> a) -> Int64 -> ByteOrder -> Get a
getNumber Word64 -> Word64
byteSwap64 Int64
16
getDouble :: HeaderGetter Double
getDouble :: HeaderGetter Double
getDouble = (Header -> ByteOrder) -> ReaderT Header Get ByteOrder
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Header -> ByteOrder
_byteOrder ReaderT Header Get ByteOrder
-> (ByteOrder -> HeaderGetter Double) -> HeaderGetter Double
forall a b.
ReaderT Header Get a
-> (a -> ReaderT Header Get b) -> ReaderT Header Get b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Get Double -> HeaderGetter Double
forall (m :: * -> *) a. Monad m => m a -> ReaderT Header m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Get Double -> HeaderGetter Double)
-> (ByteOrder -> Get Double) -> ByteOrder -> HeaderGetter Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOrder -> Get Double
_getDouble
{-# INLINE getChainLen #-}
getChainLen :: HeaderGetter Int
getChainLen :: HeaderGetter Int
getChainLen = HeaderGetter Int
getInt
makeResult :: Header -> HeaderGetter a -> Get (a, SRID)
makeResult :: forall a. Header -> HeaderGetter a -> Get (a, SRID)
makeResult Header
h HeaderGetter a
getter = (,Header -> SRID
_srid Header
h) (a -> (a, SRID)) -> Get a -> Get (a, SRID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeaderGetter a -> Header -> Get a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT HeaderGetter a
getter Header
h