diff --git a/cabal.project.local b/cabal.project.local --- a/cabal.project.local +++ b/cabal.project.local @@ -1,2 +1,4 @@ constraints: hgis +development +cairo +diagrams optimization: 2 + +max-backjumps: 120000 diff --git a/dbf/Geometry/Shapefile/Internal.hs b/dbf/Geometry/Shapefile/Internal.hs new file mode 100644 --- /dev/null +++ b/dbf/Geometry/Shapefile/Internal.hs @@ -0,0 +1,67 @@ +{-| +Module : Geometry.Shapefile.Internal +Description : Some functions for reuse inside the library +Author : Sam van Herwaarden +-} + +module Geometry.Shapefile.Internal ( getInt8 + , getIntBE + , getInt16BE + , getIntLE + , getInt16LE + , getString + , getPoint + , getCharVal + , getPointList + , steps + , Point + ) where + +import Control.Monad (replicateM) +import Data.Binary.Get hiding (getInt8) +import Data.Binary.IEEE754 (getFloat64le) +import qualified Data.ByteString.Char8 as ASCII + +-- | 8-bit Int value +getInt8 :: Get Int +getInt8 = fromIntegral <$> getWord8 + +-- | 32-bit big-endian Int +getIntBE :: Get Int +getIntBE = fromIntegral <$> getWord32be + +-- | 16-bit big-endian Int +getInt16BE :: Get Int +getInt16BE = fromIntegral <$> getWord16be + +-- | 32-bit little-endian Int +getIntLE :: Get Int +getIntLE = fromIntegral <$> getWord32le + +-- | 16-bit little-endian Int +getInt16LE :: Get Int +getInt16LE = fromIntegral <$> getWord16le + +-- | String of length `l` +getString :: Int -> Get String +getString = fmap (filter (/= '\NUL') . ASCII.unpack) . getByteString + +-- | Char (presumably 8-bit) +getCharVal :: Get Char +getCharVal = ASCII.head <$> getByteString 1 + +type Point = (Double, Double) + +-- | Two doubles making up a point with two coordinates +getPoint :: Get Point +getPoint = (,) <$> getFloat64le <*> getFloat64le + +-- | Get the increments between list values +steps :: Num a => [a] -> [a] +steps [] = [] +steps [_] = [] +steps (x1:x2:xs) = x2 - x1 : steps (x2:xs) + +-- | List of points of length `numPoints` +getPointList :: Int -> Get [Point] +getPointList = flip replicateM getPoint diff --git a/dbf/Geometry/Shapefile/MergeShpDbf.hs b/dbf/Geometry/Shapefile/MergeShpDbf.hs new file mode 100644 --- /dev/null +++ b/dbf/Geometry/Shapefile/MergeShpDbf.hs @@ -0,0 +1,27 @@ +{-| +Module : Geometry.Shapefile.MergeShpDbf +Description : Code for reading ESRI shapefiles with DBF data +Author : Sam van Herwaarden +-} + +module Geometry.Shapefile.MergeShpDbf ( readShpWithDbf ) where + +import qualified Data.ByteString.Lazy as BL +import Geometry.Shapefile.ReadDbf +import Geometry.Shapefile.ReadShp +import Geometry.Shapefile.Types +import System.FilePath + +-- | Read a shp-file from `fp`, and a dbf file from the same path but with +-- modified extension. +readShpWithDbf :: FilePath -> IO ShpData +readShpWithDbf fp = do + shpData <- readShpData <$> BL.readFile fp + let dbfPath = dropExtension fp <> ".dbf" + dbfData <- readDbfData <$> BL.readFile dbfPath + pure shpData { dbfFieldDescs = Just $ dbfFields dbfData + , shpRecs = zipWith addRecLabel (shpRecs shpData) (dbfRecords dbfData) + } + +addRecLabel :: ShpRec -> [DbfRecord] -> ShpRec +addRecLabel sr labels = sr { shpRecLabel = Just labels } -- FIXME add field name as string diff --git a/dbf/Geometry/Shapefile/ReadDbf.hs b/dbf/Geometry/Shapefile/ReadDbf.hs new file mode 100644 --- /dev/null +++ b/dbf/Geometry/Shapefile/ReadDbf.hs @@ -0,0 +1,63 @@ +{-| +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 +-} + +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 + diff --git a/dbf/Geometry/Shapefile/ReadShp.hs b/dbf/Geometry/Shapefile/ReadShp.hs new file mode 100644 --- /dev/null +++ b/dbf/Geometry/Shapefile/ReadShp.hs @@ -0,0 +1,247 @@ +{-| +Module : Geometry.Shapefile.ReadShp +Description : Code for reading the binary ESRI Shapefile format. + https://www.esri.com/library/whitepapers/pdfs/shapefile.pdf +Author : Sam van Herwaarden +-} + +module Geometry.Shapefile.ReadShp ( readShpFile, + readShpData, + ) where + +import Control.Monad (replicateM, replicateM_, when) +import Control.Monad.Loops (whileM) +import Data.Binary.Get +import Data.Binary.IEEE754 (getFloat64le) +import qualified Data.ByteString.Lazy as BL +import Geometry.Shapefile.Internal +import Geometry.Shapefile.Types + +-- | Read shapefile at `fp` to resident data structure `ShpData` +readShpFile :: String -> IO ShpData +readShpFile fp = readShpData <$> BL.readFile fp + +-- | Parse a shapefile ByteString +readShpData :: BL.ByteString -> ShpData +readShpData = runGet $ do + shpH <- getShpHeader + shpRs <- whileM (not <$> isEmpty) getShpRec + pure ShpData { shpHeader = shpH + , dbfFieldDescs = Nothing -- fill using readDbfData + , shpRecs = shpRs + } + +-- | Header of the shapefile +getShpHeader :: Get ShpHeader +getShpHeader = do + fc <- getIntBE -- File code + when (fc /= 9994) (error "getShpHeader: Input file is not a SHP file") + replicateM_ 5 getWord32be -- Unused data + shpLen <- getIntBE -- File length + shpV <- getIntLE -- Version (little-endian!) + shpT <- getShpType -- Shape type + shpbb <- getShpBBox shpT -- Bounding box + pure ShpHeader { shpFileLength = shpLen + , shpVersion = shpV + , shpType = shpT + , shpBB = shpbb + } + +-- | Get type of the record(s) +getShpType :: Get ShpType +getShpType = shpTypeFromId <$> getIntLE + +-- | Read a bounding box for relevant record type. +-- Not all bounding boxes have Z/M coordinates. +getShpBBox :: ShpType -> Get ShpBBox +getShpBBox t = do + [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le + [zMin, zMax] <- let ds = replicateM 2 getFloat64le + in if t `elem` zTypes + then fmap Just <$> ds + else ds >> pure [Nothing, Nothing] + [mMin, mMax] <- let ds = replicateM 2 getFloat64le + in if t `elem` mTypes + then fmap Just <$> ds + else ds >> pure [Nothing, Nothing] + pure ShpBBox { shpXMin = xMin + , shpXMax = xMax + , shpYMin = yMin + , shpYMax = yMax + , shpZMin = zMin + , shpZMax = zMax + , shpMMin = mMin + , shpMMax = mMax + } + +-- | Read a single record +getShpRec :: Get ShpRec +getShpRec = do + recNum <- getIntBE -- Record number + recLen <- getIntBE -- Record length + recType <- getShpType -- Shape type + recContents <- if recType == ShpNull -- Record contents + then pure Nothing + else Just <$> getRecContents recType + pure ShpRec { shpRecNum = recNum + , shpRecLen = recLen + , shpRecContents = recContents + , shpRecLabel = Nothing + , shpRecType = recType + } + +-- | Get record contents for record of given type +getRecContents :: ShpType -> Get RecContents +getRecContents t = case t of + + ShpPoint -> RecPoint <$> getPoint + + ShpPointM -> do + p <- getPoint + m <- getFloat64le + pure RecPointM { pmPoint = p, pmM = m } + + ShpPointZ -> do + p <- getPoint + z <- getFloat64le + m <- getFloat64le + pure RecPointZ { pzPoint = p, pzZ = z, pzM = m } + + ShpMultiPoint -> do + (bb, nPoints, points) <- getPointsData + pure RecMultiPoint { recMPBBox = bb, + recMPNumPoints = nPoints, + recMPPoints = points } + + ShpMultiPointM -> do + (bb, nPoints, points) <- getPointsData + (mMin, mMax, ms) <- getMData nPoints + pure RecMultiPointM { recMPMBBox = bb, + recMPMNumPoints = nPoints, + recMPMPoints = points, + recMPMMRange = (mMin, mMax), + recMPMMs = ms} + + ShpMultiPointZ -> do + (bb, nPoints, points) <- getPointsData + (zMin, zMax, zs) <- getZData nPoints + (mMin, mMax, ms) <- getMData nPoints + pure RecMultiPointZ { recMPZBBox = bb, + recMPZNumPoints = nPoints, + recMPZPoints = points, + recMPZZRange = (zMin, zMax), + recMPZZs = zs, + recMPZMRange = (mMin, mMax), + recMPZMs = ms } + + ShpPolyLine -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + pure RecPolyLine { recPolLBBox = bb, + recPolLNumParts = nParts, + recPolLNumPoints = nPoints, + recPolLPartLengths = partLengths, + recPolLPoints = pntLists } + + ShpPolyLineM -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + (mMin, mMax, ms) <- getMData nPoints + pure RecPolyLineM { recPolLMBBox = bb, + recPolLMNumParts = nParts, + recPolLMNumPoints = nPoints, + recPolLMPartLengths = partLengths, + recPolLMPoints = pntLists, + recPolLMMRange = (mMin, mMax), + recPolLMMs = ms } + + ShpPolyLineZ -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + (zMin, zMax, zs) <- getZData nPoints + (mMin, mMax, ms) <- getMData nPoints + pure RecPolyLineZ { recPolLZBBox = bb, + recPolLZNumParts = nParts, + recPolLZNumPoints = nPoints, + recPolLZPartLengths = partLengths, + recPolLZPoints = pntLists, + recPolLZZRange = (zMin, zMax), + recPolLZZs = zs, + recPolLZMRange = (mMin, mMax), + recPolLZMs = ms } + + ShpPolygon -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + pure RecPolygon { recPolBBox = bb, + recPolNumParts = nParts, + recPolNumPoints = nPoints, + recPolPartLengths = partLengths, + recPolPoints = pntLists } + + ShpPolygonM -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + (mMin, mMax, ms) <- getMData nPoints + pure RecPolygonM { recPolMBBox = bb, + recPolMNumParts = nParts, + recPolMNumPoints = nPoints, + recPolMPartLengths = partLengths, + recPolMPoints = pntLists, + recPolMMRange = (mMin, mMax), + recPolMMs = ms } + + ShpPolygonZ -> do + (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData + (zMin, zMax, zs) <- getZData nPoints + (mMin, mMax, ms) <- getMData nPoints + pure RecPolygonZ { recPolZBBox = bb, + recPolZNumParts = nParts, + recPolZNumPoints = nPoints, + recPolZPartLengths = partLengths, + recPolZPoints = pntLists, + recPolZZRange = (zMin, zMax), + recPolZZs = zs, + recPolZMRange = (mMin, mMax), + recPolZMs = ms } + + ShpNull -> + pure RecNull + + ShpMultiPatch -> + error "getShpRec: MultiPatch type is not supported, sorry!" + +-- | Recurring pattern of bounding box with a number of points +getPointsData :: Get (RecBBox, Int, [Point]) +getPointsData = do + bb <- getRecBBox + nPoints <- getIntLE + points <- replicateM nPoints getPoint + pure (bb, nPoints, points) + +-- | Recurring pattern of a bounding box with polygon data +getPolyData :: Get (RecBBox, Int, Int, [Int], [[Point]]) +getPolyData = do + bb <- getRecBBox + nParts <- getIntLE + nPoints <- getIntLE + partIndices <- replicateM nParts getIntLE + let partLengths = steps $ partIndices <> [nPoints] + pntLists <- traverse getPointList partLengths + pure (bb, nParts, nPoints, partLengths, pntLists) + +-- | Recurring pattern of M-valued data +getMData :: Int -> Get (Double, Double, [Double]) +getMData nPoints = do + [mMin, mMax] <- replicateM 2 getFloat64le + ms <- replicateM nPoints getFloat64le + pure (mMin, mMax, ms) + +-- | Recurring pattern of Z-valued data (same structure as M-valued data) +getZData :: Int -> Get (Double, Double, [Double]) +getZData = getMData + +-- | Record bounding boxes contain no information on M/Z +getRecBBox :: Get RecBBox +getRecBBox = do + [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le + pure RecBBox { recXMin = xMin, + recXMax = xMax, + recYMin = yMin, + recYMax = yMax } + diff --git a/dbf/Geometry/Shapefile/Types.hs b/dbf/Geometry/Shapefile/Types.hs new file mode 100644 --- /dev/null +++ b/dbf/Geometry/Shapefile/Types.hs @@ -0,0 +1,217 @@ +{-| +Module : Geometry.Shapefile.Types +Description : Type definitions used by the library. Currently (24 Nov 2015) + MultiPatch record types are not implemented. Only Point and + Polygon are (somewhat) tested. YMMV + https://www.esri.com/library/whitepapers/pdfs/shapefile.pdf +Author : Sam van Herwaarden +-} + +module Geometry.Shapefile.Types ( ShpData (..) + , ShpHeader (..) + , ShpType (..) + , zTypes + , mTypes + , shpTypeFromId + , RecBBox (..) + , RecContents (..) + , ShpRec (..) + , ShpBBox (..) + , DbfFieldDesc (..) + , DbfData (..) + , DbfRecord (..) + ) where + +import qualified Data.ByteString as BS +import Geometry.Shapefile.Internal + +-- * SHP Types + +data ShpData = + ShpData { + shpHeader :: ShpHeader, + dbfFieldDescs :: Maybe [DbfFieldDesc], + shpRecs :: [ShpRec] + } + +data ShpHeader = + ShpHeader { + shpFileLength :: Int, + shpVersion :: Int, + shpType :: ShpType, + shpBB :: ShpBBox + } + +data ShpType = ShpNull + | ShpPoint + | ShpPolyLine + | ShpPolygon + | ShpMultiPoint + | ShpPointZ + | ShpPolyLineZ + | ShpPolygonZ + | ShpMultiPointZ + | ShpPointM + | ShpPolyLineM + | ShpPolygonM + | ShpMultiPointM + | ShpMultiPatch + deriving (Eq) + +-- | Types with Z values +zTypes :: [ShpType] +zTypes = [ShpPointZ, ShpPolyLineZ, ShpPolygonZ, ShpMultiPointZ] + +-- | Types with M values +mTypes :: [ShpType] +mTypes = [ShpPointM, ShpPolyLineM, ShpPolygonM, ShpMultiPointM] + +-- | Numeric codes used for record types +shpTypeFromId :: Int -> ShpType +shpTypeFromId i = + case i of 0 -> ShpNull + 1 -> ShpPoint + 3 -> ShpPolyLine + 5 -> ShpPolygon + 8 -> ShpMultiPoint + 11 -> ShpPointZ + 13 -> ShpPolyLineZ + 15 -> ShpPolygonZ + 18 -> ShpMultiPointZ + 21 -> ShpPointM + 23 -> ShpPolyLineM + 25 -> ShpPolygonM + 28 -> ShpMultiPointM + 31 -> ShpMultiPatch + _ -> error "shpTypeFromId: Unknown Shape Type" + +data ShpBBox = + ShpBBox { + shpXMin :: Double, + shpXMax :: Double, + shpYMin :: Double, + shpYMax :: Double, + shpZMin :: Maybe Double, + shpZMax :: Maybe Double, + shpMMin :: Maybe Double, + shpMMax :: Maybe Double + } + + +data ShpRec = + ShpRec { + shpRecNum :: Int, + shpRecLen :: Int, + shpRecContents :: Maybe RecContents, -- Can be null type + shpRecLabel :: Maybe [DbfRecord], -- Should be usable without dbf + shpRecType :: ShpType + } + +data RecContents = + RecNull + | RecPoint Point + | RecPointM { + pmPoint :: Point, + pmM :: Double } + | RecPointZ { + pzPoint :: Point, + pzZ :: Double, + pzM :: Double } + | RecMultiPoint { + recMPBBox :: RecBBox, + recMPNumPoints :: Int, + recMPPoints :: [Point] } + | RecMultiPointM { + recMPMBBox :: RecBBox, + recMPMNumPoints :: Int, + recMPMPoints :: [Point], + recMPMMRange :: (Double, Double), + recMPMMs :: [Double] } + | RecMultiPointZ { + recMPZBBox :: RecBBox, + recMPZNumPoints :: Int, + recMPZPoints :: [Point], + recMPZZRange :: (Double, Double), + recMPZZs :: [Double], + recMPZMRange :: (Double, Double), + recMPZMs :: [Double] } + | RecPolyLine { + recPolLBBox :: RecBBox, + recPolLNumParts :: Int, + recPolLNumPoints :: Int, + recPolLPartLengths :: [Int], + recPolLPoints :: [[Point]] } + | RecPolyLineM { + recPolLMBBox :: RecBBox, + recPolLMNumParts :: Int, + recPolLMNumPoints :: Int, + recPolLMPartLengths :: [Int], + recPolLMPoints :: [[Point]], + recPolLMMRange :: (Double, Double), + recPolLMMs :: [Double] } + | RecPolyLineZ { + recPolLZBBox :: RecBBox, + recPolLZNumParts :: Int, + recPolLZNumPoints :: Int, + recPolLZPartLengths :: [Int], + recPolLZPoints :: [[Point]], + recPolLZZRange :: (Double, Double), + recPolLZZs :: [Double], + recPolLZMRange :: (Double, Double), + recPolLZMs :: [Double] } + | RecPolygon { + recPolBBox :: RecBBox, + recPolNumParts :: Int, + recPolNumPoints :: Int, + recPolPartLengths :: [Int], + recPolPoints :: [[Point]] } + | RecPolygonM { + recPolMBBox :: RecBBox, + recPolMNumParts :: Int, + recPolMNumPoints :: Int, + recPolMPartLengths :: [Int], + recPolMPoints :: [[Point]], + recPolMMRange :: (Double, Double), + recPolMMs :: [Double] } + | RecPolygonZ { + recPolZBBox :: RecBBox, + recPolZNumParts :: Int, + recPolZNumPoints :: Int, + recPolZPartLengths :: [Int], + recPolZPoints :: [[Point]], + recPolZZRange :: (Double, Double), + recPolZZs :: [Double], + recPolZMRange :: (Double, Double), + recPolZMs :: [Double] } + -- RecMultiPatch + +data RecBBox = + RecBBox { + recXMin :: Double, + recXMax :: Double, + recYMin :: Double, + recYMax :: Double + } + +-- * DBF Types + +data DbfData = + DbfData { + dbfNumRecs :: Int, + dbfFields :: [DbfFieldDesc], + dbfRecords :: [[DbfRecord]] + } + +data DbfFieldDesc = + DbfFieldDesc { + fieldName :: String, + fieldType :: Char, + fieldLen :: Int + } + +-- | Not all record types are implemented. Use your favorite method to +-- convert any bytestring (and feel free to add functionality). +data DbfRecord = DbfString String + | DbfNum String + | DbfBS BS.ByteString + deriving (Show) diff --git a/dbf/LICENSE b/dbf/LICENSE new file mode 100644 --- /dev/null +++ b/dbf/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Sam van Herwaarden + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/docs/manual.tex b/docs/manual.tex --- a/docs/manual.tex +++ b/docs/manual.tex @@ -32,8 +32,8 @@ \begin{appendices} \section{Installation} - HGIS is supported and tested with nix and stack, available from - \url{http://nixos.org/nix/} and \url{https://haskellstack.org}, respectively. + HGIS is supported and tested with cabal, available from + \url{https://www.haskell.org/cabal/}. % opinionated: nix is best when you just want the binaries! \section{Using the libaries} diff --git a/hgis.cabal b/hgis.cabal --- a/hgis.cabal +++ b/hgis.cabal @@ -1,6 +1,6 @@ -cabal-version: 1.18 +cabal-version: 2.0 name: hgis -version: 1.0.0.1 +version: 1.0.0.2 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2016-2018 Vanessa McHale @@ -17,7 +17,7 @@ cabal.project.local extra-doc-files: README.md docs/manual.tex - src/depends/readshp/LICENSE + dbf/LICENSE source-repository head type: darcs @@ -42,23 +42,16 @@ GIS.Math.Projections GIS.Math.Spherical GIS.Hylo - hs-source-dirs: src src/depends/readshp + hs-source-dirs: src other-modules: GIS.Graphics.Types GIS.Math.Utils GIS.Utils GIS.Graphics.Plot GIS.Types - Geometry.Shapefile - Geometry.Shapefile.MergeShpDbf - Geometry.Shapefile.ReadDbf - Geometry.Shapefile.ReadShp - Geometry.Shapefile.Types - Geometry.Shapefile.Internal default-language: Haskell2010 default-extensions: DeriveGeneric OverloadedStrings - other-extensions: RankNTypes TemplateHaskell FlexibleInstances - RecordWildCards + other-extensions: RankNTypes FlexibleInstances RecordWildCards ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-export-lists build-depends: @@ -70,11 +63,7 @@ directory -any, colour -any, data-default -any, - binary -any, - bytestring -any, - data-binary-ieee754 -any, - filepath -any, - monad-loops -any + hgis-readshp -any if flag(cairo) exposed-modules: @@ -94,6 +83,24 @@ if flag(development) ghc-options: -Werror + +library hgis-readshp + exposed-modules: + Geometry.Shapefile.Types + Geometry.Shapefile.MergeShpDbf + Geometry.Shapefile.ReadShp + hs-source-dirs: dbf + other-modules: + Geometry.Shapefile.ReadDbf + Geometry.Shapefile.Internal + default-language: Haskell2010 + build-depends: + base -any, + binary -any, + bytestring -any, + data-binary-ieee754 -any, + monad-loops -any, + filepath -any test-suite hgis-test type: exitcode-stdio-1.0 diff --git a/src/GIS/Graphics/Plot.hs b/src/GIS/Graphics/Plot.hs --- a/src/GIS/Graphics/Plot.hs +++ b/src/GIS/Graphics/Plot.hs @@ -13,6 +13,7 @@ import Control.Arrow import Data.Colour.Names +import Data.Foldable (fold) import GIS.Graphics.Types hiding (title) import GIS.Math.Utils import GIS.Types @@ -52,6 +53,6 @@ -- concave. plotLabels :: [([Polygon], String)] -> Plot Double Double plotLabels points = toPlot texts - where pairs = fmap (flatten . first (shittyCentroid . concat)) points + where pairs = fmap (flatten . first (shittyCentroid . fold)) points fontStyle = font_size .~ 15 $ font_weight .~ FontWeightBold $ def texts = plot_annotation_values .~ pairs $ plot_annotation_style .~ fontStyle $ def diff --git a/src/GIS/Graphics/Types.hs b/src/GIS/Graphics/Types.hs --- a/src/GIS/Graphics/Types.hs +++ b/src/GIS/Graphics/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE TemplateHaskell #-} - -- | Module for types associated with generating maps. Includes lenses. module GIS.Graphics.Types ( Map (..) , projection @@ -19,7 +17,17 @@ , _labelledDistricts :: [([Polygon], String)] -- the data we actually want to map } -makeLenses ''Map +projection :: Lens' Map Projection +projection f s = fmap (\x -> s { _projection = x }) (f (_projection s)) + +title :: Lens' Map String +title f s = fmap (\x -> s { _title = x }) (f (_title s)) + +labelEntities :: Lens' Map Bool +labelEntities f s = fmap (\x -> s { _labelEntities = x }) (f (_labelEntities s)) + +labelledDistricts :: Lens' Map [([Polygon], String)] +labelledDistricts f s = fmap (\x -> s { _labelledDistricts = x }) (f (_labelledDistricts s)) instance Default Map where def = Map { _projection = id , _title = mempty , _labelEntities = False , _labelledDistricts = mempty } diff --git a/src/GIS/Hylo.hs b/src/GIS/Hylo.hs --- a/src/GIS/Hylo.hs +++ b/src/GIS/Hylo.hs @@ -16,6 +16,7 @@ import Control.Lens hiding (lens) import Data.Default +import Data.Foldable (fold) import Data.List import Data.Maybe import Geometry.Shapefile.MergeShpDbf @@ -30,17 +31,17 @@ -- | Get the areas of various objects and return a string suitable for printing districtArea :: [District] -> String -districtArea districts = concat . intercalate (pure "\n") $ fmap (pure . show . distA) districts +districtArea districts = fold . intercalate (pure "\n") $ fmap (pure . show . distA) districts where distA (District _ label _ area _) = (label, sum area) -- TODO figure out which one is the correct one -- | Get the perimeters of various objects and return a string suitable for printing districtPerimeter :: [District] -> String -districtPerimeter districts = concat . intercalate (pure "\n") $ fmap (pure . show . distP) districts +districtPerimeter districts = fold . intercalate (pure "\n") $ fmap (pure . show . distP) districts where distP (District _ label perimeter _ _) = (label, perimeter) -- | Label with relative compactness districtCompactness :: [District] -> String -districtCompactness districts = concat . intercalate (pure "\n") $ fmap (pure . show . distC) districts +districtCompactness districts = fold . intercalate (pure "\n") $ fmap (pure . show . distC) districts where distC (District _ label _ _ compacticity) = (label, compacticity) -- | Given a projection and lists of districts, draw a map. @@ -80,12 +81,12 @@ shapes = extract id perimeters = extract totalPerimeter areas = extract (fmap areaPolygon) - compacticity = extract (relativeCompactness . concat) + compacticity = extract (relativeCompactness . fold) pure $ zipWith5 District shapes districtLabels perimeters areas compacticity -- | Helper function for extracting from shapefiles. getPolygon :: RecContents -> [Polygon] -getPolygon RecPolygon {..} = recPolPoints +getPolygon RecPolygon {..} = recPolPoints getPolygon RecPolygonM {..} = recPolMPoints getPolygon RecPolygonZ {..} = recPolZPoints -getPolygon _ = error "shapefile contents not supported. please ensure the shapefile contains a list of polygons." +getPolygon _ = error "shapefile contents not supported. please ensure the shapefile contains a list of polygons." diff --git a/src/GIS/Math/Spherical.hs b/src/GIS/Math/Spherical.hs --- a/src/GIS/Math/Spherical.hs +++ b/src/GIS/Math/Spherical.hs @@ -57,7 +57,7 @@ perimeterPolygon :: Polygon -> Double perimeterPolygon [x1, x2] = distance x1 x2 perimeterPolygon (x1:x2:points) = perimeterPolygon (x2:points) + distance x1 x2 -perimeterPolygon _ = error "Attempted to take area of polygon with no points" +perimeterPolygon _ = error "Attempted to take area of polygon with no points" -- | Find the area of a polygon with rectangular coördinates given. This -- function will error if given a polygon with no points. @@ -67,10 +67,10 @@ areaPolyRectangular _ = error "Attempted to take area of polygon with no points" -- | Distance in kilometers between two points given in degrees. -distance :: (Double, Double) -> (Double, Double) -> Double +distance :: Point -> Point -> Double distance = (*6371) .* on centralAngle toRadians -- | Compute central angle from points given in radians -centralAngle :: (Double, Double) -> (Double, Double) -> Double +centralAngle :: Point -> Point -> Double centralAngle (long1, lat1) (long2, lat2) = acos $ sin lat1 * sin lat2 + cos lat1 * cos lat2 * cos (long1 - long2) diff --git a/src/GIS/Types.hs b/src/GIS/Types.hs --- a/src/GIS/Types.hs +++ b/src/GIS/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -- | Module containing types for various geometrical objects. Lenses included. module GIS.Types ( -- * Types @@ -19,7 +18,7 @@ type Point = (Double, Double) type Polygon = [Point] -type Projection = (Double, Double) -> (Double, Double) +type Projection = Point -> Point -- | Data type for one record in a shape file, also capable of storing basic -- information about the district. @@ -30,7 +29,11 @@ , _compactness :: Double } deriving (Generic, Show) -makeLensesFor [("_districtLabel", "districtLabel"), ("_area", "area")] ''District +districtLabel :: Lens' District String +districtLabel f s = fmap (\x -> s { _districtLabel = x }) (f (_districtLabel s)) + +area :: Lens' District [Double] +area f s = fmap (\x -> s { _area = x }) (f (_area s)) data DbfReadError = NotAPolygon | ShpNull diff --git a/src/depends/readshp/Geometry/Shapefile.hs b/src/depends/readshp/Geometry/Shapefile.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-| -Module : Geometry.Shapefile -Description : Code for reading ESRI shapefiles. - Developed for intelligence2integrity. -Author : Sam van Herwaarden --} -module Geometry.Shapefile ( module Geometry.Shapefile.MergeShpDbf, - module Geometry.Shapefile.ReadDbf, - module Geometry.Shapefile.ReadShp, - module Geometry.Shapefile.Types - ) where - -import Geometry.Shapefile.MergeShpDbf -import Geometry.Shapefile.ReadDbf -import Geometry.Shapefile.ReadShp -import Geometry.Shapefile.Types diff --git a/src/depends/readshp/Geometry/Shapefile/Internal.hs b/src/depends/readshp/Geometry/Shapefile/Internal.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile/Internal.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-| -Module : Geometry.Shapefile.Internal -Description : Some functions for reuse inside the library -Author : Sam van Herwaarden --} - -module Geometry.Shapefile.Internal ( getInt8 - , getIntBE - , getInt16BE - , getIntLE - , getInt16LE - , getString - , getPoint - , getCharVal - , getPointList - , steps - , Point - ) where - -import Control.Monad (replicateM) -import Data.Binary.Get hiding (getInt8) -import Data.Binary.IEEE754 (getFloat64le) -import qualified Data.ByteString.Char8 as C - --- | 8-bit Int value -getInt8 :: Get Int -getInt8 = fromIntegral <$> getWord8 - --- | 32-bit big-endian Int -getIntBE :: Get Int -getIntBE = fromIntegral <$> getWord32be - --- | 16-bit big-endian Int -getInt16BE :: Get Int -getInt16BE = fromIntegral <$> getWord16be - --- | 32-bit little-endian Int -getIntLE :: Get Int -getIntLE = fromIntegral <$> getWord32le - --- | 16-bit little-endian Int -getInt16LE :: Get Int -getInt16LE = fromIntegral <$> getWord16le - --- | String of length `l` -getString :: Int -> Get String -getString l = filter (/= '\NUL') . C.unpack <$> getByteString l - --- | Char (presumably 8-bit) -getCharVal :: Get Char -getCharVal = C.head <$> getByteString 1 - -type Point = (Double, Double) - --- | Two doubles making up a point with two coordinates -getPoint :: Get Point -getPoint = (,) <$> getFloat64le <*> getFloat64le - --- | Get the increments between list values -steps :: Num a => [a] -> [a] -steps [] = [] -steps [_] = [] -steps (x1:x2:xs) = x2 - x1 : steps (x2:xs) - --- | List of points of length `numPoints` -getPointList :: Int -> Get [Point] -getPointList numPoints = replicateM numPoints getPoint diff --git a/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs b/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile/MergeShpDbf.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-| -Module : Geometry.Shapefile.MergeShpDbf -Description : Code for reading ESRI shapefiles with DBF data -Author : Sam van Herwaarden --} - -module Geometry.Shapefile.MergeShpDbf ( readShpWithDbf ) where - -import qualified Data.ByteString.Lazy as BL -import Geometry.Shapefile.ReadDbf -import Geometry.Shapefile.ReadShp -import Geometry.Shapefile.Types -import System.FilePath - --- | Read a shp-file from `fp`, and a dbf file from the same path but with --- modified extension. -readShpWithDbf :: String -> IO ShpData -readShpWithDbf fp = do - shpData <- readShpData <$> BL.readFile fp - let dbfPath = dropExtension fp <> ".dbf" - dbfData <- readDbfData <$> BL.readFile dbfPath - pure shpData { - dbfFieldDescs = Just $ dbfFields dbfData, - shpRecs = zipWith addRecLabel (shpRecs shpData) (dbfRecords dbfData) - } - -addRecLabel :: ShpRec -> [DbfRecord] -> ShpRec -addRecLabel sr labels = sr { shpRecLabel = Just labels } -- FIXME add field name as string diff --git a/src/depends/readshp/Geometry/Shapefile/ReadDbf.hs b/src/depends/readshp/Geometry/Shapefile/ReadDbf.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile/ReadDbf.hs +++ /dev/null @@ -1,63 +0,0 @@ -{-| -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 --} - -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 :: String -> 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 - diff --git a/src/depends/readshp/Geometry/Shapefile/ReadShp.hs b/src/depends/readshp/Geometry/Shapefile/ReadShp.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile/ReadShp.hs +++ /dev/null @@ -1,243 +0,0 @@ -{-| -Module : Geometry.Shapefile.ReadShp -Description : Code for reading the binary ESRI Shapefile format. - https://www.esri.com/library/whitepapers/pdfs/shapefile.pdf -Author : Sam van Herwaarden --} - -module Geometry.Shapefile.ReadShp ( readShpFile, - readShpData, - ) where - -import Control.Monad (replicateM, replicateM_, when) -import Control.Monad.Loops (whileM) -import Data.Binary.Get -import Data.Binary.IEEE754 (getFloat64le) -import qualified Data.ByteString.Lazy as BL -import Geometry.Shapefile.Internal -import Geometry.Shapefile.Types - --- | Read shapefile at `fp` to resident data structure `ShpData` -readShpFile :: String -> IO ShpData -readShpFile fp = readShpData <$> BL.readFile fp - --- | Parse a shapefile ByteString -readShpData :: BL.ByteString -> ShpData -readShpData = runGet $ do - shpH <- getShpHeader - shpRs <- whileM (not <$> isEmpty) getShpRec - pure ShpData { shpHeader = shpH, - dbfFieldDescs = Nothing, -- fill using readDbfData - shpRecs = shpRs } - --- | Header of the shapefile -getShpHeader :: Get ShpHeader -getShpHeader = do - fc <- getIntBE -- File code - when (fc /= 9994) (error "getShpHeader: Input file is not a SHP file") - _ <- replicateM_ 5 getWord32be -- Unused data - shpLen <- getIntBE -- File length - shpV <- getIntLE -- Version (little-endian!) - shpT <- getShpType -- Shape type - shpbb <- getShpBBox shpT -- Bounding box - pure ShpHeader { shpFileLength = shpLen, - shpVersion = shpV, - shpType = shpT, - shpBB = shpbb } - --- | Get type of the record(s) -getShpType :: Get ShpType -getShpType = shpTypeFromId <$> getIntLE - --- | Read a bounding box for relevant record type. --- Not all bounding boxes have Z/M coordinates. -getShpBBox :: ShpType -> Get ShpBBox -getShpBBox t = do - [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le - [zMin, zMax] <- let ds = replicateM 2 getFloat64le - in if t `elem` zTypes - then fmap Just <$> ds - else ds >> pure [Nothing, Nothing] - [mMin, mMax] <- let ds = replicateM 2 getFloat64le - in if t `elem` mTypes - then fmap Just <$> ds - else ds >> pure [Nothing, Nothing] - pure ShpBBox { shpXMin = xMin, - shpXMax = xMax, - shpYMin = yMin, - shpYMax = yMax, - shpZMin = zMin, - shpZMax = zMax, - shpMMin = mMin, - shpMMax = mMax } - --- | Read a single record -getShpRec :: Get ShpRec -getShpRec = do - recNum <- getIntBE -- Record number - recLen <- getIntBE -- Record length - recType <- getShpType -- Shape type - recContents <- if recType == ShpNull -- Record contents - then pure Nothing - else Just <$> getRecContents recType - pure ShpRec { shpRecNum = recNum, - shpRecLen = recLen, - shpRecContents = recContents, - shpRecLabel = Nothing, - shpRecType = recType } - --- | Get record contents for record of given type -getRecContents :: ShpType -> Get RecContents -getRecContents t = case t of - - ShpPoint -> RecPoint <$> getPoint - - ShpPointM -> do - p <- getPoint - m <- getFloat64le - pure RecPointM { pmPoint = p, pmM = m } - - ShpPointZ -> do - p <- getPoint - z <- getFloat64le - m <- getFloat64le - pure RecPointZ { pzPoint = p, pzZ = z, pzM = m } - - ShpMultiPoint -> do - (bb, nPoints, points) <- getPointsData - pure RecMultiPoint { recMPBBox = bb, - recMPNumPoints = nPoints, - recMPPoints = points } - - ShpMultiPointM -> do - (bb, nPoints, points) <- getPointsData - (mMin, mMax, ms) <- getMData nPoints - pure RecMultiPointM { recMPMBBox = bb, - recMPMNumPoints = nPoints, - recMPMPoints = points, - recMPMMRange = (mMin, mMax), - recMPMMs = ms} - - ShpMultiPointZ -> do - (bb, nPoints, points) <- getPointsData - (zMin, zMax, zs) <- getZData nPoints - (mMin, mMax, ms) <- getMData nPoints - pure RecMultiPointZ { recMPZBBox = bb, - recMPZNumPoints = nPoints, - recMPZPoints = points, - recMPZZRange = (zMin, zMax), - recMPZZs = zs, - recMPZMRange = (mMin, mMax), - recMPZMs = ms } - - ShpPolyLine -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - pure RecPolyLine { recPolLBBox = bb, - recPolLNumParts = nParts, - recPolLNumPoints = nPoints, - recPolLPartLengths = partLengths, - recPolLPoints = pntLists } - - ShpPolyLineM -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - (mMin, mMax, ms) <- getMData nPoints - pure RecPolyLineM { recPolLMBBox = bb, - recPolLMNumParts = nParts, - recPolLMNumPoints = nPoints, - recPolLMPartLengths = partLengths, - recPolLMPoints = pntLists, - recPolLMMRange = (mMin, mMax), - recPolLMMs = ms } - - ShpPolyLineZ -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - (zMin, zMax, zs) <- getZData nPoints - (mMin, mMax, ms) <- getMData nPoints - pure RecPolyLineZ { recPolLZBBox = bb, - recPolLZNumParts = nParts, - recPolLZNumPoints = nPoints, - recPolLZPartLengths = partLengths, - recPolLZPoints = pntLists, - recPolLZZRange = (zMin, zMax), - recPolLZZs = zs, - recPolLZMRange = (mMin, mMax), - recPolLZMs = ms } - - ShpPolygon -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - pure RecPolygon { recPolBBox = bb, - recPolNumParts = nParts, - recPolNumPoints = nPoints, - recPolPartLengths = partLengths, - recPolPoints = pntLists } - - ShpPolygonM -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - (mMin, mMax, ms) <- getMData nPoints - pure RecPolygonM { recPolMBBox = bb, - recPolMNumParts = nParts, - recPolMNumPoints = nPoints, - recPolMPartLengths = partLengths, - recPolMPoints = pntLists, - recPolMMRange = (mMin, mMax), - recPolMMs = ms } - - ShpPolygonZ -> do - (bb, nParts, nPoints, partLengths, pntLists) <- getPolyData - (zMin, zMax, zs) <- getZData nPoints - (mMin, mMax, ms) <- getMData nPoints - pure RecPolygonZ { recPolZBBox = bb, - recPolZNumParts = nParts, - recPolZNumPoints = nPoints, - recPolZPartLengths = partLengths, - recPolZPoints = pntLists, - recPolZZRange = (zMin, zMax), - recPolZZs = zs, - recPolZMRange = (mMin, mMax), - recPolZMs = ms } - - ShpNull -> - pure RecNull - - ShpMultiPatch -> - error "getShpRec: MultiPatch type is not supported, sorry!" - --- | Recurring pattern of bounding box with a number of points -getPointsData :: Get (RecBBox, Int, [Point]) -getPointsData = do - bb <- getRecBBox - nPoints <- getIntLE - points <- replicateM nPoints getPoint - pure (bb, nPoints, points) - --- | Recurring pattern of a bounding box with polygon data -getPolyData :: Get (RecBBox, Int, Int, [Int], [[Point]]) -getPolyData = do - bb <- getRecBBox - nParts <- getIntLE - nPoints <- getIntLE - partIndices <- replicateM nParts getIntLE - let partLengths = steps $ partIndices <> [nPoints] - pntLists <- mapM getPointList partLengths - pure (bb, nParts, nPoints, partLengths, pntLists) - --- | Recurring pattern of M-valued data -getMData :: Int -> Get (Double, Double, [Double]) -getMData nPoints = do - [mMin, mMax] <- replicateM 2 getFloat64le - ms <- replicateM nPoints getFloat64le - pure (mMin, mMax, ms) - --- | Recurring pattern of Z-valued data (same structure as M-valued data) -getZData :: Int -> Get (Double, Double, [Double]) -getZData = getMData - --- | Record bounding boxes contain no information on M/Z -getRecBBox :: Get RecBBox -getRecBBox = do - [xMin, yMin, xMax, yMax] <- replicateM 4 getFloat64le - pure RecBBox { recXMin = xMin, - recXMax = xMax, - recYMin = yMin, - recYMax = yMax } - diff --git a/src/depends/readshp/Geometry/Shapefile/Types.hs b/src/depends/readshp/Geometry/Shapefile/Types.hs deleted file mode 100644 --- a/src/depends/readshp/Geometry/Shapefile/Types.hs +++ /dev/null @@ -1,220 +0,0 @@ -{-| -Module : Geometry.Shapefile.Types -Description : Type definitions used by the library. Currently (24 Nov 2015) - MultiPatch record types are not implemented. Only Point and - Polygon are (somewhat) tested. YMMV - https://www.esri.com/library/whitepapers/pdfs/shapefile.pdf -Author : Sam van Herwaarden --} - -module Geometry.Shapefile.Types ( ShpData (..) - , ShpHeader (..) - , ShpType (..) - , zTypes - , mTypes - , shpTypeFromId - , RecBBox (..) - , RecContents (..) - , ShpRec (..) - , ShpBBox (..) - , DbfFieldDesc (..) - , DbfData (..) - , DbfRecord (..) - ) where - -import qualified Data.ByteString as BS - -import Geometry.Shapefile.Internal - --- * SHP Types - -data ShpData = - ShpData { - shpHeader :: ShpHeader, - dbfFieldDescs :: Maybe [DbfFieldDesc], - shpRecs :: [ShpRec] - } deriving (Eq, Show) - -data ShpHeader = - ShpHeader { - shpFileLength :: Int, - shpVersion :: Int, - shpType :: ShpType, - shpBB :: ShpBBox - } deriving (Eq, Show) - -data ShpType = ShpNull - | ShpPoint - | ShpPolyLine - | ShpPolygon - | ShpMultiPoint - | ShpPointZ - | ShpPolyLineZ - | ShpPolygonZ - | ShpMultiPointZ - | ShpPointM - | ShpPolyLineM - | ShpPolygonM - | ShpMultiPointM - | ShpMultiPatch - deriving (Eq, Show) - --- | Types with Z values -zTypes :: [ShpType] -zTypes = [ShpPointZ, ShpPolyLineZ, ShpPolygonZ, ShpMultiPointZ] - --- | Types with M values -mTypes :: [ShpType] -mTypes = [ShpPointM, ShpPolyLineM, ShpPolygonM, ShpMultiPointM] - --- | Numeric codes used for record types -shpTypeFromId :: Int -> ShpType -shpTypeFromId i = - case i of 0 -> ShpNull - 1 -> ShpPoint - 3 -> ShpPolyLine - 5 -> ShpPolygon - 8 -> ShpMultiPoint - 11 -> ShpPointZ - 13 -> ShpPolyLineZ - 15 -> ShpPolygonZ - 18 -> ShpMultiPointZ - 21 -> ShpPointM - 23 -> ShpPolyLineM - 25 -> ShpPolygonM - 28 -> ShpMultiPointM - 31 -> ShpMultiPatch - _ -> error "shpTypeFromId: Unknown Shape Type" - -data ShpBBox = - ShpBBox { - shpXMin :: Double, - shpXMax :: Double, - shpYMin :: Double, - shpYMax :: Double, - shpZMin :: Maybe Double, - shpZMax :: Maybe Double, - shpMMin :: Maybe Double, - shpMMax :: Maybe Double - } deriving (Eq, Show) - - -data ShpRec = - ShpRec { - shpRecNum :: Int, - shpRecLen :: Int, - shpRecContents :: Maybe RecContents, -- Can be null type - shpRecLabel :: Maybe [DbfRecord], -- Should be usable without dbf - shpRecType :: ShpType - } deriving (Eq, Show) - -data RecContents = - RecNull - | RecPoint Point - | RecPointM { - pmPoint :: Point, - pmM :: Double } - | RecPointZ { - pzPoint :: Point, - pzZ :: Double, - pzM :: Double } - | RecMultiPoint { - recMPBBox :: RecBBox, - recMPNumPoints :: Int, - recMPPoints :: [Point] } - | RecMultiPointM { - recMPMBBox :: RecBBox, - recMPMNumPoints :: Int, - recMPMPoints :: [Point], - recMPMMRange :: (Double, Double), - recMPMMs :: [Double] } - | RecMultiPointZ { - recMPZBBox :: RecBBox, - recMPZNumPoints :: Int, - recMPZPoints :: [Point], - recMPZZRange :: (Double, Double), - recMPZZs :: [Double], - recMPZMRange :: (Double, Double), - recMPZMs :: [Double] } - | RecPolyLine { - recPolLBBox :: RecBBox, - recPolLNumParts :: Int, - recPolLNumPoints :: Int, - recPolLPartLengths :: [Int], - recPolLPoints :: [[Point]] } - | RecPolyLineM { - recPolLMBBox :: RecBBox, - recPolLMNumParts :: Int, - recPolLMNumPoints :: Int, - recPolLMPartLengths :: [Int], - recPolLMPoints :: [[Point]], - recPolLMMRange :: (Double, Double), - recPolLMMs :: [Double] } - | RecPolyLineZ { - recPolLZBBox :: RecBBox, - recPolLZNumParts :: Int, - recPolLZNumPoints :: Int, - recPolLZPartLengths :: [Int], - recPolLZPoints :: [[Point]], - recPolLZZRange :: (Double, Double), - recPolLZZs :: [Double], - recPolLZMRange :: (Double, Double), - recPolLZMs :: [Double] } - | RecPolygon { - recPolBBox :: RecBBox, - recPolNumParts :: Int, - recPolNumPoints :: Int, - recPolPartLengths :: [Int], - recPolPoints :: [[Point]] } - | RecPolygonM { - recPolMBBox :: RecBBox, - recPolMNumParts :: Int, - recPolMNumPoints :: Int, - recPolMPartLengths :: [Int], - recPolMPoints :: [[Point]], - recPolMMRange :: (Double, Double), - recPolMMs :: [Double] } - | RecPolygonZ { - recPolZBBox :: RecBBox, - recPolZNumParts :: Int, - recPolZNumPoints :: Int, - recPolZPartLengths :: [Int], - recPolZPoints :: [[Point]], - recPolZZRange :: (Double, Double), - recPolZZs :: [Double], - recPolZMRange :: (Double, Double), - recPolZMs :: [Double] } - -- RecMultiPatch - deriving (Eq, Show) - -data RecBBox = - RecBBox { - recXMin :: Double, - recXMax :: Double, - recYMin :: Double, - recYMax :: Double - } deriving (Eq, Show) - --- * DBF Types - -data DbfData = - DbfData { - dbfNumRecs :: Int, - dbfFields :: [DbfFieldDesc], - dbfRecords :: [[DbfRecord]] - } deriving (Eq, Show) - -data DbfFieldDesc = - DbfFieldDesc { - fieldName :: String, - fieldType :: Char, - fieldLen :: Int - } deriving (Eq, Show) - --- | Not all record types are implemented. Use your favorite method to --- convert any bytestring (and feel free to add functionality). -data DbfRecord = DbfString String - | DbfNum String - | DbfBS BS.ByteString - deriving (Eq, Show) - diff --git a/src/depends/readshp/LICENSE b/src/depends/readshp/LICENSE deleted file mode 100644 --- a/src/depends/readshp/LICENSE +++ /dev/null @@ -1,20 +0,0 @@ -Copyright (c) 2015 Sam van Herwaarden - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.