diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,55 @@ +# geojson [![Build Status](https://travis-ci.org/domdere/hs-geojson.png?branch=master)](https://travis-ci.org/domdere/hs-geojson) [![Hackage](https://budueba.com/hackage/geojson)](https://hackage.haskell.org/package/geojson) + +A thin GeoJSON Layer above the `aeson` library + +## Building the project + +Install the dependencies with: + + cabal install --dependencies-only + +Optionally add `--enable-tests` if you intend to run the unit tests + +The project must be "configured" at least once everytime `geojson.cabal` changes, this can be done with: + + cabal configure + +If you wish to run the unit tests you will have to run: + + cabal configure --enable-tests + +Then finally build it with: + + cabal build + +See `cabal build --help` for more build options. + +## Running Unit Tests + +**After** running `cabal build`, you can run the unit tests with the command: + + cabal test + +## Adding Unit tests + +Unit tests are written with [**doctest**] [doctest-github], for instructions on how to add unit tests +see the **doctest** [**User Guide**] [doctest-userguide]. + +Currently only files in the `src/` directory are searched for tests, it is assumed that the code in `main/` +is a thin layer of code that uses modules from `src/`. + +## Development: Cabal Dependency Hell? + +Cabal's great, but when you are developing a few different projects with their own dependency chains, sometimes installing all your libraries to the same place causes problems, + +Consider trying [`cabal-dev`] [cabal-dev]. In terms of using it, all thats required is replacing `cabal` with `cabal-dev` in all the above command lines. + +It will download and install all the dependencies for your project and install them in a `cabal-dev/` directory in your project directory, and they will only be used for this project. + +Those with newer versions of `cabal` (`>= 1.18` I think) can skip `cabal-dev` and instead run `cabal sandbox init`, and just start runnign the above instructions +as is from `cabal install --only-dependencies` + +[doctest-github]: https://github.com/sol/doctest-haskell "sol/doctest-haskell on GitHub.com" +[doctest-userguide]: https://github.com/sol/doctest-haskell/blob/master/README.markdown#usage "doctest Usage Guide" +[cabal-dev]: https://github.com/creswick/cabal-dev "creswick/cabal-dev on GitHub.com" + diff --git a/doctests/Main.hs b/doctests/Main.hs --- a/doctests/Main.hs +++ b/doctests/Main.hs @@ -8,6 +8,11 @@ import System.FilePath import Test.DocTest +extensions :: [String] +extensions = + [ "OverloadedStrings" + ] + docopts :: [FilePath] docopts = [ "-isrc" @@ -15,7 +20,7 @@ , "-optP-include" , "-optPdist/build/autogen/cabal_macros.h" , "-hide-all-packages" - ] ++ map ("-package=" ++) deps ++ opts + ] ++ map ("-package=" ++) deps ++ opts ++ map ("-X" ++) extensions -- the list of all file paths to search for source files sourceDirs :: [FilePath] diff --git a/etc/CHANGELOG.md b/etc/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/etc/CHANGELOG.md @@ -0,0 +1,9 @@ +# 1.0.x + +## 0.0.2 -> 2.0.0 + +- Migrated from `json` to `aeson`, all `JSON` instances were removed and replaced with `ToJSON` and `FromJSON` instances +- `GeoFeature` and `GeoFeatureCollection` are now of kind `* -> *`, parameterised on the Property type, `GeoFeature a` and `GeoFeatureCollection a` are in `ToJSON` and/or `FromJSON` if `a` is in `ToJSON` and/or `FromJSON` respectively. +- Lenses and prisms have been generated for each of the types. +- Orphan Instances were removed. Orphan Instances are bad. Breaking type class coherency had some rather annoying consequences, you only need to import `Data.Geospatial` now and the `ToJSON` and `FromJSON` instances will come with it. I wanted to split up the files and thought seperating the instances from the declarations was a good idea but it wasnt. Instead I split the data types into seperate modules and kept the instances with their respective data type declarations. + diff --git a/etc/LICENCE b/etc/LICENCE deleted file mode 100644 --- a/etc/LICENCE +++ /dev/null diff --git a/etc/LICENCE.md b/etc/LICENCE.md new file mode 100644 --- /dev/null +++ b/etc/LICENCE.md @@ -0,0 +1,20 @@ +# BSD 3-Clause License + +Copyright (c) 2014, Dom De Re +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, +OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/geojson.cabal b/geojson.cabal --- a/geojson.cabal +++ b/geojson.cabal @@ -1,12 +1,12 @@ name: geojson -version: 0.0.2 -license: MIT -license-file: etc/LICENCE +version: 1.0.0 +license: BSD3 +license-file: etc/LICENCE.md author: Dom De Re maintainer: Dom De Re -copyright: Copyright (C) 2010-2013 +copyright: Copyright (C) 2013-2014 synopsis: A thin GeoJSON Layer above the json library -category: Text +category: Data description: A thin GeoJSON Layer above the json library. . It currently conforms to version 1.0 of the GeoJSON spec which can be found here: @@ -20,10 +20,9 @@ bug-reports: https://github.com/domdere/hs-geojson/issues cabal-version: >= 1.10 build-type: Custom -tested-with: GHC == 7.4.1 - , GHC == 7.6.3 ---extra-source-files: etc/CONTRIBUTORS, --- etc/CREDITS +tested-with: GHC == 7.6.3 +extra-source-files: README.md, + etc/CHANGELOG.md source-repository head type: git @@ -41,7 +40,9 @@ default-language: Haskell2010 build-depends: base < 5 && >= 4 - , json + , aeson == 0.7.* + , lens == 4.1.* + , text == 1.1.* ghc-options: -Wall -fno-warn-unused-imports @@ -51,9 +52,22 @@ hs-source-dirs: src - exposed-modules: Text.GeoJSON - , Data.Geospatial + exposed-modules: Data.Geospatial + other-modules: Data.Geospatial.BasicTypes + , Data.Geospatial.CRS + , Data.Geospatial.GeoFeature + , Data.Geospatial.GeoFeatureCollection + , Data.Geospatial.Geometry + , Data.Geospatial.Geometry.GeoMultiLine + , Data.Geospatial.Geometry.GeoMultiPoint + , Data.Geospatial.Geometry.GeoMultiPolygon + , Data.Geospatial.Geometry.GeoLine + , Data.Geospatial.Geometry.GeoPoint + , Data.Geospatial.Geometry.GeoPolygon + , Data.Geospatial.Geometry.Aeson + , Data.Geospatial.GeoPosition + test-suite doctests type: exitcode-stdio-1.0 @@ -64,12 +78,12 @@ default-language: Haskell2010 - build-depends: - base < 5 && >= 3, - doctest >= 0.9.7, - filepath >= 1.3, - directory >= 1.1, - QuickCheck >= 2.0 + build-depends: base < 5 && >= 3 + , bytestring == 0.10.* + , doctest >= 0.9.7 + , filepath >= 1.3 + , directory >= 1.1 + , QuickCheck >= 2.0 ghc-options: -Wall diff --git a/src/Data/Geospatial.hs b/src/Data/Geospatial.hs --- a/src/Data/Geospatial.hs +++ b/src/Data/Geospatial.hs @@ -1,147 +1,77 @@ +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- -- Refer to the GeoJSON Spec http://www.geojson.org/geojson-spec.html - -module Data.Geospatial ( - -- Types - Latitude - , Longitude - , Easting - , Northing - , Altitude - , GeoPositionWithoutCRS - , GeoPosition(..) - , GeoPoint(..) - , GeoMultiPoint(..) - , GeoPolygon(..) - , GeoMultiPolygon(..) - , GeoLine(..) - , GeoMultiLine(..) - , GeoPolyLine(..) - , GeospatialGeometry(..) - , Name - , Code - , Href - , FormatString - , ProjectionType - , CRSObject(..) - , FeatureID - , GeoProperty(..) - , GeoPropertyObject - , BoundingBoxWithoutCRS - , GeoFeature(..) - , GeoFeatureCollection(..) - -- Functions - , stripCRSFromPosition - , defaultCRS - ) where - -import Text.JSON - -type Latitude = Float -type Longitude = Float -type Easting = Float -type Northing = Float -type Altitude = Float - --- | ("WithoutCRS" is a catch all for indeterminate CRSs and for expression of positions --- before a CRS has been determined - -type GeoPositionWithoutCRS = [Float] - --- | see Section 2.1.1 "Position" in the GeoJSON Spec, --- I make the assumption here that the only position types we will use will --- involve easting/northing (+/- Altitude) or lon/lat (+/- Altitude) -data GeoPosition = - LonLat Longitude Latitude - | LonLatAlt Longitude Latitude Altitude - | EastingNorthing Easting Northing - | EastingNorthingAlt Easting Northing Altitude - --- | the GeoPosition is a bit special in that when you convert it to GeoJSON, --- it will lose the CRS info attached to it and cannot be read back in --- from the GeoJSON. Hence it is ineligible for the JSON type class, --- so this function will strip it down to a GeoPositionWithoutCRS, which is eligible -stripCRSFromPosition :: GeoPosition -> GeoPositionWithoutCRS -stripCRSFromPosition (LonLat lon lat) = [lon, lat] -stripCRSFromPosition (LonLatAlt lon lat alt) = [lon, lat, alt] -stripCRSFromPosition (EastingNorthing easting northing) = [easting, northing] -stripCRSFromPosition (EastingNorthingAlt easting northing alt) = [easting, northing, alt] - --- These are all using newtype so that I can override their JSON instances.. - -newtype GeoPoint = GeoPoint GeoPositionWithoutCRS deriving (Show, Eq) -newtype GeoMultiPoint = GeoMultiPoint [GeoPoint] deriving (Show, Eq) -newtype GeoPolygon = GeoPolygon [GeoPositionWithoutCRS] deriving (Show, Eq) -newtype GeoMultiPolygon = GeoMultiPolygon [GeoPolygon] deriving (Show, Eq) -newtype GeoLine = GeoLine [GeoPositionWithoutCRS] deriving (Show, Eq) -newtype GeoMultiLine = GeoMultiLine [GeoLine] deriving (Show, Eq) - -data GeoPolyLine = Poly GeoPolygon | LineString GeoLine - --- | See section 2.1 "Geometry Objects" in the GeoJSON Spec. -data GeospatialGeometry = - NoGeometry - | Point GeoPoint - | MultiPoint GeoMultiPoint - | Polygon GeoPolygon - | MultiPolygon GeoMultiPolygon - | Line GeoLine - | MultiLine GeoMultiLine - | Collection [GeospatialGeometry] deriving (Show, Eq) - -type Name = String -type Code = Int -type Href = String -type FormatString = String -type ProjectionType = String - --- | See Section 3 "Coordinate Reference System Objects" in the GeoJSON Spec --- "NoCRS" is required because no 'crs' attribute in a GeoJSON feature is NOT the same thing as --- a null 'crs' attribute. no 'crs' value implies the default CRS, while a null CRS means --- you cannot assume a CRS, null will mapped to NoCRS while a non-existent attribute will --- be mapped to a Nothing Maybe value -data CRSObject = - NoCRS - | NamedCRS Name - | EPSG Code - | LinkedCRS Href FormatString deriving (Show, Eq) - --- | The default CRS according to Section 3 "Coordinate Reference System Objects" is WGS84 which I believe, --- from http://spatialreference.org/ref/epsg/4326/ -> [JSON](http://spatialreference.org/ref/epsg/4326/json/ "WGS84 in JSON") --- is represented thus: -defaultCRS :: CRSObject -defaultCRS = EPSG 4326 - -type FeatureID = String - -data GeoProperty = - StringProperty String - | FloatProperty Float - | DoubleProperty Double - | IntProperty Int - | PropertyObject GeoPropertyObject deriving (Show, Eq) - --- | According to section 2.2 "Feature Objects" of the GeoJSON spec, the "properties" object --- can be any JSON object, or a null value, we may as well just make it a Type Alias --- for JSValue, even though it has a wider scope (Integer, Rational, String etc...) --- to take advantage of the solid JSON code out there to handle generic objects and the null value -type GeoPropertyObject = JSValue - --- | See Section 4 "Bounding Boxes" of the GeoJSON spec, --- The length of the list/array must be 2*n where n is the dimensionality of the position type for the CRS --- with min values first followed by the max values, wich both the min/max sets following the same axis order as the CRS, --- e.g for WGS84: minLongitude, minLatitude, maxLongitude, maxLatitude --- The spec mentions that it can be part of a geometry object too but doesnt give an example, --- This implementation will ignore bboxes on Geometry objects, they can be added if required. -type BoundingBoxWithoutCRS = [Float] - --- | See Section 2.2 "Feature Objects" of the GeoJSON spec. -data GeoFeature = GeoFeature { - bbox :: Maybe BoundingBoxWithoutCRS, - geometry :: GeospatialGeometry, - properties :: GeoPropertyObject, - featureId :: Maybe FeatureID } deriving (Show, Eq) - --- | See Section 2.3 "Feature Collection Objects" of the GeoJSON spec -data GeoFeatureCollection = GeoFeatureCollection (Maybe BoundingBoxWithoutCRS) [GeoFeature] deriving (Show, Eq) - +-- +------------------------------------------------------------------- +module Data.Geospatial ( + -- * Types + Latitude + , Longitude + , Easting + , Northing + , Altitude + , GeoPositionWithoutCRS + , GeoPosition(..) + , GeoPoint(..) + , GeoMultiPoint(..) + , GeoPolygon(..) + , GeoMultiPolygon(..) + , GeoLine(..) + , GeoMultiLine(..) + , GeospatialGeometry(..) + , Name + , Code + , Href + , FormatString + , ProjectionType + , CRSObject(..) + , FeatureID + , BoundingBoxWithoutCRS + , GeoFeature(..) + , GeoFeatureCollection(..) + -- * Functions + , stripCRSFromPosition + , defaultCRS + -- * Lenses + -- ** Geometry Lenses + , unGeoPoint + , unGeoMultiPoint + , unGeoPolygon + , unGeoLine + , unGeoMultiLine + , unGeoMultiPolygon + -- ** Feature Lenses + , bbox + , geometry + , properties + , featureId + , boundingbox + , geofeatures + -- * Prisms + -- ** Geometry + , _NoGeometry + , _Point + , _MultiPoint + , _Polygon + , _MultiPolygon + , _Line + , _MultiLine + , _Collection + -- ** CRS + , _NoCRS + , _NamedCRS + , _EPSG + , _LinkedCRS + ) where +import Data.Geospatial.BasicTypes +import Data.Geospatial.CRS +import Data.Geospatial.GeoFeature +import Data.Geospatial.GeoFeatureCollection +import Data.Geospatial.Geometry +import Data.Geospatial.GeoPosition diff --git a/src/Data/Geospatial/BasicTypes.hs b/src/Data/Geospatial/BasicTypes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/BasicTypes.hs @@ -0,0 +1,60 @@ +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.BasicTypes +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- Basic types for GeoJSON representations. +------------------------------------------------------------------- +module Data.Geospatial.BasicTypes ( + -- * Coordinate types + Latitude + , Longitude + , Easting + , Northing + , Altitude + , GeoPositionWithoutCRS + -- * CRS Reference types + , Name + , Code + , Href + , FormatString + , ProjectionType + -- * Feature Types + , BoundingBoxWithoutCRS + , FeatureID + ) where + +import Data.Text ( Text ) + +type Latitude = Float +type Longitude = Float +type Easting = Float +type Northing = Float +type Altitude = Float + +-- | (`GeoPositionWithoutCRS` is a catch all for indeterminate CRSs and for expression of positions +-- before a CRS has been determined +-- +type GeoPositionWithoutCRS = [Float] + +type Name = Text +type Code = Int +type Href = Text +type FormatString = Text +type ProjectionType = Text + +-- Feature Types + +type FeatureID = Text + +-- | See Section 4 /Bounding Boxes/ of the GeoJSON spec, +-- The length of the list/array must be 2*n where n is the dimensionality of the position type for the CRS +-- with min values first followed by the max values, wich both the min/max sets following the same axis order as the CRS, +-- e.g for WGS84: minLongitude, minLatitude, maxLongitude, maxLatitude +-- The spec mentions that it can be part of a geometry object too but doesnt give an example, +-- This implementation will ignore bboxes on Geometry objects, they can be added if required. +type BoundingBoxWithoutCRS = [Float] + + diff --git a/src/Data/Geospatial/CRS.hs b/src/Data/Geospatial/CRS.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/CRS.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.CRS +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- See Section 3 /Coordinate Reference System Objects/ +-- in the GeoJSON Spec +-- +------------------------------------------------------------------- +module Data.Geospatial.CRS ( + -- * Types + CRSObject(..) + -- * Functions + , defaultCRS + -- * Prisms + , _NoCRS + , _NamedCRS + , _EPSG + , _LinkedCRS + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry +import Data.Geospatial.GeoPosition + +import Control.Applicative ( (<$>), (<*>) ) +import Control.Lens ( makePrisms ) +import Control.Monad ( mzero ) +import Data.Aeson + ( FromJSON(..) + , ToJSON(..) + , Value(..) + , Object + , (.:) + , (.=) + , object + ) +import Data.Aeson.Types ( Parser ) +import Data.Text ( Text ) + +-- $setup +-- +-- >>> import qualified Data.Aeson as A +-- >>> import qualified Data.ByteString.Lazy.Char8 as BS +-- +-- Test CRS Data +-- >>> let testLinkCRSJSON = "{\"type\":\"link\",\"properties\":{\"href\":\"www.google.com.au\",\"type\":\"proj4\"}}" +-- >>> let testLinkCRS = LinkedCRS "www.google.com.au" "proj4" +-- >>> let testEPSGJSON = "{\"type\":\"epsg\",\"properties\":{\"code\":4326}}" +-- >>> let testEPSG = EPSG 4326 +-- >>> let testNamedCRSJSON = "{\"type\":\"name\",\"properties\":{\"name\":\"urn:ogc:def:crs:OGC:1.3:CRS84\"}}" +-- >>> let testNamedCRS = NamedCRS "urn:ogc:def:crs:OGC:1.3:CRS84" +-- + +-- | See Section 3 /Coordinate Reference System Objects/ in the GeoJSON Spec +-- `NoCRS` is required because no 'crs' attribute in a GeoJSON feature is NOT the same thing as +-- a null 'crs' attribute. no 'crs' value implies the default CRS, while a null CRS means +-- you cannot assume a CRS, null will mapped to `NoCRS` while a non-existent attribute will +-- be mapped to a `Nothing` `Maybe` value +data CRSObject = + NoCRS + | NamedCRS !Name + | EPSG Code + | LinkedCRS !Href !FormatString deriving (Show, Eq) + +makePrisms ''CRSObject + +-- | The default CRS according to Section 3 /Coordinate Reference System Objects/ is WGS84 which I believe, +-- from which translates to this in JSON: ) +-- is represented thus: +defaultCRS :: CRSObject +defaultCRS = EPSG 4326 + +-- instances + +-- | +-- encode and decodes CRS Objects to and from GeoJSON +-- +-- >>> (A.decode . BS.pack) testLinkCRSJSON == Just testLinkCRS +-- True +-- +-- >>> (A.decode . BS.pack) testNamedCRSJSON == Just testNamedCRS +-- True +-- +-- >>> (A.decode . BS.pack) testEPSGJSON == Just testEPSG +-- True +-- +-- Aeson doesnt decode "null" to `Null` unfortunately +-- +-- (A.decode . BS.pack) "null" == Just NoCRS +-- True +-- +instance FromJSON CRSObject where + parseJSON Null = return NoCRS + parseJSON (Object obj) = do + crsType <- obj .: "type" + crsObjectFromAeson crsType obj + parseJSON _ = mzero + +-- | +-- encode CRS Objects to GeoJSON +-- +-- >>> (A.decode . A.encode) testLinkCRS == Just testLinkCRS +-- True +-- +-- >>> (A.decode . A.encode) testNamedCRS == Just testNamedCRS +-- True +-- +-- >>> (A.decode . A.encode) testEPSG == Just testEPSG +-- True +-- +-- >>> A.encode NoCRS +-- "null" +-- +instance ToJSON CRSObject where + toJSON (NamedCRS name) = object ["type" .= ("name" :: Text), "properties" .= object ["name" .= name]] + toJSON (EPSG code) = object ["type" .= ("epsg" :: Text), "properties" .= object ["code" .= code]] + toJSON (LinkedCRS href format) = object ["type" .= ("link" :: Text), "properties" .= object ["href" .= href, "type" .= format]] + toJSON NoCRS = Null + +-- helpers + +crsPropertyFromAesonObj :: (FromJSON a) => Text -> Object -> Parser a +crsPropertyFromAesonObj name obj = do + props <- obj .: "properties" + props .: name + +crsObjectFromAeson :: Text -> Object -> Parser CRSObject +crsObjectFromAeson "name" obj = NamedCRS <$> crsPropertyFromAesonObj "name" obj +crsObjectFromAeson "epsg" obj = EPSG <$> crsPropertyFromAesonObj "code" obj +crsObjectFromAeson "link" obj = LinkedCRS <$> crsPropertyFromAesonObj "href" obj <*> crsPropertyFromAesonObj "type" obj +crsObjectFromAeson _ _ = mzero + + diff --git a/src/Data/Geospatial/GeoFeature.hs b/src/Data/Geospatial/GeoFeature.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/GeoFeature.hs @@ -0,0 +1,203 @@ +{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.GeoFeature +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- See Section 2.2 /Feature Objects/ of the GeoJSON spec. +-- Parameterised on the property type +-- +------------------------------------------------------------------- +module Data.Geospatial.GeoFeature ( + -- * Types + GeoFeature(..) + -- * Lenses + , bbox + , geometry + , properties + , featureId + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry +import Data.Geospatial.Geometry.Aeson +import Data.Geospatial.GeoPosition + +import Prelude ( Show, Eq(..), ($) ) +import Control.Applicative ( (<$>), (<*>) ) +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object, (.:), (.:?), (.=), object ) +import Data.List ( (++) ) +import Data.Maybe ( Maybe ) +import Data.Text ( Text ) + +-- $setup +-- +-- >>> import qualified Data.Aeson as A +-- >>> import qualified Data.ByteString.Lazy.Char8 as BS +-- >>> import Data.Function ( (.) ) +-- >>> import Data.Int ( Int ) +-- >>> import Data.Maybe ( Maybe(..) ) +-- >>> import Data.String +-- >>> import qualified Data.Text as T +-- +-- >>> let decode' = A.decode . BS.pack; decode' :: (FromJSON a) => String -> Maybe a +-- +-- Test Bounding Box Data +-- >>> let lshapedPolyVertices = [[120.0, -15.0], [127.0, -15.0], [127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: [GeoPositionWithoutCRS] +-- >>> let emptyVertices = [] :: [GeoPositionWithoutCRS] +-- >>> let testLatLonBBox = [-32, 147.5, -29.5, 151.0] :: BoundingBoxWithoutCRS +-- >>> let testLatLonBBoxJSON = "[-32,147.5,-29.5,151]" +-- >>> let testEmptyBBox = [] :: BoundingBoxWithoutCRS +-- >>> let testEmptyBBoxJSON = "[]" +-- +-- End Test Bounding Box Data +-- Test Geometry Data +-- Polys +-- >>> let lShapedPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" +-- +-- Upside down L Shaped Poly +-- +-- (120, -15) (127, -15) +-- *---------------------------* +-- | | +-- | | +-- | (124, -18) | +-- *---------------* | +-- (120, -18) | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- *-----------* +-- (124, -25) (127, -25) +-- +-- >>> let lShapedGeoPoly = GeoPolygon lshapedPolyVertices +-- >>> let lShapedPoly = Polygon lShapedGeoPoly +-- >>> let emptyPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[]}" +-- >>> let emptyGeoPoly = GeoPolygon emptyVertices +-- >>> let emptyPoly = Polygon emptyGeoPoly +-- +-- Multi Polys +-- >>> let emptyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[]}" +-- >>> let emptyMultiGeoPoly = GeoMultiPolygon [] +-- >>> let emptyMultiPoly = MultiPolygon emptyMultiGeoPoly +-- >>> let singlePolyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let singlePolyGeoMultiPoly = GeoMultiPolygon [lShapedGeoPoly] +-- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly +-- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]}" +-- >>> let geoMultiPoly = GeoMultiPolygon [lShapedGeoPoly, emptyGeoPoly] +-- >>> let multiPoly = MultiPolygon geoMultiPoly +-- +-- Line Data +-- >>> let lShapedLineJSON = "{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" +-- >>> let lShapedGeoLine = GeoLine lshapedPolyVertices +-- >>> let lShapedLine = Line lShapedGeoLine +-- >>> let emptyLineJSON = "{\"type\":\"Line\",\"coordinates\":[]}" +-- >>> let emptyGeoLine = GeoLine emptyVertices +-- >>> let emptyLine = Line emptyGeoLine +-- +-- Multi Lines +-- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[]}" +-- >>> let emptyMultiGeoLine = GeoMultiLine [] +-- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine +-- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let singleLineGeoMultiLine = GeoMultiLine [lShapedGeoLine] +-- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine +-- >>> let multiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]}" +-- >>> let geoMultiLine = GeoMultiLine [lShapedGeoLine, emptyGeoLine] +-- >>> let multiLine = MultiLine geoMultiLine +-- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" +-- >>> let emptyCollection = Collection [] +-- >>> let bigassCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, emptyLine, multiLine, lShapedLine, multiPoly, singlePolyMultiPoly, lShapedPoly, emptyMultiPoly, lShapedPoly] +-- +-- End Test Geometry Data +-- +-- Test Properties +-- >>> let testProperties = object [(T.pack "depth") .= (5 :: Int), (T.pack "comment") .= (T.pack "Bore run over by dump truck")] +-- +-- Test Features +-- >>> let bigFeatureJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let bigFeature = GeoFeature (Just testLatLonBBox) bigassCollection testProperties (Just "GW001") +-- >>> let featureWithNoPropertiesJSON = "{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let featureWithNoProperties = let GeoFeature bbox geometry _ featureId = bigFeature in GeoFeature bbox geometry Null featureId +-- >>> let featureWithNoGeometryJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let featureWithNoGeometry = let GeoFeature bbox _ props featureId = bigFeature in GeoFeature bbox NoGeometry props featureId +-- >>> let featureWithNoIdJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]}" +-- >>> let featureWithNoId = let GeoFeature bbox geometry props _ = bigFeature in GeoFeature bbox geometry props Nothing +-- >>> let featureWithNoBBoxJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"}" +-- >>> let featureWithNoBBox = let GeoFeature _ geometry props featureId = bigFeature in GeoFeature Nothing geometry props featureId +-- + +-- | See Section 2.2 /Feature Objects/ of the GeoJSON spec. +-- Parameterised on the property type +data GeoFeature a = GeoFeature { + _bbox :: Maybe BoundingBoxWithoutCRS, + _geometry :: GeospatialGeometry, + _properties :: a, + _featureId :: Maybe FeatureID } deriving (Show, Eq) + +makeLenses ''GeoFeature + +-- instances + +-- | decodes Feature objects to and from GeoJSON +-- +-- >>> decode' bigFeatureJSON == Just bigFeature +-- True +-- +-- >>> decode' featureWithNoPropertiesJSON == Just featureWithNoProperties +-- True +-- +-- >>> decode' featureWithNoIdJSON == Just featureWithNoId +-- True +-- +-- >>> decode' featureWithNoBBoxJSON == Just featureWithNoBBox +-- True +-- +-- >>> decode' featureWithNoGeometryJSON == Just featureWithNoGeometry +-- True +-- +instance (FromJSON a) => FromJSON (GeoFeature a) where +-- parseJSON :: Value -> Parse a + parseJSON (Object obj) = do + objType <- obj .: ("type" :: Text) + if objType /= ("Feature" :: Text) + then + mzero + else + GeoFeature + <$> obj .:? ("bbox" :: Text) + <*> obj .: ("geometry" :: Text) + <*> obj .: ("properties" :: Text) + <*> obj .:? ("id" :: Text) + parseJSON _ = mzero + +-- | encodes Feature objects to and from GeoJSON +-- +-- >>> (A.decode . A.encode) bigFeature == Just bigFeature +-- True +-- +-- >>> (A.decode . A.encode) featureWithNoProperties == Just featureWithNoProperties +-- True +-- +-- >>> (A.decode . A.encode) featureWithNoId == Just featureWithNoId +-- True +-- +-- >>> (A.decode . A.encode) featureWithNoBBox == Just featureWithNoBBox +-- True +-- +-- >>> (A.decode . A.encode) featureWithNoGeometry == Just featureWithNoGeometry +-- True +-- +instance (ToJSON a) => ToJSON (GeoFeature a) where +-- toJSON :: a -> Value + toJSON (GeoFeature bbox' geom props featureId') = object $ baseAttributes ++ optAttributes "bbox" bbox' ++ optAttributes "id" featureId' + where + baseAttributes = ["type" .= ("Feature" :: Text), "properties" .= props, "geometry" .= geom] diff --git a/src/Data/Geospatial/GeoFeatureCollection.hs b/src/Data/Geospatial/GeoFeatureCollection.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/GeoFeatureCollection.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.GeoFeature +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- See Section 2.3 /Feature Collection Objects/ of the GeoJSON spec +-- +------------------------------------------------------------------- +module Data.Geospatial.GeoFeatureCollection ( + -- * Types + GeoFeatureCollection(..) + -- * Lenses + , boundingbox + , geofeatures + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.GeoFeature +import Data.Geospatial.Geometry +import Data.Geospatial.Geometry.Aeson +import Data.Geospatial.GeoPosition + +import Prelude ( Show, Eq(..), ($) ) +import Control.Applicative ( (<$>), (<*>) ) +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero, return ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object, (.:), (.:?), (.=), object ) +import Data.List ( (++) ) +import Data.Maybe ( Maybe(..) ) +import Data.Text ( Text ) + +-- $setup +-- +-- >>> import qualified Data.Aeson as A +-- >>> import qualified Data.ByteString.Lazy.Char8 as BS +-- >>> import Data.Function ( (.) ) +-- >>> import Data.Int ( Int ) +-- >>> import Data.Maybe ( Maybe(..) ) +-- >>> import Data.String +-- >>> import qualified Data.Text as T +-- +-- >>> let decode' = A.decode . BS.pack; decode' :: (FromJSON a) => String -> Maybe a +-- +-- Test Bounding Box Data +-- >>> let lshapedPolyVertices = [[120.0, -15.0], [127.0, -15.0], [127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: [GeoPositionWithoutCRS] +-- >>> let emptyVertices = [] :: [GeoPositionWithoutCRS] +-- >>> let testLatLonBBox = [-32, 147.5, -29.5, 151.0] :: BoundingBoxWithoutCRS +-- >>> let testLatLonBBoxJSON = "[-32,147.5,-29.5,151]" +-- >>> let testEmptyBBox = [] :: BoundingBoxWithoutCRS +-- >>> let testEmptyBBoxJSON = "[]" +-- +-- End Test Bounding Box Data +-- Test Geometry Data +-- Polys +-- >>> let lShapedPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" +-- +-- Upside down L Shaped Poly +-- +-- (120, -15) (127, -15) +-- *---------------------------* +-- | | +-- | | +-- | (124, -18) | +-- *---------------* | +-- (120, -18) | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- *-----------* +-- (124, -25) (127, -25) +-- +-- >>> let lShapedGeoPoly = GeoPolygon lshapedPolyVertices +-- >>> let lShapedPoly = Polygon lShapedGeoPoly +-- >>> let emptyPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[]}" +-- >>> let emptyGeoPoly = GeoPolygon emptyVertices +-- >>> let emptyPoly = Polygon emptyGeoPoly +-- +-- Multi Polys +-- >>> let emptyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[]}" +-- >>> let emptyMultiGeoPoly = GeoMultiPolygon [] +-- >>> let emptyMultiPoly = MultiPolygon emptyMultiGeoPoly +-- >>> let singlePolyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let singlePolyGeoMultiPoly = GeoMultiPolygon [lShapedGeoPoly] +-- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly +-- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]}" +-- >>> let geoMultiPoly = GeoMultiPolygon [lShapedGeoPoly, emptyGeoPoly] +-- >>> let multiPoly = MultiPolygon geoMultiPoly +-- +-- Line Data +-- >>> let lShapedLineJSON = "{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" +-- >>> let lShapedGeoLine = GeoLine lshapedPolyVertices +-- >>> let lShapedLine = Line lShapedGeoLine +-- >>> let emptyLineJSON = "{\"type\":\"Line\",\"coordinates\":[]}" +-- >>> let emptyGeoLine = GeoLine emptyVertices +-- >>> let emptyLine = Line emptyGeoLine +-- +-- Multi Lines +-- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[]}" +-- >>> let emptyMultiGeoLine = GeoMultiLine [] +-- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine +-- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let singleLineGeoMultiLine = GeoMultiLine [lShapedGeoLine] +-- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine +-- >>> let multiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]}" +-- >>> let geoMultiLine = GeoMultiLine [lShapedGeoLine, emptyGeoLine] +-- >>> let multiLine = MultiLine geoMultiLine +-- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" +-- >>> let emptyCollection = Collection [] +-- >>> let bigassCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, emptyLine, multiLine, lShapedLine, multiPoly, singlePolyMultiPoly, lShapedPoly, emptyMultiPoly, lShapedPoly] +-- +-- End Test Geometry Data +-- +-- Test Properties +-- >>> let testProperties = object [(T.pack "depth") .= (5 :: Int), (T.pack "comment") .= (T.pack "Bore run over by dump truck")] +-- +-- Test Features +-- >>> let bigFeatureJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let bigFeature = GeoFeature (Just testLatLonBBox) bigassCollection testProperties (Just "GW001") +-- >>> let featureWithNoPropertiesJSON = "{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let featureWithNoProperties = let GeoFeature bbox geometry _ featureId = bigFeature in GeoFeature bbox geometry Null featureId +-- >>> let featureWithNoGeometryJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" +-- >>> let featureWithNoGeometry = let GeoFeature bbox _ props featureId = bigFeature in GeoFeature bbox NoGeometry props featureId +-- >>> let featureWithNoIdJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]}" +-- >>> let featureWithNoId = let GeoFeature bbox geometry props _ = bigFeature in GeoFeature bbox geometry props Nothing +-- >>> let featureWithNoBBoxJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"}" +-- >>> let featureWithNoBBox = let GeoFeature _ geometry props featureId = bigFeature in GeoFeature Nothing geometry props featureId +-- >>> let bigAssFeatureCollectionJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"features\":[{\"geometry\":{\"geometries\":[{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":null,\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}},{\"geometry\":{\"geometries\":[{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"MultiLine\"},{\"coordinates\":[],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[],\"type\":\"Line\"}],\"type\":\"MultiLine\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}],\"type\":\"FeatureCollection\"}" +-- >>> let bigAssFeatureCollection = GeoFeatureCollection (Just testLatLonBBox) [featureWithNoBBox, featureWithNoGeometry, featureWithNoBBox, featureWithNoId, featureWithNoProperties, bigFeature] +-- >>> let bigAssFeatureCollectionWithNoBBoxJSON = "{\"type\":\"FeatureCollection\",\"features\":[{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]},{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}]}" +-- >>> let bigAssFeatureCollectionWithNoBBox = let GeoFeatureCollection _ features = bigAssFeatureCollection in GeoFeatureCollection Nothing features +-- >>> let emptyFeatureCollectionJSON = "{\"type\":\"FeatureCollection\",\"features\":[]}" +-- >>> let emptyFeatureCollection = GeoFeatureCollection Nothing [] :: GeoFeatureCollection Value +-- >>> let emptyFeatureCollectionWithBBoxJSON = "{\"type\":\"FeatureCollection\",\"features\":[],\"bbox\":[-32,147.5,-29.5,151]}" +-- >>> let emptyFeatureCollectionWithBBox = GeoFeatureCollection (Just testLatLonBBox) []; emptyFeatureCollectionWithBBox :: GeoFeatureCollection Value +-- + +-- | See Section 2.3 /Feature Collection Objects/ of the GeoJSON spec +-- +data GeoFeatureCollection a = GeoFeatureCollection + { _boundingbox :: Maybe BoundingBoxWithoutCRS + , _geofeatures :: [GeoFeature a] + } deriving (Show, Eq) + +makeLenses ''GeoFeatureCollection + +-- instances + +-- | Decodes FeatureCollection objects to and from GeoJSON +-- +-- >>> decode' bigAssFeatureCollectionJSON == Just bigAssFeatureCollection +-- True +-- +-- >>> decode' bigAssFeatureCollectionWithNoBBoxJSON == Just bigAssFeatureCollectionWithNoBBox +-- True +-- +-- >>> decode' emptyFeatureCollectionWithBBoxJSON == Just emptyFeatureCollectionWithBBox +-- True +-- +-- >>> decode' emptyFeatureCollectionJSON == Just emptyFeatureCollection +-- True +-- +instance (FromJSON a) => FromJSON (GeoFeatureCollection a) where +-- parseJSON :: Value -> Parse a + parseJSON (Object obj) = do + objType <- obj .: ("type" :: Text) + if objType /= ("FeatureCollection" :: Text) + then + mzero + else + GeoFeatureCollection + <$> obj .:? ("bbox" :: Text) + <*> obj .: ("features" :: Text) + parseJSON _ = mzero + +-- | Encodes FeatureCollection objects to and from GeoJSON +-- +-- >>> (A.decode . A.encode) bigAssFeatureCollection == Just bigAssFeatureCollection +-- True +-- +-- >>> (A.decode . A.encode) bigAssFeatureCollectionWithNoBBox == Just bigAssFeatureCollectionWithNoBBox +-- True +-- +-- >>> (A.decode . A.encode) emptyFeatureCollectionWithBBox == Just emptyFeatureCollectionWithBBox +-- True +-- +-- >>> (A.decode . A.encode) emptyFeatureCollection == Just emptyFeatureCollection +-- True +-- +instance (ToJSON a) => ToJSON (GeoFeatureCollection a) where +-- toJSON :: a -> Value + toJSON (GeoFeatureCollection bbox' features) = object $ baseAttributes ++ optAttributes "bbox" bbox' + where + baseAttributes = ["type" .= ("FeatureCollection" :: Text), "features" .= features] diff --git a/src/Data/Geospatial/GeoPosition.hs b/src/Data/Geospatial/GeoPosition.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/GeoPosition.hs @@ -0,0 +1,38 @@ +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.GeoPosition +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- see Section 2.1.1 /Position/ in the GeoJSON Spec +------------------------------------------------------------------- +module Data.Geospatial.GeoPosition ( + -- * Type + GeoPosition(..) + -- * Functions + , stripCRSFromPosition + ) where + +import Data.Geospatial.BasicTypes + +-- | see Section 2.1.1 /Position/ in the GeoJSON Spec, +-- I make the assumption here that the only position types we will use will +-- involve easting or northing (+ve or -ve Altitude) or lon or lat (+ve or -ve Altitude) +data GeoPosition = + LonLat Longitude Latitude + | LonLatAlt Longitude Latitude Altitude + | EastingNorthing Easting Northing + | EastingNorthingAlt Easting Northing Altitude + +-- | the `GeoPosition` is a bit special in that when you convert it to GeoJSON, +-- it will lose the CRS info attached to it and cannot be read back in +-- from the GeoJSON. Hence it is ineligible for the `FromJSON` type class, +-- so this function will strip it down to a `GeoPositionWithoutCRS`, which is eligible +stripCRSFromPosition :: GeoPosition -> GeoPositionWithoutCRS +stripCRSFromPosition (LonLat lon lat) = [lon, lat] +stripCRSFromPosition (LonLatAlt lon lat alt) = [lon, lat, alt] +stripCRSFromPosition (EastingNorthing easting northing) = [easting, northing] +stripCRSFromPosition (EastingNorthingAlt easting northing alt) = [easting, northing, alt] + + diff --git a/src/Data/Geospatial/Geometry.hs b/src/Data/Geospatial/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- See section 2.1 "Geometry Objects" in the GeoJSON Spec. +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry ( + -- * Types + GeoPoint(..) + , GeoMultiPoint(..) + , GeoPolygon(..) + , GeoMultiPolygon(..) + , GeoLine(..) + , GeoMultiLine(..) + , GeospatialGeometry(..) + -- * Lenses + , unGeoPoint + , unGeoMultiPoint + , unGeoPolygon + , unGeoMultiPolygon + , unGeoLine + , unGeoMultiLine + -- * Prisms + , _NoGeometry + , _Point + , _MultiPoint + , _Polygon + , _MultiPolygon + , _Line + , _MultiLine + , _Collection + ) where + +import Data.Geospatial.Geometry.Aeson +import Data.Geospatial.Geometry.GeoLine +import Data.Geospatial.Geometry.GeoMultiLine +import Data.Geospatial.Geometry.GeoMultiPoint +import Data.Geospatial.Geometry.GeoMultiPolygon +import Data.Geospatial.Geometry.GeoPoint +import Data.Geospatial.Geometry.GeoPolygon + +import Control.Applicative ( (<$>) ) +import Control.Lens ( makePrisms ) +import Control.Monad ( mzero ) +import Data.Aeson + ( FromJSON(..) + , ToJSON(..) + , Value(..) + , Object + , (.:) + , (.=) + , object + ) +import Data.Aeson.Types ( Parser ) +import Data.Text ( Text ) + +-- $setup +-- >>> import Data.Geospatial.BasicTypes +-- +-- >>> import qualified Data.Aeson as A +-- >>> import qualified Data.ByteString.Lazy.Char8 as BS +-- +-- >>> let lshapedPolyVertices = [[120.0, -15.0], [127.0, -15.0], [127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: [GeoPositionWithoutCRS] +-- >>> let emptyVertices = [] :: [GeoPositionWithoutCRS] +-- +-- >>> let decode' = A.decode . BS.pack; decode' :: (FromJSON a) => String -> Maybe a +-- +-- Test Geometry Data +-- Polys +-- >>> let lShapedPolyJSON = "{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Polygon\"}" +-- +-- Upside down L Shaped Poly +-- +-- (120, -15) (127, -15) +-- *---------------------------* +-- | | +-- | | +-- | (124, -18) | +-- *---------------* | +-- (120, -18) | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- *-----------* +-- (124, -25) (127, -25) +-- +-- >>> let lShapedGeoPoly = GeoPolygon lshapedPolyVertices +-- >>> let lShapedPoly = Polygon lShapedGeoPoly +-- >>> let emptyPolyJSON = "{\"coordinates\":[],\"type\":\"Polygon\"}" +-- >>> let emptyGeoPoly = GeoPolygon emptyVertices +-- >>> let emptyPoly = Polygon emptyGeoPoly +-- +-- Multi Polys +-- >>> let emptyMultiPolyJSON = "{\"coordinates\":[],\"type\":\"MultiPolygon\"}" +-- >>> let emptyMultiGeoPoly = GeoMultiPolygon [] +-- >>> let emptyMultiPoly = MultiPolygon emptyMultiGeoPoly +-- >>> let singlePolyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let singlePolyGeoMultiPoly = GeoMultiPolygon [lShapedGeoPoly] +-- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly +-- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]}" +-- >>> let geoMultiPoly = GeoMultiPolygon [lShapedGeoPoly, emptyGeoPoly] +-- >>> let multiPoly = MultiPolygon geoMultiPoly +-- +-- Line Data +-- >>> let lShapedLineJSON = "{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" +-- >>> let lShapedGeoLine = GeoLine lshapedPolyVertices +-- >>> let lShapedLine = Line lShapedGeoLine +-- >>> let emptyLineJSON = "{\"type\":\"Line\",\"coordinates\":[]}" +-- >>> let emptyGeoLine = GeoLine emptyVertices +-- >>> let emptyLine = Line emptyGeoLine +-- +-- Multi Lines +-- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[]}" +-- >>> let emptyMultiGeoLine = GeoMultiLine [] +-- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine +-- >>> let singleLineMultiLineJSON = "{\"coordinates\":[{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"Line\"}],\"type\":\"MultiLine\"}" +-- >>> let singleLineGeoMultiLine = GeoMultiLine [lShapedGeoLine] +-- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine +-- >>> let multiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]}" +-- >>> let geoMultiLine = GeoMultiLine [lShapedGeoLine, emptyGeoLine] +-- >>> let multiLine = MultiLine geoMultiLine +-- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" +-- >>> let emptyCollection = Collection [] +-- >>> let bigassCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" +-- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, emptyLine, multiLine, lShapedLine, multiPoly, singlePolyMultiPoly, lShapedPoly, emptyMultiPoly, lShapedPoly] +-- +-- End Test Geometry Data +-- +-- + +-- | See section 2.1 /Geometry Objects/ in the GeoJSON Spec. +data GeospatialGeometry = + NoGeometry + | Point GeoPoint + | MultiPoint GeoMultiPoint + | Polygon GeoPolygon + | MultiPolygon GeoMultiPolygon + | Line GeoLine + | MultiLine GeoMultiLine + | Collection [GeospatialGeometry] deriving (Show, Eq) + +makePrisms ''GeospatialGeometry + +geometryFromAeson :: String -> Value -> Parser GeospatialGeometry +geometryFromAeson "Point" obj = Point <$> parseJSON obj +geometryFromAeson "MultiPoint" obj = MultiPoint <$> parseJSON obj +geometryFromAeson "Polygon" obj = Polygon <$> parseJSON obj +geometryFromAeson "MultiPolygon" obj = MultiPolygon <$> parseJSON obj +geometryFromAeson "Line" obj = Line <$> parseJSON obj +geometryFromAeson "MultiLine" obj = MultiLine <$> parseJSON obj +geometryFromAeson "GeometryCollection" (Object jsonObj) = Collection <$> (jsonObj .: ("geometries" :: Text)) +geometryFromAeson "GeometryCollection" _ = mzero +geometryFromAeson _ _ = mzero + + +-- | +-- encodes and Geometry Objects to GeoJSON +-- (refer to source to see the values for the test values) +-- +-- >>> A.encode NoGeometry +-- "null" +-- +-- >>> (A.decode . A.encode) lShapedPoly == Just lShapedPoly +-- True +-- +-- >>> (A.decode . A.encode) emptyPoly == Just emptyPoly +-- True +-- +-- >>> (A.decode . A.encode) emptyMultiPoly == Just emptyMultiPoly +-- True +-- +-- >>> (A.decode . A.encode) singleLineMultiLine == Just singleLineMultiLine +-- True +-- +-- >>> (A.decode . A.encode) multiLine == Just multiLine +-- True +-- +-- >>> (A.decode . A.encode) emptyCollection == Just emptyCollection +-- True +-- +-- >>> (A.decode . A.encode) bigassCollection == Just bigassCollection +-- True +-- +instance ToJSON GeospatialGeometry where +-- toJSON :: a -> Value + toJSON NoGeometry = Null + toJSON (Point point) = toJSON point + toJSON (MultiPoint points) = toJSON points + toJSON (Polygon vertices) = toJSON vertices + toJSON (MultiPolygon vertices) = toJSON vertices + toJSON (Line vertices) = toJSON vertices + toJSON (MultiLine vertices) = toJSON vertices + toJSON (Collection geometries) = object + [ "type" .= ("GeometryCollection" :: Text) + , "geometries" .= geometries + ] + +-- | +-- encodes and decodes Geometry Objects to and from GeoJSON +-- (refer to source to see the values for the test values) +-- +-- >>> decode' lShapedPolyJSON == Just lShapedPoly +-- True +-- +-- >>> decode' emptyPolyJSON == Just emptyPoly +-- True +-- +-- >>> decode' emptyMultiPolyJSON == Just emptyMultiPoly +-- True +-- +-- >>> decode' singleLineMultiLineJSON == Just singleLineMultiLine +-- True +-- +-- >>> decode' multiLineJSON == Just multiLine +-- True +-- +-- >>> decode' emptyCollectionJSON == Just emptyCollection +-- True +-- +-- >>> decode' bigassCollectionJSON == Just bigassCollection +-- True +-- +-- Aeson doesnt decode "null" into `Null` unfortunately +-- +-- decode' "null" :: Maybe GeospatialGeometry +-- Just NoGeometry +-- +instance FromJSON GeospatialGeometry where +-- parseJSON :: Value -> Parser a + parseJSON Null = return NoGeometry + parseJSON (Object obj) = do + geometryType <- obj .: ("type" :: Text) + geometryFromAeson geometryType (Object obj) + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/Aeson.hs b/src/Data/Geospatial/Geometry/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/Aeson.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geosptial.Geometry.Aeson +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +-- Some helpers for some of the common Aeson ops +------------------------------------------------------------------- +module Data.Geospatial.Geometry.Aeson ( + -- * Geometry + readGeometryGeoAeson + , makeGeometryGeoAeson + -- * Optional fields + , optValFromObj + , optAttributes + ) where + +import Control.Applicative ( (<$>) ) +import Control.Monad ( mzero ) +import Data.Aeson + ( FromJSON(..) + , ToJSON(..) + , Object + , Value + , (.:) + , (.:?) + , (.=) + , object + ) +import Data.Aeson.Types ( Pair, Parser ) +import Data.Maybe ( Maybe(..) ) +import Data.Text ( Text ) + +-- | A generic function that can be used to read in the GeoJSON for: +-- `GeoPoint`, `GeoMultiPoint`, `GeoLine`, `GeoMultiLine`, `GeoPolygon` and `GeoMultiPolygon` +-- Takes in a String for the GeoJSON geometry type, the type constructor +-- for the datatype and the JSON object containing both the 'type' val and the 'coordinates' val +-- +readGeometryGeoAeson :: (FromJSON a, FromJSON b) => String -> (a -> b) -> Object -> Parser b +readGeometryGeoAeson geomTypeString geomType geopointObj = do + geometryType <- geopointObj .: "type" + if geometryType == geomTypeString + then + geomType <$> geopointObj .: "coordinates" + else + mzero + +-- | The inverse to the above, you just give it the type string and the value for the coordinates +-- and it will create the JSON object +-- +makeGeometryGeoAeson :: (ToJSON a) => String -> a -> Value +makeGeometryGeoAeson typeString coordinates = + object ["type" .= typeString, "coordinates" .= coordinates] + +-- | get an optional value out of a JSON object: +-- +optValFromObj :: (FromJSON a) => Text -> Object -> Parser (Maybe a) +optValFromObj = flip (.:?) + +-- | The other way around, given an optional value, will return the attributes that +-- should be added to the makeObj input +-- +optAttributes :: (ToJSON a) => Text -> Maybe a -> [Pair] +optAttributes _ Nothing = [] +optAttributes name (Just x) = [name .= x] diff --git a/src/Data/Geospatial/Geometry/GeoLine.hs b/src/Data/Geospatial/Geometry/GeoLine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoLine.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoLine +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoLine ( + -- * Type + GeoLine(..) + -- * Lenses + , unGeoLine + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.Aeson + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoLine = GeoLine { _unGeoLine :: [GeoPositionWithoutCRS] } deriving (Show, Eq) + +makeLenses ''GeoLine + +-- instances + +instance ToJSON GeoLine where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "Line" . _unGeoLine + +instance FromJSON GeoLine where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "Line" GeoLine o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoMultiLine.hs b/src/Data/Geospatial/Geometry/GeoMultiLine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoMultiLine.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoMultiLine +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoMultiLine ( + -- * Type + GeoMultiLine(..) + -- * Lenses + , unGeoMultiLine + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.GeoLine +import Data.Geospatial.Geometry.Aeson + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoMultiLine = GeoMultiLine { _unGeoMultiLine :: [GeoLine] } deriving (Show, Eq) + +makeLenses ''GeoMultiLine + +-- instances + +instance ToJSON GeoMultiLine where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "MultiLine" . _unGeoMultiLine + +instance FromJSON GeoMultiLine where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "MultiLine" GeoMultiLine o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoMultiPoint.hs b/src/Data/Geospatial/Geometry/GeoMultiPoint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoMultiPoint.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoMultiPoint +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoMultiPoint ( + -- * Type + GeoMultiPoint(..) + -- * Lenses + , unGeoMultiPoint + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.GeoPoint +import Data.Geospatial.Geometry.Aeson + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoMultiPoint = GeoMultiPoint { _unGeoMultiPoint :: [GeoPoint] } deriving (Show, Eq) + +makeLenses ''GeoMultiPoint + +-- instances + +instance ToJSON GeoMultiPoint where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "MultiPoint" . _unGeoMultiPoint + +instance FromJSON GeoMultiPoint where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "MultiPoint" GeoMultiPoint o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoMultiPolygon.hs b/src/Data/Geospatial/Geometry/GeoMultiPolygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoMultiPolygon.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoMultiPolygon +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoMultiPolygon ( + -- * Type + GeoMultiPolygon(..) + -- * Lenses + , unGeoMultiPolygon + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.GeoPolygon +import Data.Geospatial.Geometry.Aeson + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoMultiPolygon = GeoMultiPolygon { _unGeoMultiPolygon :: [GeoPolygon] } deriving (Show, Eq) + +makeLenses ''GeoMultiPolygon + +-- instances + +instance ToJSON GeoMultiPolygon where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "MultiPolygon" . _unGeoMultiPolygon + +instance FromJSON GeoMultiPolygon where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "MultiPolygon" GeoMultiPolygon o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoPoint.hs b/src/Data/Geospatial/Geometry/GeoPoint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoPoint.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoPoint +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoPoint ( + -- * Type + GeoPoint(..) + -- * Lenses + , unGeoPoint + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.Aeson + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoPoint = GeoPoint { _unGeoPoint :: GeoPositionWithoutCRS } deriving (Show, Eq) + +makeLenses ''GeoPoint + +-- instances + +instance ToJSON GeoPoint where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "Point" . _unGeoPoint + +instance FromJSON GeoPoint where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "Point" GeoPoint o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoPolygon.hs b/src/Data/Geospatial/Geometry/GeoPolygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Geometry/GeoPolygon.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Geometry.GeoPolygon +-- Copyright : (C) 2014 Dom De Re +-- License : BSD-style (see the file etc/LICENSE.md) +-- Maintainer : Dom De Re +-- +------------------------------------------------------------------- +module Data.Geospatial.Geometry.GeoPolygon ( + -- * Type + GeoPolygon(..) + -- * Lenses + , unGeoPolygon + ) where + +import Data.Geospatial.BasicTypes +import Data.Geospatial.Geometry.Aeson +import Data.Geospatial.GeoPosition + +import Control.Lens ( makeLenses ) +import Control.Monad ( mzero ) +import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) + +newtype GeoPolygon = GeoPolygon { _unGeoPolygon :: [GeoPositionWithoutCRS] } deriving (Show, Eq) + +makeLenses ''GeoPolygon + +-- instances + +instance ToJSON GeoPolygon where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "Polygon" . _unGeoPolygon + +instance FromJSON GeoPolygon where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "Polygon" GeoPolygon o + parseJSON _ = mzero diff --git a/src/Text/GeoJSON.hs b/src/Text/GeoJSON.hs deleted file mode 100644 --- a/src/Text/GeoJSON.hs +++ /dev/null @@ -1,410 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} --- Only export the JSON instances -module Text.GeoJSON () where - -import Control.Applicative -import Text.JSON - -import Data.Geospatial - --- | This module only exports the JSON Instances for the types from Data.Geospatial. --- . --- Hence you will have to refer to the `Data.Geospatial` documentation to find the documentation --- related to the Instances contained in this module. - --- $setup --- Test Bounding Box Data --- >>> let lshapedPolyVertices = [[120.0, -15.0], [127.0, -15.0], [127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: [GeoPositionWithoutCRS] --- >>> let emptyVertices = [] :: [GeoPositionWithoutCRS] --- >>> let testLatLonBBox = [-32, 147.5, -29.5, 151.0] :: BoundingBoxWithoutCRS --- >>> let testLatLonBBoxJSON = "[-32,147.5,-29.5,151]" --- >>> let testEmptyBBox = [] :: BoundingBoxWithoutCRS --- >>> let testEmptyBBoxJSON = "[]" --- --- End Test Bounding Box Data --- Test Geometry Data --- Polys --- >>> let lShapedPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" --- --- Upside down L Shaped Poly --- --- (120, -15) (127, -15) --- *---------------------------* --- | | --- | | --- | (124, -18) | --- *---------------* | --- (120, -18) | | --- | | --- | | --- | | --- | | --- | | --- | | --- *-----------* --- (124, -25) (127, -25) --- --- >>> let lShapedGeoPoly = GeoPolygon lshapedPolyVertices --- >>> let lShapedPoly = Polygon lShapedGeoPoly --- >>> let emptyPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[]}" --- >>> let emptyGeoPoly = GeoPolygon emptyVertices --- >>> let emptyPoly = Polygon emptyGeoPoly --- --- Multi Polys --- >>> let emptyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[]}" --- >>> let emptyMultiGeoPoly = GeoMultiPolygon [] --- >>> let emptyMultiPoly = MultiPolygon emptyMultiGeoPoly --- >>> let singlePolyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" --- >>> let singlePolyGeoMultiPoly = GeoMultiPolygon [lShapedGeoPoly] --- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly --- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]}" --- >>> let geoMultiPoly = GeoMultiPolygon [lShapedGeoPoly, emptyGeoPoly] --- >>> let multiPoly = MultiPolygon geoMultiPoly --- --- Line Data --- >>> let lShapedLineJSON = "{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" --- >>> let lShapedGeoLine = GeoLine lshapedPolyVertices --- >>> let lShapedLine = Line lShapedGeoLine --- >>> let emptyLineJSON = "{\"type\":\"Line\",\"coordinates\":[]}" --- >>> let emptyGeoLine = GeoLine emptyVertices --- >>> let emptyLine = Line emptyGeoLine --- --- Multi Lines --- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[]}" --- >>> let emptyMultiGeoLine = GeoMultiLine [] --- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine --- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" --- >>> let singleLineGeoMultiLine = GeoMultiLine [lShapedGeoLine] --- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine --- >>> let multiLineJSON = "{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]}" --- >>> let geoMultiLine = GeoMultiLine [lShapedGeoLine, emptyGeoLine] --- >>> let multiLine = MultiLine geoMultiLine --- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" --- >>> let emptyCollection = Collection [] --- >>> let bigassCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" --- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, emptyLine, multiLine, lShapedLine, multiPoly, singlePolyMultiPoly, lShapedPoly, emptyMultiPoly, lShapedPoly] --- --- End Test Geometry Data --- --- Test CRS Data --- >>> let testLinkCRSJSON = "{\"type\":\"link\",\"properties\":{\"href\":\"www.google.com.au\",\"type\":\"proj4\"}}" --- >>> let testLinkCRS = LinkedCRS "www.google.com.au" "proj4" --- >>> let testEPSGJSON = "{\"type\":\"epsg\",\"properties\":{\"code\":4326}}" --- >>> let testEPSG = EPSG 4326 --- >>> let testNamedCRSJSON = "{\"type\":\"name\",\"properties\":{\"name\":\"urn:ogc:def:crs:OGC:1.3:CRS84\"}}" --- >>> let testNamedCRS = NamedCRS "urn:ogc:def:crs:OGC:1.3:CRS84" --- --- Test Properties --- >>> let testProperties = makeObj [("depth", showJSON (5 :: Int)), ("comment", showJSON "Bore run over by dump truck")] --- --- Test Features --- >>> let bigFeatureJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" --- >>> let bigFeature = GeoFeature (Just testLatLonBBox) bigassCollection testProperties (Just "GW001") --- >>> let featureWithNoPropertiesJSON = "{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" --- >>> let featureWithNoProperties = let GeoFeature bbox geometry _ featureId = bigFeature in GeoFeature bbox geometry JSNull featureId --- >>> let featureWithNoGeometryJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" --- >>> let featureWithNoGeometry = let GeoFeature bbox _ props featureId = bigFeature in GeoFeature bbox NoGeometry props featureId --- >>> let featureWithNoIdJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]}" --- >>> let featureWithNoId = let GeoFeature bbox geometry props _ = bigFeature in GeoFeature bbox geometry props Nothing --- >>> let featureWithNoBBoxJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"}" --- >>> let featureWithNoBBox = let GeoFeature _ geometry props featureId = bigFeature in GeoFeature Nothing geometry props featureId --- >>> let bigAssFeatureCollectionJSON = "{\"type\":\"FeatureCollection\",\"features\":[{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]},{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}],\"bbox\":[-32,147.5,-29.5,151]}" --- >>> let bigAssFeatureCollection = GeoFeatureCollection (Just testLatLonBBox) [featureWithNoBBox, featureWithNoGeometry, featureWithNoBBox, featureWithNoId, featureWithNoProperties, bigFeature] --- >>> let bigAssFeatureCollectionWithNoBBoxJSON = "{\"type\":\"FeatureCollection\",\"features\":[{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151]},{\"type\":\"Feature\",\"properties\":null,\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"},{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":{\"type\":\"GeometryCollection\",\"geometries\":[{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"MultiLine\",\"coordinates\":[]},{\"type\":\"Line\",\"coordinates\":[]},{\"type\":\"MultiLine\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Line\",\"coordinates\":[]}]},{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"Polygon\",\"coordinates\":[]}]},{\"type\":\"MultiPolygon\",\"coordinates\":[{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]},{\"type\":\"MultiPolygon\",\"coordinates\":[]},{\"type\":\"Polygon\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]},\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}]}" --- >>> let bigAssFeatureCollectionWithNoBBox = let GeoFeatureCollection _ features = bigAssFeatureCollection in GeoFeatureCollection Nothing features --- >>> let emptyFeatureCollectionJSON = "{\"type\":\"FeatureCollection\",\"features\":[]}" --- >>> let emptyFeatureCollection = GeoFeatureCollection Nothing [] --- >>> let emptyFeatureCollectionWithBBoxJSON = "{\"type\":\"FeatureCollection\",\"features\":[],\"bbox\":[-32,147.5,-29.5,151]}" --- >>> let emptyFeatureCollectionWithBBox = GeoFeatureCollection (Just testLatLonBBox) [] --- - - - --- helper functions: - --- | A generic function that can be used to read in the GeoJSON for: --- GeoPoint, GeoMultiPoint, GeoLine, GeoMultiLine, GeoPolygon and GeoMultiPolygon --- Takes in a String for the GeoJSON geometry type, the type constructor --- for the datatype and the JSON object containing both the 'type' val and the 'coordinates' val -readGeometryGeoJSON :: (JSON a, JSON b) => String -> (a -> b) -> JSValue -> Result b -readGeometryGeoJSON geomTypeString geomType json = do - geopointObj <- readJSON json - geometryType <- valFromObj "type" geopointObj - if geometryType == geomTypeString - then - geomType <$> valFromObj "coordinates" geopointObj - else - fail $ "Invalid Geometry Type: " ++ geometryType - --- | The inverse to the above, you just give it the type string and the value for the coordinates --- and it will create the JSON object -makeGeometryGeoJSON :: (JSON a) => String -> a -> JSValue -makeGeometryGeoJSON typeString coordinates = - makeObj [("type", showJSON typeString), ("coordinates", showJSON coordinates)] - -geometryFromJSON :: String -> JSValue -> Result GeospatialGeometry -geometryFromJSON "Point" obj = Point <$> readJSON obj -geometryFromJSON "MultiPoint" obj = MultiPoint <$> readJSON obj -geometryFromJSON "Polygon" obj = Polygon <$> readJSON obj -geometryFromJSON "MultiPolygon" obj = MultiPolygon <$> readJSON obj -geometryFromJSON "Line" obj = Line <$> readJSON obj -geometryFromJSON "MultiLine" obj = MultiLine <$> readJSON obj -geometryFromJSON "GeometryCollection" (JSObject jsonObj) = Collection <$> (valFromObj "geometries" jsonObj >>= readJSON) -geometryFromJSON "GeometryCollection" _ = Error "Invalid value type for 'geometries' attribute.." -geometryFromJSON typeString _ = Error $ "Invalid Geometry Type: " ++ typeString - -crsPropertyFromObj :: (JSON a) => String -> JSObject JSValue -> Result a -crsPropertyFromObj name obj = do - props <- valFromObj "properties" obj - valFromObj name props - -crsObjectFromJSON :: String -> JSObject JSValue -> Result CRSObject -crsObjectFromJSON "name" obj = NamedCRS <$> crsPropertyFromObj "name" obj -crsObjectFromJSON "epsg" obj = EPSG <$> crsPropertyFromObj "code" obj -crsObjectFromJSON "link" obj = LinkedCRS <$> crsPropertyFromObj "href" obj <*> crsPropertyFromObj "type" obj -crsObjectFromJSON typeString _ = Error $ "Invalid or unimplemented CRS Object Type: " ++ typeString - --- | get an optional value out of a JSON object: -optValFromObj :: (JSON a) => String -> JSObject JSValue -> Result (Maybe a) -optValFromObj attribute object = resultToMaybe $ valFromObj attribute object - where - resultToMaybe (Ok x) = Ok $ Just x - resultToMaybe (Error _) = Ok Nothing - --- | The other way around, given an optional value, will return the attributes that --- should be added to the makeObj input -optAttributes :: (JSON a) => String -> Maybe a -> [(String, JSValue)] -optAttributes _ Nothing = [] -optAttributes name (Just x) = [(name, showJSON x)] --- end helper functions - --- Conversion of Geospatial data types into GeoJSON, --- We do this by inducting all the types from Data.Geospatial.Types into --- the JSON typeclass - -instance JSON GeoPoint where - readJSON = readGeometryGeoJSON "Point" GeoPoint - - showJSON (GeoPoint point) = makeGeometryGeoJSON "Point" point - -instance JSON GeoMultiPoint where - readJSON = readGeometryGeoJSON "MultiPoint" GeoMultiPoint - - showJSON (GeoMultiPoint points) = makeGeometryGeoJSON "MultiPoint" points - -instance JSON GeoPolygon where - readJSON = readGeometryGeoJSON "Polygon" GeoPolygon - - showJSON (GeoPolygon vertices) = makeGeometryGeoJSON "Polygon" vertices - -instance JSON GeoMultiPolygon where - readJSON = readGeometryGeoJSON "MultiPolygon" GeoMultiPolygon - - showJSON (GeoMultiPolygon polys) = makeGeometryGeoJSON "MultiPolygon" polys - -instance JSON GeoLine where - readJSON = readGeometryGeoJSON "Line" GeoLine - - showJSON (GeoLine line) = makeGeometryGeoJSON "Line" line - -instance JSON GeoMultiLine where - readJSON = readGeometryGeoJSON "MultiLine" GeoMultiLine - - showJSON (GeoMultiLine lines') = makeGeometryGeoJSON "MultiLine" lines' - --- | --- encodes and decodes Geometry Objects to and from GeoJSON --- (refer to source to see the values for the test values) --- --- >>> encode NoGeometry --- "null" --- --- >>> decode "null" :: Result GeospatialGeometry --- Ok NoGeometry --- --- >>> encode lShapedPoly == lShapedPolyJSON --- True --- --- >>> decode lShapedPolyJSON == Ok lShapedPoly --- True --- --- >>> encode emptyPoly == emptyPolyJSON --- True --- --- >>> decode emptyPolyJSON == Ok emptyPoly --- True --- --- >>> encode emptyMultiPoly == emptyMultiPolyJSON --- True --- --- >>> decode emptyMultiPolyJSON == Ok emptyMultiPoly --- True --- --- >>> encode singleLineMultiLine == singleLineMultiLineJSON --- True --- --- >>> decode singleLineMultiLineJSON == Ok singleLineMultiLine --- True --- --- >>> encode multiLine == multiLineJSON --- True --- --- >>> decode multiLineJSON == Ok multiLine --- True --- --- >>> encode emptyCollection == emptyCollectionJSON --- True --- --- >>> decode emptyCollectionJSON == Ok emptyCollection --- True --- --- >>> encode bigassCollection == bigassCollectionJSON --- True --- --- >>> decode bigassCollectionJSON == Ok bigassCollection --- True --- -instance JSON GeospatialGeometry where - readJSON JSNull = Ok NoGeometry - readJSON json = do - geometryObj <- readJSON json - geometryType <- valFromObj "type" geometryObj - geometryFromJSON geometryType (JSObject geometryObj) - - showJSON (NoGeometry) = JSNull - showJSON (Point point) = showJSON point - showJSON (MultiPoint points) = showJSON points - showJSON (Polygon vertices) = showJSON vertices - showJSON (MultiPolygon vertices) = showJSON vertices - showJSON (Line vertices) = showJSON vertices - showJSON (MultiLine vertices) = showJSON vertices - showJSON (Collection geometries) = makeObj [("type", showJSON "GeometryCollection"), ("geometries", showJSON geometries)] - --- | --- encode and decodes CRS Objects to and from GeoJSON --- --- >>> encode testLinkCRS == testLinkCRSJSON --- True --- --- >>> decode testLinkCRSJSON == Ok testLinkCRS --- True --- --- >>> encode testNamedCRS == testNamedCRSJSON --- True --- --- >>> decode testNamedCRSJSON == Ok testNamedCRS --- True --- --- >>> encode testEPSG == testEPSGJSON --- True --- --- >>> decode testEPSGJSON == Ok testEPSG --- True --- --- >>> encode NoCRS --- "null" --- --- >>> decode "null" == Ok NoCRS --- True --- -instance JSON CRSObject where - readJSON JSNull = Ok NoCRS - readJSON json = do - crsObject <- readJSON json - crsType <- valFromObj "type" crsObject - crsObjectFromJSON crsType crsObject - - showJSON (NamedCRS name) = makeObj [("type", showJSON "name"), ("properties", showJSON (makeObj [("name", showJSON name)]))] - showJSON (EPSG code) = makeObj [("type", showJSON "epsg"), ("properties", showJSON (makeObj [("code", showJSON code)]))] - showJSON (LinkedCRS href format ) = makeObj [("type", showJSON "link"), ("properties", showJSON (makeObj [("href", showJSON href), ("type", showJSON format)]))] - showJSON NoCRS = JSNull - --- | encodes and decodes Feature objects to and from GeoJSON --- --- >>> encode bigFeature == bigFeatureJSON --- True --- --- >>> decode bigFeatureJSON == Ok bigFeature --- True --- --- >>> encode featureWithNoProperties == featureWithNoPropertiesJSON --- True --- --- >>> decode featureWithNoPropertiesJSON == Ok featureWithNoProperties --- True --- --- >>> encode featureWithNoId == featureWithNoIdJSON --- True --- --- >>> decode featureWithNoIdJSON == Ok featureWithNoId --- True --- --- >>> encode featureWithNoBBox == featureWithNoBBoxJSON --- True --- --- >>> decode featureWithNoBBoxJSON == Ok featureWithNoBBox --- True --- --- >>> encode featureWithNoGeometry == featureWithNoGeometryJSON --- True --- --- >>> decode featureWithNoGeometryJSON == Ok featureWithNoGeometry --- True --- -instance JSON GeoFeature where - readJSON json = do - obj <- readJSON json - objType <- valFromObj "type" obj - if objType /= "Feature" - then - fail $ "Invalid GeoJSON type for a Feature: " ++ objType - else - GeoFeature <$> optValFromObj "bbox" obj - <*> valFromObj "geometry" obj - <*> valFromObj "properties" obj - <*> optValFromObj "id" obj - - showJSON (GeoFeature bbox' geom props featureId') = makeObj $ baseAttributes ++ optAttributes "bbox" bbox' ++ optAttributes "id" featureId' - where - baseAttributes = [("type", showJSON "Feature"), ("properties", showJSON props), ("geometry", showJSON geom)] - --- | Encodes and Decodes FeatureCollection objects to and from GeoJSON --- --- >>> encode bigAssFeatureCollection == bigAssFeatureCollectionJSON --- True --- --- >>> decode bigAssFeatureCollectionJSON == Ok bigAssFeatureCollection --- True --- --- >>> encode bigAssFeatureCollectionWithNoBBox == bigAssFeatureCollectionWithNoBBoxJSON --- True --- --- >>> decode bigAssFeatureCollectionWithNoBBoxJSON == Ok bigAssFeatureCollectionWithNoBBox --- True --- --- >>> encode emptyFeatureCollectionWithBBox == emptyFeatureCollectionWithBBoxJSON --- True --- --- >>> decode emptyFeatureCollectionWithBBoxJSON == Ok emptyFeatureCollectionWithBBox --- True --- --- >>> encode emptyFeatureCollection == emptyFeatureCollectionJSON --- True --- --- >>> decode emptyFeatureCollectionJSON == Ok emptyFeatureCollection --- True --- -instance JSON GeoFeatureCollection where - readJSON json = do - obj <- readJSON json - objType <- valFromObj "type" obj - if objType /= "FeatureCollection" - then - fail $ "Invalid GeoJSON type for a Feature Collection: " ++ objType - else - GeoFeatureCollection <$> optValFromObj "bbox" obj <*> valFromObj "features" obj - - showJSON (GeoFeatureCollection bbox' features) = makeObj $ baseAttributes ++ optAttributes "bbox" bbox' - where - baseAttributes = [("type", showJSON "FeatureCollection"), ("features", showJSON features)] -