{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Poseidon.Postgis where
import GHC.Generics
import Data.Geospatial.Internal.Geometry
import Control.Monad
import Database.Poseidon.Internal
import Database.Poseidon
import Prelude (error)
import System.IO
import Text.Show
import Control.Applicative
import Data.Function
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Monoid
import Data.Either
import Data.Maybe
import Data.Binary.Get
import Data.Wkb
newtype PGGeospatialGeometry = PGGeospatialGeometry GeospatialGeometry
deriving (Generic, Show)
toGeospatialGeometry :: PGGeospatialGeometry -> GeospatialGeometry
toGeospatialGeometry pgGeospatialGeometry = case pgGeospatialGeometry of
PGGeospatialGeometry value' -> value'
deserializeGeospatialGeometry :: BSL.ByteString -> PGGeospatialGeometry
deserializeGeospatialGeometry bs = do
let eitherParsed = parseByteString bs
case eitherParsed of
Right location' -> PGGeospatialGeometry $ location'
Left _ -> error "Impossible to decode location"
instance Deserialize PGGeospatialGeometry where
deserialize res row col = do
bs <- (fromMaybe mempty) <$> getBSValue res row col
pure $ deserializeGeospatialGeometry bs
instance Deserialize (Maybe PGGeospatialGeometry) where
deserialize res row col = do
bs <- getBSValue res row col
pure $ deserializeGeospatialGeometry <$> bs
parseWkbByteString :: BSL.ByteString -> IO PGGeospatialGeometry
parseWkbByteString bs = do
let eitherBS = parseByteString bs
case eitherBS of
Right wkb -> pure $ PGGeospatialGeometry wkb
Left errorStr -> error errorStr
instance Deserialize [PGGeospatialGeometry] where
deserialize res row col = do
bs <- (fromMaybe mempty) <$> getBSValue res row col
let pgArray = runGet getPGArray bs
let words8 = fmap pgArrayDataData $ pgArrayData pgArray
let bsList = BS.pack <$> words8
sequence $ (parseWkbByteString . BSL.fromStrict) <$> bsList