module Database.Shapefile.Shp.Handle
( ShpHandle
, openShp
, closeShp
, shpIsOpen
, shpHeader
, shpDbfFields
, getShpRecord
) where
import Database.Shapefile.Shp
import Database.Shapefile.Shx
import Database.Shapefile.Shx.Handle
import Database.XBase.Dbf.Handle
import System.IO
import System.FilePath
import Control.Monad
import Control.Concurrent.RWLock
import qualified Data.ByteString.Lazy as BS
import Data.Binary.Get
data ShpHandle = ShpHandle
{ shpReadOnly :: Bool
, shpLock :: RWLock
, shpFile :: Handle
, shxHandle :: ShxHandle
, dbfHandle :: DbfHandle
}
withShpFile_ :: ShpHandle -> IOMode -> (Handle -> IO a) -> IO a
withShpFile_ ShpHandle{..} mode action = withLock shpLock (action shpFile)
where withLock = case mode of
ReadMode -> withReadLock
_ -> withWriteLock
withShpFile :: ShpHandle -> IOMode -> (Handle -> IO a) -> IO a
withShpFile shp@ShpHandle{..} mode action = case (mode, shpReadOnly) of
(ReadMode, _) -> allow
(_, False) -> allow
(_, True) -> deny
where
allow = withShpFile_ shp mode action
deny = fail "withShpFile: write attempted on shp which was opened as read-only"
readShpBlock :: ShpHandle -> Integer -> Int -> IO BS.ByteString
readShpBlock shp pos len = withShpFile shp ReadMode $ \file -> do
hSeek file AbsoluteSeek pos
BS.hGet file len
openShp :: FilePath -> Bool -> IO ShpHandle
openShp file shpReadOnly = do
let mode | shpReadOnly = ReadMode
| otherwise = ReadWriteMode
shpFile <- openBinaryFile file mode
shxHandle <- openShx (file `replaceExtension` "shx") shpReadOnly
dbfHandle <- openDbf (file `replaceExtension` "dbf") shpReadOnly
shpLock <- newRWLockIO
return ShpHandle
{ shpReadOnly = shpReadOnly
, shpLock = shpLock
, shpFile = shpFile
, shxHandle = shxHandle
, dbfHandle = dbfHandle
}
closeShp :: ShpHandle -> IO ()
closeShp shp = do
withShpFile_ shp WriteMode hClose
closeShx (shxHandle shp)
closeDbf (dbfHandle shp)
shpIsOpen :: ShpHandle -> IO Bool
shpIsOpen ShpHandle{..} = hIsOpen shpFile
shpHeader :: ShpHandle -> IO ShpFileHeader
shpHeader shp = do
hdr <- readShpBlock shp 0 100
return (runGet getShpFileHeader hdr)
shpDbfFields :: ShpHandle -> IO [DbfFieldHandle]
shpDbfFields = dbfFields . dbfHandle
getShpRecord :: ShpHandle -> Int -> IO (ShpRec, Maybe DbfRecHandle)
getShpRecord shp n = do
shxRec <- getShxRecord (shxHandle shp) n
rec <- readShpBlock shp (shxOffsetBytes shxRec) (8 + fromInteger (shxLengthBytes shxRec))
dbfRec <- dbfGetRecord (dbfHandle shp) (toInteger n)
return (runGet getShpRec rec, dbfRec)