ReadDbf.hs

{-|
Module      : Geometry.Shapefile.ReadDbf
Description : Code for reading DBF files.
              Not robust, handle with care. YMMV
              Based on http://www.dbf2002.com/dbf-file-format.html
Author      : Sam van Herwaarden <samvherwaarden@gmail.com>
-}

module Geometry.Shapefile.ReadDbf ( readDbfFile,
                                    readDbfData
                                  ) where

import           Control.Monad               (replicateM)
import           Control.Monad.Loops         (whileM)
import           Data.Binary.Get             hiding (getInt8)
import qualified Data.ByteString.Lazy        as BL
import           Geometry.Shapefile.Internal
import           Geometry.Shapefile.Types

-- | Read dbf file at `fp` into resident data format `DbfData`
readDbfFile :: FilePath -> IO DbfData
readDbfFile fp = readDbfData <$> BL.readFile fp

-- | Parse a ByteString containing DBF data
readDbfData :: BL.ByteString -> DbfData
readDbfData = runGet $ do
  _           <- getByteString 4   -- DBF File type
  numRecs     <- getIntLE          -- Number of records
  firstRecPos <- getInt16LE        -- Position of first record
  _           <- getByteString 22  -- Rec len, table flags, code page mark
  -- Field descriptors
  let fieldsRemain = (< firstRecPos - 1) . fromIntegral <$> bytesRead
  fields      <- whileM fieldsRemain getDbfFieldDesc
  _           <- getWord8          -- Skip spacer
  -- Records
  recs        <- replicateM numRecs (getWord8 >> mapM getDbfRecord fields)
  -- Everything together
  pure DbfData { dbfNumRecs = numRecs
               , dbfFields  = fields
               , dbfRecords = recs
               }

-- | Read header field descriptor
getDbfFieldDesc :: Get DbfFieldDesc
getDbfFieldDesc = do
  name     <- getString 11     -- Field name
  fieldT   <- getCharVal       -- Field type
  _        <- getIntLE         -- Field displacement (?)
  len      <- getInt8          -- Field length
  _        <- getByteString 15 -- Num decimal/field flags/autoincrement
  pure DbfFieldDesc { fieldName = name
                    , fieldType = fieldT
                    , fieldLen  = len
                    }

-- | Read a record. Not all record types are (meaningfully) implemented.
getDbfRecord :: DbfFieldDesc -> Get DbfRecord
getDbfRecord field = let n = fieldLen field in
  case fieldType field of
    'C' -> DbfString <$> getString     n
    'N' -> DbfNum    <$> getString     n
    _   -> DbfBS     <$> getByteString n