diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -0,0 +1,20 @@ +# BSD 3-Clause License + +Copyright (c) 2014-2018, HS-GeoJSON Project +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/README.md b/README.md --- a/README.md +++ b/README.md @@ -32,9 +32,6 @@ ## 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/`. @@ -49,7 +46,5 @@ 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/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,77 +1,7 @@ -#!/usr/bin/env runhaskell -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wall #-} + module Main (main) where -import Data.List ( nub ) -import Data.Version ( showVersion ) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -#endif -import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) -import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, findProgramVersion, currentDir ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag ) -import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) -import Distribution.Verbosity ( Verbosity ) -import Distribution.Version ( Version ) -import System.Directory ( getDirectoryContents ) -import System.FilePath ( () ) +import Distribution.Simple main :: IO () -main = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - } - -generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule verbosity pkg lbi = do - let dir = autogenModulesDir lbi - createDirectoryIfMissingVerbose verbosity True dir - withLibLBI pkg lbi $ \_ libcfg -> - withTestLBI pkg lbi $ \suite suitecfg -> do - ghcOpts <- - generateCabalDevOpts - <$> isCabalDevPresent - <*> getGhcVersion verbosity - rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines - [ "module Build_" ++ testName suite ++ " where" - , "deps :: [String]" - , "deps = " ++ show (formatdeps (testDeps libcfg suitecfg)) - , "opts :: [String]" - , "opts = " ++ show ghcOpts - ] - where - formatdeps = map (formatone . snd) - formatone p = case packageName p of - PackageName n -> n ++ "-" ++ showVersion (packageVersion p) - -isCabalDevPresent :: IO Bool -isCabalDevPresent = do - contents <- getDirectoryContents currentDir - return $ "cabal-dev" `elem` contents - -getGhcVersion :: Verbosity -> IO (Maybe Version) -getGhcVersion verb = findProgramVersion - "--version" - (last . words) - verb - "ghc" - -generateCabalDevOpts :: Bool -> Maybe Version -> [String] -generateCabalDevOpts isCabalDev version = - case version of - Nothing -> [] - Just version' -> - let - baseOpts = [ "-Lcabal-dev/lib" - , "-package-conf=cabal-dev/packages-" ++ showVersion version' ++ ".conf" - ] - in - if isCabalDev then baseOpts else [] - -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys +main = defaultMain diff --git a/doctests/Main.hs b/doctests/Main.hs deleted file mode 100644 --- a/doctests/Main.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE CPP #-} -module Main where - -import Build_doctests (deps, opts) -import Control.Monad - -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative -#endif - -import Data.List -import System.Directory -import System.FilePath -import Test.DocTest - -extensions :: [String] -extensions = - [ "OverloadedStrings" - ] - -docopts :: [FilePath] -docopts = - [ "-isrc" - , "-idist/build/autogen" - , "-optP-include" - , "-optPdist/build/autogen/cabal_macros.h" - , "-hide-all-packages" - ] ++ map ("-package=" ++) deps ++ opts ++ map ("-X" ++) extensions - --- the list of all file paths to search for source files -sourceDirs :: [FilePath] -sourceDirs = ["src"] - -main :: IO () -main = getSources >>= \sources -> doctest $ docopts ++ sources - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c - -isSourceFile :: FilePath -> Bool -isSourceFile p = (takeFileName p /= "Setup.hs") && (".hs" `isSuffixOf` p) - -getSources :: IO [FilePath] -getSources = liftM (filter isSourceFile . concat) (mapM go sourceDirs) - where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs diff --git a/etc/LICENCE.md b/etc/LICENCE.md deleted file mode 100644 --- a/etc/LICENCE.md +++ /dev/null @@ -1,20 +0,0 @@ -# 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,105 +1,95 @@ -name: geojson -version: 1.3.1 -license: BSD3 -license-file: etc/LICENCE.md -author: Dom De Re -maintainer: Dom De Re -copyright: Copyright (C) 2013-2014 -synopsis: A thin GeoJSON Layer above the aeson library -category: Data -description: A thin GeoJSON Layer above the aeson library. - . - It currently conforms to version 1.0 of the GeoJSON spec which can be found here: - . - +name: geojson +version: 1.3.2 +license: BSD3 +license-file: LICENCE +author: Dom De Re +maintainer: Andrew Newman +copyright: Copyright (C) 2013-2018 +synopsis: A thin GeoJSON Layer above the aeson library +category: Data +description: A thin GeoJSON Layer above the aeson library. + . + It currently conforms to version 1.0 of the GeoJSON spec which can be found here: + . + -homepage: https://github.com/domdere/hs-geojson -bug-reports: https://github.com/domdere/hs-geojson/issues -cabal-version: >= 1.22 -build-type: Custom -tested-with: GHC == 7.10.1 -extra-source-files: README.md, - CHANGELOG.md +homepage: https://github.com/newmana/hs-geojson +bug-reports: https://github.com/newmana/hs-geojson/issues +cabal-version: >= 1.10 +build-type: Simple +extra-source-files: README.md, + CHANGELOG.md source-repository head type: git - location: https://github.com/domdere/hs-geojson.git + location: https://github.com/newmana/hs-geojson.git source-repository this type: git - location: https://github.com/domdere/hs-geojson.git - tag: 1.3.0 - -flag small_base - description: Choose the new, split-up base package. + location: https://github.com/newmana/hs-geojson.git + tag: 1.3.2 library - default-language: Haskell2010 - - build-depends: base < 5 && >= 4 - , aeson >= 0.8 && < 1.0 - , lens >= 4.11 && < 4.13 - , semigroups == 0.16.* - , text == 1.2.* - , transformers >= 0.3 && < 0.5 - , validation == 0.5.* - , vector == 0.10.* - - ghc-options: -Wall - -fno-warn-unused-imports - -fno-warn-unused-binds - -fno-warn-unused-do-bind - -fno-warn-type-defaults - hs-source-dirs: src - + build-depends: base < 5 && >= 4 + , aeson >= 0.8 + , lens >= 4.11 + , semigroups >= 0.16 + , text >= 1.2 + , scientific >= 0.2.0 + , transformers >= 0.3 + , validation >= 0.5 + , vector >= 0.10 exposed-modules: Data.Geospatial , Data.LinearRing , Data.LineString - - 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 - - main-is: - Main.hs - - default-language: - Haskell2010 - - build-depends: base < 5 && >= 3 - , bytestring == 0.10.* - , doctest == 0.10.* - , filepath >= 1.3 && < 1.5 - , directory == 1.2.* - , QuickCheck == 2.8.* - , template-haskell + , Data.Geospatial.Internal.BasicTypes + , Data.Geospatial.Internal.CRS + , Data.Geospatial.Internal.GeoFeature + , Data.Geospatial.Internal.GeoFeatureCollection + , Data.Geospatial.Internal.Geometry + , Data.Geospatial.Internal.Geometry.GeoMultiLine + , Data.Geospatial.Internal.Geometry.GeoMultiPoint + , Data.Geospatial.Internal.Geometry.GeoMultiPolygon + , Data.Geospatial.Internal.Geometry.GeoLine + , Data.Geospatial.Internal.Geometry.GeoPoint + , Data.Geospatial.Internal.Geometry.GeoPolygon + , Data.Geospatial.Internal.Geometry.Aeson + , Data.Geospatial.Internal.GeoPosition + default-language: Haskell2010 + ghc-options: -Wall - ghc-options: - -Wall +test-suite geojson-test + hs-source-dirs: test + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: base < 5 && >= 4 + , aeson >= 0.8 + , bytestring >= 0.10 + , geojson + , tasty + , tasty-hspec + , tasty-quickcheck + , text >= 1.2 + , validation >= 0.5 + other-modules: Arbitrary + , Fixture + , Data.LinearRingTests + , Data.LineStringTests + , Data.Geospatial.Internal.CRSTests + , Data.Geospatial.Internal.GeoFeatureCollectionTests + , Data.Geospatial.Internal.GeoFeatureTests + , Data.Geospatial.Internal.GeometryTests + default-language: Haskell2010 + ghc-options: -Wall -threaded - hs-source-dirs: - doctests - -test-suite hlint - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Main.hs +test-suite geojson-hlint hs-source-dirs: hlint + main-is: Main.hs + type: exitcode-stdio-1.0 build-depends: base - , hlint == 1.9.* + , hlint + default-language: Haskell2010 + ghc-options: -Wall + -threaded diff --git a/hlint/Main.hs b/hlint/Main.hs --- a/hlint/Main.hs +++ b/hlint/Main.hs @@ -1,12 +1,12 @@ module Main where -import Control.Monad ( unless ) -import Language.Haskell.HLint ( hlint ) -import System.Environment ( getArgs ) -import System.Exit ( exitFailure ) +import Control.Monad (unless) +import Language.Haskell.HLint (hlint) +import System.Environment (getArgs) +import System.Exit (exitFailure) main :: IO () main = do args <- getArgs - hlints <- hlint $ ["src", "--cpp-define=HLINT", "--cpp-ansi"] ++ args + hlints <- hlint $ ["src/", "test/", "hlint/", "--cpp-define=HLINT", "--cpp-ansi"] ++ args unless (null hlints) exitFailure diff --git a/src/Data/Geospatial.hs b/src/Data/Geospatial.hs --- a/src/Data/Geospatial.hs +++ b/src/Data/Geospatial.hs @@ -1,9 +1,9 @@ ------------------------------------------------------------------- -- | -- Module : Data.Geospatial --- Copyright : (C) 2014 Dom De Re --- License : BSD-style (see the file etc/LICENSE.md) --- Maintainer : Dom De Re +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman -- -- Refer to the GeoJSON Spec http://www.geojson.org/geojson-spec.html -- @@ -15,6 +15,7 @@ , Easting , Northing , Altitude + , FeatureID(..) , GeoPositionWithoutCRS , GeoPosition(..) , GeoPoint(..) @@ -30,7 +31,6 @@ , FormatString , ProjectionType , CRSObject(..) - , FeatureID , BoundingBoxWithoutCRS , GeoFeature(..) , GeoFeatureCollection(..) @@ -69,9 +69,9 @@ , _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 +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.CRS +import Data.Geospatial.Internal.GeoFeature +import Data.Geospatial.Internal.GeoFeatureCollection +import Data.Geospatial.Internal.Geometry +import Data.Geospatial.Internal.GeoPosition diff --git a/src/Data/Geospatial/BasicTypes.hs b/src/Data/Geospatial/BasicTypes.hs deleted file mode 100644 --- a/src/Data/Geospatial/BasicTypes.hs +++ /dev/null @@ -1,60 +0,0 @@ -------------------------------------------------------------------- --- | --- 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 = Double -type Longitude = Double -type Easting = Double -type Northing = Double -type Altitude = Double - --- | (`GeoPositionWithoutCRS` is a catch all for indeterminate CRSs and for expression of positions --- before a CRS has been determined --- -type GeoPositionWithoutCRS = [Double] - -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 = [Double] - - diff --git a/src/Data/Geospatial/CRS.hs b/src/Data/Geospatial/CRS.hs deleted file mode 100644 --- a/src/Data/Geospatial/CRS.hs +++ /dev/null @@ -1,137 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/Data/Geospatial/GeoFeature.hs +++ /dev/null @@ -1,206 +0,0 @@ -{-# 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 Prelude ( Show, Eq(..), ($) ) -import Control.Applicative ( (<$>), (<*>) ) -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), (.:), (.:?), (.=), object ) -import Data.List ( (++) ) -import Data.Maybe ( Maybe ) -import Data.Text ( Text ) - --- $setup --- --- >>> import Data.LinearRing --- >>> import Data.LineString --- >>> import Data.Geospatial.Geometry.GeoMultiPolygon (mergeGeoPolygons) --- >>> import Data.Geospatial.Geometry.GeoMultiLine (mergeGeoLines) --- --- >>> import Control.Monad ( return ) --- >>> 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 = return (makeLinearRing [120.0, -15.0] [127.0, -15.0] [127.0, -25.0] [[124.0, -25.0], [124.0, -18.0], [120.0, -18.0]]) :: [LinearRing GeoPositionWithoutCRS] --- >>> let lshapedPolyLineVertices = makeLineString [120.0, -15.0] [127.0, -15.0] [[127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: LineString GeoPositionWithoutCRS --- >>> let emptyVertices = [] :: [LinearRing 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 = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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 = "{\"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\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]]}" --- >>> let singlePolyGeoMultiPoly = mergeGeoPolygons [lShapedGeoPoly] --- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly --- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],[]]}" --- >>> let geoMultiPoly = mergeGeoPolygons [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 lshapedPolyLineVertices --- >>> let lShapedLine = Line lShapedGeoLine --- --- Multi Lines --- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[]}" --- >>> let emptyMultiGeoLine = GeoMultiLine [] --- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine --- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[{\"type\":\"Line\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}]}" --- >>> let singleLineGeoMultiLine = mergeGeoLines [lShapedGeoLine] --- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine --- >>> let multiLineJSON = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"}" --- >>> let geoMultiLine = mergeGeoLines [lShapedGeoLine, lShapedGeoLine] --- >>> let multiLine = MultiLine geoMultiLine --- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" --- >>> let emptyCollection = Collection [] --- >>> let bigassCollectionJSON = "{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"}" --- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, 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 = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> let bigFeature = GeoFeature (Just testLatLonBBox) bigassCollection testProperties (Just "GW001") --- >>> let featureWithNoPropertiesJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null}" --- >>> 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 = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> let featureWithNoId = let GeoFeature bbox geometry props _ = bigFeature in GeoFeature bbox geometry props Nothing --- >>> let featureWithNoBBoxJSON = "{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> 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 deleted file mode 100644 --- a/src/Data/Geospatial/GeoFeatureCollection.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# 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.Aeson - -import Prelude ( Show, Eq(..), ($) ) -import Control.Applicative ( (<$>), (<*>) ) -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), (.:), (.:?), (.=), object ) -import Data.List ( (++) ) -import Data.Maybe ( Maybe(..) ) -import Data.Text ( Text ) - --- $setup --- --- >>> import Data.Geospatial.Geometry --- >>> import Data.LinearRing --- >>> import Data.LineString --- >>> import Data.Geospatial.Geometry.GeoMultiPolygon (mergeGeoPolygons) --- >>> import Data.Geospatial.Geometry.GeoMultiLine (mergeGeoLines) --- --- >>> import Control.Monad ( return ) --- >>> 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 = return (makeLinearRing [120.0, -15.0] [127.0, -15.0] [127.0, -25.0] [[124.0, -25.0], [124.0, -18.0], [120.0, -18.0]]) :: [LinearRing GeoPositionWithoutCRS] --- >>> let lshapedPolyLineVertices = makeLineString [120.0, -15.0] [127.0, -15.0] [[127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: LineString GeoPositionWithoutCRS --- >>> let emptyVertices = [] :: [LinearRing GeoPositionWithoutCRS] --- >>> let emptyLineVertices = [] :: [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 = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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 = "{\"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\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]]}" --- >>> let singlePolyGeoMultiPoly = mergeGeoPolygons [lShapedGeoPoly] --- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly --- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],[]]}" --- >>> let geoMultiPoly = mergeGeoPolygons [lShapedGeoPoly, emptyGeoPoly] --- >>> let multiPoly = MultiPolygon geoMultiPoly --- --- Line Data --- >>> let lShapedLineJSON = "{\"type\":\"LineString\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" --- >>> let lShapedGeoLine = GeoLine lshapedPolyLineVertices --- >>> let lShapedLine = Line lShapedGeoLine --- --- Multi Lines --- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[]}" --- >>> let emptyMultiGeoLine = GeoMultiLine [] --- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine --- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]}" --- >>> let singleLineGeoMultiLine = mergeGeoLines [lShapedGeoLine] --- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine --- >>> let multiLineJSON = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"}" --- >>> let geoMultiLine = mergeGeoLines [lShapedGeoLine, lShapedGeoLine] --- >>> let multiLine = MultiLine geoMultiLine --- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" --- >>> let emptyCollection = Collection [] --- >>> let bigassCollectionJSON = "{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"}" --- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, 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 = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> let bigFeature = GeoFeature (Just testLatLonBBox) bigassCollection testProperties (Just "GW001") --- >>> let featureWithNoPropertiesJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null}" --- >>> 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 = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> let featureWithNoId = let GeoFeature bbox geometry props _ = bigFeature in GeoFeature bbox geometry props Nothing --- >>> let featureWithNoBBoxJSON = "{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" --- >>> 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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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 = "{\"features\":[{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}],\"type\":\"FeatureCollection\"}" --- >>> 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 deleted file mode 100644 --- a/src/Data/Geospatial/GeoPosition.hs +++ /dev/null @@ -1,38 +0,0 @@ -------------------------------------------------------------------- --- | --- 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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry.hs +++ /dev/null @@ -1,246 +0,0 @@ -{-# 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(..), splitGeoMultiPoint, mergeGeoPoints - , GeoPolygon(..) - , GeoMultiPolygon(..), splitGeoMultiPolygon, mergeGeoPolygons - , GeoLine(..) - , GeoMultiLine(..), splitGeoMultiLine, mergeGeoLines - , 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 Data.LinearRing --- >>> import Data.LineString --- >>> import Data.Geospatial.Geometry.GeoMultiPolygon (mergeGeoPolygons) --- >>> import Data.Geospatial.Geometry.GeoMultiLine (mergeGeoLines) --- --- >>> import Control.Monad ( return ) --- >>> import qualified Data.Aeson as A --- >>> import qualified Data.ByteString.Lazy.Char8 as BS --- --- >>> let lshapedPolyVertices = return (makeLinearRing [120.0, -15.0] [127.0, -15.0] [127.0, -25.0] [[124.0, -25.0], [124.0, -18.0], [120.0, -18.0]]) :: [LinearRing GeoPositionWithoutCRS] --- >>> let lshapedPolyLineVertices = makeLineString [120.0, -15.0] [127.0, -15.0] [[127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] :: LineString GeoPositionWithoutCRS --- >>> let emptyVertices = [] :: [LinearRing 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],[120,-15]]],\"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 = "{\"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\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]]}" --- >>> let singlePolyGeoMultiPoly = mergeGeoPolygons [lShapedGeoPoly] --- >>> let singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly --- >>> let multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],[]]}" --- >>> let geoMultiPoly = mergeGeoPolygons [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 lshapedPolyLineVertices --- >>> let lShapedLine = Line lShapedGeoLine --- --- Multi Lines --- >>> let emptyMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[]}" --- >>> let emptyMultiGeoLine = GeoMultiLine [] --- >>> let emptyMultiLine = MultiLine emptyMultiGeoLine --- >>> let singleLineMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]}" --- >>> let singleLineGeoMultiLine = mergeGeoLines [lShapedGeoLine] --- >>> let singleLineMultiLine = MultiLine singleLineGeoMultiLine --- >>> let multiLineJSON = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"}" --- >>> let geoMultiLine = mergeGeoLines [lShapedGeoLine, lShapedGeoLine] --- >>> let multiLine = MultiLine geoMultiLine --- >>> let emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" --- >>> let emptyCollection = Collection [] --- >>> let bigassCollectionJSON = "{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"}" --- >>> let bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, 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 "LineString" obj = Line <$> parseJSON obj -geometryFromAeson "MultiLineString" 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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/Aeson.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoLine.hs +++ /dev/null @@ -1,38 +0,0 @@ -{-# 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 Data.LineString - -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..) ) - -newtype GeoLine = GeoLine { _unGeoLine :: LineString GeoPositionWithoutCRS } deriving (Show, Eq) - -makeLenses ''GeoLine - --- instances - -instance ToJSON GeoLine where --- toJSON :: a -> Value - toJSON = makeGeometryGeoAeson "LineString" . _unGeoLine - -instance FromJSON GeoLine where --- parseJSON :: Value -> Parser a - parseJSON (Object o) = readGeometryGeoAeson "LineString" GeoLine o - parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoMultiLine.hs b/src/Data/Geospatial/Geometry/GeoMultiLine.hs deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoMultiLine.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# 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 - -- * To Points - , splitGeoMultiLine, mergeGeoLines - ) where - -import Data.Geospatial.BasicTypes -import Data.Geospatial.Geometry.GeoLine -import Data.Geospatial.Geometry.Aeson -import Data.LineString - -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) - -newtype GeoMultiLine = GeoMultiLine { _unGeoMultiLine :: [LineString GeoPositionWithoutCRS] } deriving (Show, Eq) - -makeLenses ''GeoMultiLine - - --- | Split GeoMultiLine coordinates into multiple GeoLines -splitGeoMultiLine:: GeoMultiLine -> [GeoLine] -splitGeoMultiLine = map GeoLine . _unGeoMultiLine - --- | Merge multiple GeoLines into one GeoMultiLine -mergeGeoLines :: [GeoLine] -> GeoMultiLine -mergeGeoLines = GeoMultiLine . map _unGeoLine - --- instances - -instance ToJSON GeoMultiLine where --- toJSON :: a -> Value - toJSON = makeGeometryGeoAeson "MultiLineString" . _unGeoMultiLine - -instance FromJSON GeoMultiLine where --- parseJSON :: Value -> Parser a - parseJSON (Object o) = readGeometryGeoAeson "MultiLineString" GeoMultiLine o - parseJSON _ = mzero diff --git a/src/Data/Geospatial/Geometry/GeoMultiPoint.hs b/src/Data/Geospatial/Geometry/GeoMultiPoint.hs deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoMultiPoint.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# 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 - -- * To Points - , splitGeoMultiPoint, mergeGeoPoints - ) 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 :: [GeoPositionWithoutCRS] } deriving (Show, Eq) - -makeLenses ''GeoMultiPoint - - --- | Split GeoMultiPoint coordinates into multiple GeoPoints -splitGeoMultiPoint:: GeoMultiPoint -> [GeoPoint] -splitGeoMultiPoint = map GeoPoint . _unGeoMultiPoint - --- | Merge multiple GeoPoints into one GeoMultiPoint -mergeGeoPoints :: [GeoPoint] -> GeoMultiPoint -mergeGeoPoints = GeoMultiPoint . map _unGeoPoint - --- 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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoMultiPolygon.hs +++ /dev/null @@ -1,49 +0,0 @@ -{-# 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 - -- * To Polygons - , splitGeoMultiPolygon, mergeGeoPolygons - ) where - -import Data.Geospatial.BasicTypes -import Data.Geospatial.Geometry.GeoPolygon -import Data.Geospatial.Geometry.Aeson -import Data.LinearRing - -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) - -newtype GeoMultiPolygon = GeoMultiPolygon { _unGeoMultiPolygon :: [[LinearRing GeoPositionWithoutCRS]] } deriving (Show, Eq) - --- | Split GeoMultiPolygon coordinates into multiple GeoPolygons -splitGeoMultiPolygon :: GeoMultiPolygon -> [GeoPolygon] -splitGeoMultiPolygon = map GeoPolygon . _unGeoMultiPolygon - --- | Merge multiple GeoPolygons into one GeoMultiPolygon -mergeGeoPolygons :: [GeoPolygon] -> GeoMultiPolygon -mergeGeoPolygons = GeoMultiPolygon . map _unGeoPolygon - -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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoPoint.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/Data/Geospatial/Geometry/GeoPolygon.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# 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 Data.LinearRing - -import Control.Lens ( makeLenses ) -import Control.Monad ( mzero ) -import Data.Aeson ( FromJSON(..), ToJSON(..), Value(..), Object ) - -newtype GeoPolygon = GeoPolygon { _unGeoPolygon :: [LinearRing 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/Data/Geospatial/Internal/BasicTypes.hs b/src/Data/Geospatial/Internal/BasicTypes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/BasicTypes.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.BasicTypes +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- Basic types for GeoJSON representations. +------------------------------------------------------------------- +module Data.Geospatial.Internal.BasicTypes ( + -- * Coordinate types + Latitude + , Longitude + , Easting + , Northing + , Altitude + , GeoPositionWithoutCRS + -- * CRS Reference types + , Name + , Code + , Href + , FormatString + , ProjectionType + -- * Feature Types + , BoundingBoxWithoutCRS + , FeatureID (..) + ) where + +import Data.Aeson (FromJSON (..), ToJSON (..), Value (..)) +import Data.Scientific (Scientific, toBoundedInteger) +import Data.Text (Text) + +type Latitude = Double +type Longitude = Double +type Easting = Double +type Northing = Double +type Altitude = Double + +-- | (`GeoPositionWithoutCRS` is a catch all for indeterminate CRSs and for expression of positions +-- before a CRS has been determined +-- +type GeoPositionWithoutCRS = [Double] + +type Name = Text +type Code = Int +type Href = Text +type FormatString = Text +type ProjectionType = Text + +-- Feature Types + +data FeatureID = + FeatureIDText Text + | FeatureIDNumber Int deriving (Show, Eq) + +instance FromJSON FeatureID where + parseJSON (Number nID) = + case x of + Nothing -> fail "Not an integer value" + Just z -> pure $ FeatureIDNumber z + where + x = toBoundedInteger nID :: Maybe Int + parseJSON (String sID) = pure $ FeatureIDText sID + parseJSON _ = fail "unknown id type" + + +instance ToJSON FeatureID where + toJSON (FeatureIDText a) = String a + toJSON (FeatureIDNumber b) = Number (fromInteger $ toInteger b :: Scientific) + + +-- | 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 = [Double] diff --git a/src/Data/Geospatial/Internal/CRS.hs b/src/Data/Geospatial/Internal/CRS.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/CRS.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.CRS +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- See Section 3 /Coordinate Reference System Objects/ +-- in the GeoJSON Spec +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.CRS ( + -- * Types + CRSObject(..) + -- * Functions + , defaultCRS + -- * Prisms + , _NoCRS + , _NamedCRS + , _EPSG + , _LinkedCRS + ) where + +import Data.Geospatial.Internal.BasicTypes + +import Control.Applicative ((<$>), (<*>)) +import Control.Lens (makePrisms) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), Object, + ToJSON (..), Value (..), + object, (.:), (.=)) +import Data.Aeson.Types (Parser) +import Data.Text (Text) + +-- | 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 + +-- | +-- decode CRS Objects from GeoJSON +-- +-- Aeson doesnt decode "null" to `Null` unfortunately +-- +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 +-- +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/Internal/GeoFeature.hs b/src/Data/Geospatial/Internal/GeoFeature.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/GeoFeature.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.GeoFeature +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- See Section 2.2 /Feature Objects/ of the GeoJSON spec. +-- Parameterised on the property type +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.GeoFeature ( + -- * Types + GeoFeature(..) + -- * Lenses + , bbox + , geometry + , properties + , featureId + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry +import Data.Geospatial.Internal.Geometry.Aeson + +import Control.Applicative ((<$>), (<*>)) +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..), object, + (.:), (.:?), (.=)) +import Data.List ((++)) +import Data.Maybe (Maybe) +import Data.Text (Text) +import Prelude (Eq (..), Show, ($)) + +-- | 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 from GeoJSON +-- +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 GeoJSON +-- +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/Internal/GeoFeatureCollection.hs b/src/Data/Geospatial/Internal/GeoFeatureCollection.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/GeoFeatureCollection.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.GeoFeature +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- See Section 2.3 /Feature Collection Objects/ of the GeoJSON spec +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.GeoFeatureCollection ( + -- * Types + GeoFeatureCollection(..) + -- * Lenses + , boundingbox + , geofeatures + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.GeoFeature +import Data.Geospatial.Internal.Geometry.Aeson + +import Control.Applicative ((<$>), (<*>)) +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..), object, + (.:), (.:?), (.=)) +import Data.List ((++)) +import Data.Maybe (Maybe (..)) +import Data.Text (Text) +import Prelude (Eq (..), Show, ($)) + +-- | 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 + +-- | Decode FeatureCollection objects from GeoJSON +-- +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 + +-- | Encode FeatureCollection objects to GeoJSON +-- +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/Internal/GeoPosition.hs b/src/Data/Geospatial/Internal/GeoPosition.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/GeoPosition.hs @@ -0,0 +1,38 @@ +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.GeoPosition +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- see Section 2.1.1 /Position/ in the GeoJSON Spec +------------------------------------------------------------------- +module Data.Geospatial.Internal.GeoPosition ( + -- * Type + GeoPosition(..) + -- * Functions + , stripCRSFromPosition + ) where + +import Data.Geospatial.Internal.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/Internal/Geometry.hs b/src/Data/Geospatial/Internal/Geometry.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- See section 2.1 "Geometry Objects" in the GeoJSON Spec. +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry ( + -- * Types + GeoPoint(..) + , GeoMultiPoint(..), splitGeoMultiPoint, mergeGeoPoints + , GeoPolygon(..) + , GeoMultiPolygon(..), splitGeoMultiPolygon, mergeGeoPolygons + , GeoLine(..) + , GeoMultiLine(..), splitGeoMultiLine, mergeGeoLines + , GeospatialGeometry(..) + -- * Lenses + , unGeoPoint + , unGeoMultiPoint + , unGeoPolygon + , unGeoMultiPolygon + , unGeoLine + , unGeoMultiLine + -- * Prisms + , _NoGeometry + , _Point + , _MultiPoint + , _Polygon + , _MultiPolygon + , _Line + , _MultiLine + , _Collection + ) where + +import Data.Geospatial.Internal.Geometry.GeoLine +import Data.Geospatial.Internal.Geometry.GeoMultiLine +import Data.Geospatial.Internal.Geometry.GeoMultiPoint +import Data.Geospatial.Internal.Geometry.GeoMultiPolygon +import Data.Geospatial.Internal.Geometry.GeoPoint +import Data.Geospatial.Internal.Geometry.GeoPolygon + +import Control.Applicative ((<$>)) +import Control.Lens (makePrisms) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..), + object, + (.:), (.=)) +import Data.Aeson.Types (Parser) +import Data.Text (Text) + +-- | 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 "LineString" obj = Line <$> parseJSON obj +geometryFromAeson "MultiLineString" obj = MultiLine <$> parseJSON obj +geometryFromAeson "GeometryCollection" (Object jsonObj) = Collection <$> (jsonObj .: ("geometries" :: Text)) +geometryFromAeson "GeometryCollection" _ = mzero +geometryFromAeson _ _ = mzero + + +-- | +-- encodes Geometry Objects to GeoJSON +-- +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 + ] + +-- | +-- decodes Geometry Objects from GeoJSON +-- +-- Aeson doesnt decode "null" into `Null` unfortunately +-- +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/Internal/Geometry/Aeson.hs b/src/Data/Geospatial/Internal/Geometry/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/Aeson.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geosptial.Geometry.Aeson +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- Some helpers for some of the common Aeson ops +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.Aeson ( + -- * Geometry + readGeometryGeoAeson + , makeGeometryGeoAeson + -- * Optional fields + , optValFromObj + , optAttributes + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), Object, ToJSON (..), 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/Internal/Geometry/GeoLine.hs b/src/Data/Geospatial/Internal/Geometry/GeoLine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoLine.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoLine +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoLine ( + -- * Type + GeoLine(..) + -- * Lenses + , unGeoLine + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson +import Data.LineString + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +newtype GeoLine = GeoLine { _unGeoLine :: LineString GeoPositionWithoutCRS } deriving (Show, Eq) + +makeLenses ''GeoLine + +-- instances + +instance ToJSON GeoLine where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "LineString" . _unGeoLine + +instance FromJSON GeoLine where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "LineString" GeoLine o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Internal/Geometry/GeoMultiLine.hs b/src/Data/Geospatial/Internal/Geometry/GeoMultiLine.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoMultiLine.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoMultiLine +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoMultiLine ( + -- * Type + GeoMultiLine(..) + -- * Lenses + , unGeoMultiLine + -- * To Points + , splitGeoMultiLine, mergeGeoLines + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson +import Data.Geospatial.Internal.Geometry.GeoLine +import Data.LineString + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +newtype GeoMultiLine = GeoMultiLine { _unGeoMultiLine :: [LineString GeoPositionWithoutCRS] } deriving (Show, Eq) + +makeLenses ''GeoMultiLine + + +-- | Split GeoMultiLine coordinates into multiple GeoLines +splitGeoMultiLine:: GeoMultiLine -> [GeoLine] +splitGeoMultiLine = map GeoLine . _unGeoMultiLine + +-- | Merge multiple GeoLines into one GeoMultiLine +mergeGeoLines :: [GeoLine] -> GeoMultiLine +mergeGeoLines = GeoMultiLine . map _unGeoLine + +-- instances + +instance ToJSON GeoMultiLine where +-- toJSON :: a -> Value + toJSON = makeGeometryGeoAeson "MultiLineString" . _unGeoMultiLine + +instance FromJSON GeoMultiLine where +-- parseJSON :: Value -> Parser a + parseJSON (Object o) = readGeometryGeoAeson "MultiLineString" GeoMultiLine o + parseJSON _ = mzero diff --git a/src/Data/Geospatial/Internal/Geometry/GeoMultiPoint.hs b/src/Data/Geospatial/Internal/Geometry/GeoMultiPoint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoMultiPoint.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoMultiPoint +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoMultiPoint ( + -- * Type + GeoMultiPoint(..) + -- * Lenses + , unGeoMultiPoint + -- * To Points + , splitGeoMultiPoint, mergeGeoPoints + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson +import Data.Geospatial.Internal.Geometry.GeoPoint + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +newtype GeoMultiPoint = GeoMultiPoint { _unGeoMultiPoint :: [GeoPositionWithoutCRS] } deriving (Show, Eq) + +makeLenses ''GeoMultiPoint + + +-- | Split GeoMultiPoint coordinates into multiple GeoPoints +splitGeoMultiPoint:: GeoMultiPoint -> [GeoPoint] +splitGeoMultiPoint = map GeoPoint . _unGeoMultiPoint + +-- | Merge multiple GeoPoints into one GeoMultiPoint +mergeGeoPoints :: [GeoPoint] -> GeoMultiPoint +mergeGeoPoints = GeoMultiPoint . map _unGeoPoint + +-- 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/Internal/Geometry/GeoMultiPolygon.hs b/src/Data/Geospatial/Internal/Geometry/GeoMultiPolygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoMultiPolygon.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoMultiPolygon +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoMultiPolygon ( + -- * Type + GeoMultiPolygon(..) + -- * Lenses + , unGeoMultiPolygon + -- * To Polygons + , splitGeoMultiPolygon, mergeGeoPolygons + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson +import Data.Geospatial.Internal.Geometry.GeoPolygon +import Data.LinearRing + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +newtype GeoMultiPolygon = GeoMultiPolygon { _unGeoMultiPolygon :: [[LinearRing GeoPositionWithoutCRS]] } deriving (Show, Eq) + +-- | Split GeoMultiPolygon coordinates into multiple GeoPolygons +splitGeoMultiPolygon :: GeoMultiPolygon -> [GeoPolygon] +splitGeoMultiPolygon = map GeoPolygon . _unGeoMultiPolygon + +-- | Merge multiple GeoPolygons into one GeoMultiPolygon +mergeGeoPolygons :: [GeoPolygon] -> GeoMultiPolygon +mergeGeoPolygons = GeoMultiPolygon . map _unGeoPolygon + +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/Internal/Geometry/GeoPoint.hs b/src/Data/Geospatial/Internal/Geometry/GeoPoint.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoPoint.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoPoint +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoPoint ( + -- * Type + GeoPoint(..) + -- * Lenses + , unGeoPoint + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +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/Internal/Geometry/GeoPolygon.hs b/src/Data/Geospatial/Internal/Geometry/GeoPolygon.hs new file mode 100644 --- /dev/null +++ b/src/Data/Geospatial/Internal/Geometry/GeoPolygon.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE TemplateHaskell #-} +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.Geometry.GeoPolygon +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +------------------------------------------------------------------- +module Data.Geospatial.Internal.Geometry.GeoPolygon ( + -- * Type + GeoPolygon(..) + -- * Lenses + , unGeoPolygon + ) where + +import Data.Geospatial.Internal.BasicTypes +import Data.Geospatial.Internal.Geometry.Aeson +import Data.LinearRing + +import Control.Lens (makeLenses) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), + ToJSON (..), + Value (..)) + +newtype GeoPolygon = GeoPolygon { _unGeoPolygon :: [LinearRing 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/Data/LineString.hs b/src/Data/LineString.hs --- a/src/Data/LineString.hs +++ b/src/Data/LineString.hs @@ -2,9 +2,9 @@ ------------------------------------------------------------------- -- | -- Module : Data.LineString --- Copyright : (C) 2014 Dom De Re --- License : BSD-style (see the file etc/LICENSE.md) --- Maintainer : Dom De Re +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman -- -- Refer to the GeoJSON Spec -- @@ -24,30 +24,19 @@ , lineStringLength ) where -import Prelude hiding ( foldr ) - -import Control.Applicative ( Applicative(..) ) -import Control.Lens ( ( # ), (^?) ) -import Control.Monad ( mzero ) -import Data.Aeson ( ToJSON(..), FromJSON(..), Value ) -import Data.Aeson.Types ( Parser, typeMismatch ) -import Data.Foldable ( Foldable(..) ) -import Data.Functor ( (<$>) ) -import Data.Maybe ( fromMaybe ) -import Data.Traversable ( Traversable(..) ) -import Data.Validation ( Validate(..), Validation, _Failure, _Success ) +import Prelude hiding (foldr) --- $setup --- --- >>> import Control.Applicative ( (<*>) ) --- >>> import Data.Functor ( (<$>) ) --- >>> import Data.Maybe ( Maybe(..) ) --- >>> import Data.Monoid ( Monoid(..) ) --- >>> import Test.QuickCheck --- --- >>> instance (Arbitrary a) => Arbitrary (LineString a) where arbitrary = makeLineString <$> arbitrary <*> arbitrary <*> arbitrary --- --- +import Control.Applicative (Applicative (..)) +import Control.Lens (( # ), (^?)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), ToJSON (..), Value) +import Data.Aeson.Types (Parser, typeMismatch) +import Data.Foldable (Foldable (..)) +import Data.Functor ((<$>)) +import Data.Maybe (fromMaybe) +import Data.Traversable (Traversable (..)) +import Data.Validation (Validate (..), Validation, _Failure, + _Success) -- | -- a LineString has at least 2 elements @@ -63,6 +52,7 @@ data ListToLineStringError = ListEmpty | SingletonList + deriving (Eq) -- functions @@ -78,25 +68,15 @@ lineStringLast :: LineString a -> a lineStringLast (LineString _ x xs) = fromMaybe x (safeLast xs) --- NOTE (Dom De Re): Props have been commented out until --- has been resolved. - -- | -- returns the number of elements in the list, including the replicated element at the end of the list. -- --- (\xs -> lineStringLength xs == (length (fromLineString xs))) (xs :: LineString Int) --- lineStringLength :: LineString a -> Int lineStringLength (LineString _ _ xs) = 2 + length xs -- | -- This function converts it into a list and appends the given element to the end. -- --- (\xs -> safeLast (fromLineString xs) == Just (lineStringHead xs)) (xs :: LineString Int) --- --- (\xs -> length (fromLineString xs) >= 4) (xs :: LineString Int) --- - fromLineString :: LineString a -> [a] fromLineString (LineString x y zs) = x : y : zs @@ -104,21 +84,6 @@ -- creates a LineString out of a list of elements, -- if there are enough elements (needs at least 2) elements -- --- >>> fromList [] :: Validation ListToLineStringError (LineString Int) --- Failure List Empty --- --- >>> fromList [0] :: Validation ListToLineStringError (LineString Int) --- Failure Singleton List --- --- >>> fromList [0, 1] :: Validation ListToLineStringError (LineString Int) --- Success [0,1] --- --- >>> fromList [0, 1, 2] :: Validation ListToLineStringError (LineString Int) --- Success [0,1,2] --- --- >>> fromList [0, 1, 2, 4, 5, 0] :: Validation ListToLineStringError (LineString Int) --- Success [0,1,2,4,5,0] --- fromList :: (Validate v) => [a] @@ -142,7 +107,7 @@ -- instances instance Show ListToLineStringError where - show ListEmpty = "List Empty" + show ListEmpty = "List Empty" show SingletonList = "Singleton List" instance (Show a) => Show (LineString a) where @@ -153,10 +118,6 @@ -- | This instance of Foldable will run through the entire ring, closing the -- loop by also passing the initial element in again at the end. --- --- > (\xs -> (foldr (:) [] xs) == (fromLineString xs)) (xs :: LineString Int) --- --- > (\xs -> (lineStringHead xs) == (foldr'' (\a -> const a) 0 xs)) (xs :: LineString Int) -- instance Foldable LineString where -- foldr :: (a -> b -> b) -> b -> LineString a -> b diff --git a/src/Data/LinearRing.hs b/src/Data/LinearRing.hs --- a/src/Data/LinearRing.hs +++ b/src/Data/LinearRing.hs @@ -2,9 +2,9 @@ ------------------------------------------------------------------- -- | -- Module : Data.LinearRing --- Copyright : (C) 2014 Dom De Re --- License : BSD-style (see the file etc/LICENSE.md) --- Maintainer : Dom De Re +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman -- -- Refer to the GeoJSON Spec -- @@ -25,31 +25,20 @@ , ringLength ) where -import Prelude hiding ( foldr ) - -import Control.Applicative ( Applicative(..) ) -import Control.Lens ( ( # ), (^?) ) -import Control.Monad ( mzero ) -import Data.Aeson ( ToJSON(..), FromJSON(..), Value ) -import Data.Aeson.Types ( Parser, typeMismatch ) -import Data.Foldable ( Foldable(..) ) -import Data.Functor ( (<$>) ) -import Data.List ( intercalate ) -import Data.List.NonEmpty as NL ( NonEmpty, toList ) -import Data.Traversable ( Traversable(..) ) -import Data.Validation ( Validate(..), AccValidation, _Failure, _Success ) +import Prelude hiding (foldr) --- $setup --- --- >>> import Control.Applicative ( (<*>) ) --- >>> import Data.Functor ( (<$>) ) --- >>> import Data.Maybe ( Maybe(..) ) --- >>> import Data.Monoid ( Monoid(..) ) --- >>> import Test.QuickCheck --- --- >>> instance (Arbitrary a) => Arbitrary (LinearRing a) where arbitrary = makeLinearRing <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary --- --- +import Control.Applicative (Applicative (..)) +import Control.Lens (( # ), (^?)) +import Control.Monad (mzero) +import Data.Aeson (FromJSON (..), ToJSON (..), Value) +import Data.Aeson.Types (Parser, typeMismatch) +import Data.Foldable (Foldable (..)) +import Data.Functor ((<$>)) +import Data.List (intercalate) +import Data.List.NonEmpty as NL (NonEmpty, toList) +import Data.Traversable (Traversable (..)) +import Data.Validation (AccValidation, Validate (..), _Failure, + _Success) -- | -- a LinearRing has at least 3 (distinct) elements @@ -66,6 +55,7 @@ data ListToLinearRingError a = ListTooShort Int | HeadNotEqualToLast a a + deriving (Eq) -- functions @@ -75,25 +65,15 @@ ringHead :: LinearRing a -> a ringHead (LinearRing x _ _ _) = x --- NOTE (Dom De Re): Props have been commented out until --- has been resolved. - -- | -- returns the number of elements in the list, including the replicated element at the end of the list. -- --- prop> (\xs -> ringLength xs == (length (fromLinearRing xs))) (xs :: LinearRing Int) --- ringLength :: LinearRing a -> Int ringLength (LinearRing _ _ _ xs) = 4 + length xs -- | -- This function converts it into a list and appends the given element to the end. -- --- (\xs -> safeLast (fromLinearRing xs) == Just (ringHead xs)) (xs :: LinearRing Int) --- --- (\xs -> length (fromLinearRing xs) >= 4) (xs :: LinearRing Int) --- - fromLinearRing :: LinearRing a -> [a] fromLinearRing (LinearRing x y z ws) = x : y : z : foldr (:) [x] ws @@ -112,32 +92,8 @@ -- -- And be aware that the last element of the list will be dropped. -- --- >>> fromList [] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccFailure (List too short: (length = 0) :| []) --- --- >>> fromList [0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccFailure (List too short: (length = 1) :| []) --- --- >>> fromList [0, 1] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccFailure (List too short: (length = 2) :| []) --- --- >>> fromList [0, 1, 2] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccFailure (List too short: (length = 3) :| []) --- --- >>> fromList [0, 1, 2, 3] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccSuccess [0,1,2,0] --- --- >>> fromList [0, 1, 2, 4, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccSuccess [0,1,2,4,0] --- --- >>> fromList [0, 1, 2, 4, 5, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccSuccess [0,1,2,4,5,0] --- -- Unfortunately it doesn't check that the last element is the same as the first at the moment... -- --- >>> fromList [0, 1, 2, 4, 5, 6] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) --- AccSuccess [0,1,2,4,5,0] --- fromList :: (Validate v, Functor (v (NonEmpty (ListToLinearRingError a)))) => [a] @@ -187,10 +143,6 @@ -- | This instance of Foldable will run through the entire ring, closing the -- loop by also passing the initial element in again at the end. -- --- > (\xs -> (foldr (:) [] xs) == (fromLinearRing xs)) (xs :: LinearRing Int) --- --- > (\xs -> (ringHead xs) == (foldr'' (\a -> const a) 0 xs)) (xs :: LinearRing Int) --- instance Foldable LinearRing where -- foldr :: (a -> b -> b) -> b -> LinearRing a -> b foldr f u (LinearRing x y z ws) = f x (f y (f z (foldr f (f x u) ws))) @@ -235,8 +187,8 @@ mhl xs = (,) <$> safeHead xs <*> safeLast xs safeHead :: [a] -> Maybe a -safeHead [] = Nothing -safeHead (x:_) = Just x +safeHead [] = Nothing +safeHead (x:_) = Just x safeLast :: [a] -> Maybe a safeLast [] = Nothing @@ -245,8 +197,6 @@ -- | -- Does a fold but ignores the last element of the list --- --- > (\x xs -> length (foldrDropLast (:) [] (x : xs)) == length xs) (x :: Int) (xs :: [Int]) -- foldrDropLast :: (a -> b -> b) -> b -> [a] -> b foldrDropLast _ x [] = x diff --git a/test/Arbitrary.hs b/test/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/test/Arbitrary.hs @@ -0,0 +1,15 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Arbitrary where + +import Test.Tasty.QuickCheck (Arbitrary, arbitrary) +-- Local +import Data.LinearRing (LinearRing, makeLinearRing) +import Data.LineString (LineString, makeLineString) + + +instance (Arbitrary a) => Arbitrary (LinearRing a) where + arbitrary = makeLinearRing <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance (Arbitrary a) => Arbitrary (LineString a) where + arbitrary = makeLineString <$> arbitrary <*> arbitrary <*> arbitrary diff --git a/test/Data/Geospatial/Internal/CRSTests.hs b/test/Data/Geospatial/Internal/CRSTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/Geospatial/Internal/CRSTests.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Geospatial.Internal.CRSTests where + +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy.Char8 as BS +import Test.Tasty +import Test.Tasty.Hspec (Spec, context, describe, it, + shouldBe, testSpec) +-- Local +import Data.Geospatial.Internal.CRS +import Fixture + + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup "Data.Geospatial.Internal.CRSTests" [specs] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.Geospatial.Internal.CRS.fromJSON" testFromJSON + , testSpec "Data.Geospatial.Internal.CRS.toJSON" testToJSON + ] + pure $ testGroup "Data.Geospatial.Internal.CRSTests.Spec" specs + +-- Spec + +-- >>> (A.decode . BS.pack) testLinkCRSJSON == Just testLinkCRS +-- True +-- +-- >>> (A.decode . BS.pack) testNamedCRSJSON == Just testNamedCRS +-- True +-- +-- >>> (A.decode . BS.pack) testEPSGJSON == Just testEPSG +-- True +-- +-- (A.decode . BS.pack) "null" == Just NoCRS +-- True +-- +testFromJSON :: Spec +testFromJSON = + describe "fromJSON" $ do + it "decode CRS Objects from GeoJSON" $ do + A.decode testLinkCRSJSON `shouldBe` Just testLinkCRS + A.decode testNamedCRSJSON `shouldBe` Just testNamedCRS + A.decode testEPSGJSON `shouldBe` Just testEPSG + context "when provided with invalid input" $ + it "fails" $ + (A.decode . BS.pack) "null" `shouldBe` Just NoCRS + +-- >>> (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" +-- +testToJSON :: Spec +testToJSON = + describe "toJSON" $ do + it "encode CRS Objects to GeoJSON" $ do + (A.decode . A.encode) testLinkCRS `shouldBe` Just testLinkCRS + (A.decode . A.encode) testNamedCRS `shouldBe` Just testNamedCRS + (A.decode . A.encode) testEPSG `shouldBe` Just testEPSG + context "when provided with invalid input" $ + it "fails" $ + A.encode NoCRS `shouldBe` "null" diff --git a/test/Data/Geospatial/Internal/GeoFeatureCollectionTests.hs b/test/Data/Geospatial/Internal/GeoFeatureCollectionTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/Geospatial/Internal/GeoFeatureCollectionTests.hs @@ -0,0 +1,68 @@ +module Data.Geospatial.Internal.GeoFeatureCollectionTests where + +import qualified Data.Aeson as A +import Test.Tasty +import Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec) +-- Local +import Fixture + + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup " Data.Geospatial.Internal.GeoFeatureCollectionTests" [specs] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.Geospatial.Internal.GeoFeatureCollection.fromJSON" testFromJSON + , testSpec "Data.Geospatial.Internal.GeoFeatureCollection.toJSON" testToJSON + ] + pure $ testGroup "Data.Geospatial.Internal.GeoFeatureCollectionTests.Spec" specs + + +-- Spec + +-- >>> (A.decode . BS.pack) bigAssFeatureCollectionJSON == Just bigAssFeatureCollection +-- True +-- +-- >>> (A.decode . BS.pack) bigAssFeatureCollectionWithNoBBoxJSON == Just bigAssFeatureCollectionWithNoBBox +-- True +-- +-- >>> (A.decode . BS.pack) emptyFeatureCollectionWithBBoxJSON == Just emptyFeatureCollectionWithBBox +-- True +-- +-- >>> (A.decode . BS.pack) emptyFeatureCollectionJSON == Just emptyFeatureCollection +-- True +-- +testFromJSON :: Spec +testFromJSON = + describe "fromJSON" $ + it "decode FeatureCollection Objects from GeoJSON" $ do + A.decode bigAssFeatureCollectionJSON `shouldBe` Just bigAssFeatureCollection + A.decode bigAssFeatureCollectionWithNoBBoxJSON `shouldBe` Just bigAssFeatureCollectionWithNoBBox + A.decode emptyFeatureCollectionWithBBoxJSON `shouldBe` Just emptyFeatureCollectionWithBBox + A.decode emptyFeatureCollectionJSON `shouldBe` Just emptyFeatureCollection + +-- >>> (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 +-- +testToJSON :: Spec +testToJSON = + describe "toJSON" $ + it "encode FeatureCollection Objects to GeoJSON" $ do + (A.decode . A.encode) bigAssFeatureCollection `shouldBe` Just bigAssFeatureCollection + (A.decode . A.encode) bigAssFeatureCollectionWithNoBBox `shouldBe` Just bigAssFeatureCollectionWithNoBBox + (A.decode . A.encode) emptyFeatureCollectionWithBBox `shouldBe` Just emptyFeatureCollectionWithBBox + (A.decode . A.encode) emptyFeatureCollection `shouldBe` Just emptyFeatureCollection diff --git a/test/Data/Geospatial/Internal/GeoFeatureTests.hs b/test/Data/Geospatial/Internal/GeoFeatureTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/Geospatial/Internal/GeoFeatureTests.hs @@ -0,0 +1,75 @@ +module Data.Geospatial.Internal.GeoFeatureTests where + +import qualified Data.Aeson as A +import Test.Tasty +import Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec) +-- Local +import Fixture + + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup "Data.Geospatial.Internal.GeoFeatureTests" [specs] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.Geospatial.Internal.GeoFeature.fromJSON" testFromJSON + , testSpec "Data.Geospatial.Internal.GeoFeature.toJSON" testToJSON + ] + pure $ testGroup "Data.Geospatial.Internal.GeoFeatureTests.Spec" specs + +-- Spec + +-- >>> (A.decode . BS.pack) bigFeatureJSON == Just bigFeature +-- True +-- +-- >>> (A.decode . BS.pack) featureWithNoPropertiesJSON == Just featureWithNoProperties +-- True +-- +-- >>> (A.decode . BS.pack) featureWithNoIdJSON == Just featureWithNoId +-- True +-- +-- >>> (A.decode . BS.pack) featureWithNoBBoxJSON == Just featureWithNoBBox +-- True +-- +-- >>> (A.decode . BS.pack) featureWithNoGeometryJSON == Just featureWithNoGeometry +-- True +-- +testFromJSON :: Spec +testFromJSON = + describe "fromJSON" $ + it "decode Feature Objects from GeoJSON" $ do + A.decode bigFeatureJSON `shouldBe` Just bigFeature + A.decode featureWithNoPropertiesJSON `shouldBe` Just featureWithNoProperties + A.decode featureWithNoIdJSON `shouldBe` Just featureWithNoId + A.decode featureWithNoBBoxJSON `shouldBe` Just featureWithNoBBox + A.decode featureWithNoGeometryJSON `shouldBe` Just featureWithNoGeometry + +-- >>> (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 +-- +testToJSON :: Spec +testToJSON = + describe "toJSON" $ + it "encode Feature Objects to GeoJSON" $ do + (A.decode . A.encode) bigFeature `shouldBe` Just bigFeature + (A.decode . A.encode) featureWithNoProperties `shouldBe` Just featureWithNoProperties + (A.decode . A.encode) featureWithNoId `shouldBe` Just featureWithNoId + (A.decode . A.encode) featureWithNoBBox `shouldBe` Just featureWithNoBBox + (A.decode . A.encode) featureWithNoGeometry `shouldBe` Just featureWithNoGeometry diff --git a/test/Data/Geospatial/Internal/GeometryTests.hs b/test/Data/Geospatial/Internal/GeometryTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/Geospatial/Internal/GeometryTests.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Geospatial.Internal.GeometryTests where + +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy.Char8 as BS +import Test.Tasty +import Test.Tasty.Hspec (Spec, describe, it, + shouldBe, testSpec) +-- Local +import Data.Geospatial.Internal.Geometry +import Fixture + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup "Data.Geospatial.Internal.GeometryTests" [specs] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.Geospatial.Internal.Geometry.fromJSON" testFromJSON + , testSpec "Data.Geospatial.Internal.Geometry.toJSON" testToJSON + ] + pure $ testGroup "Data.Geospatial.Internal.GeometryTests.Spec" specs + +-- Spec + +-- >>> 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 + +-- +-- decode' "null" :: Maybe GeospatialGeometry +-- Just NoGeometry +-- +testFromJSON :: Spec +testFromJSON = + describe "fromJSON" $ + it "decode Feature Objects from GeoJSON" $ do + A.decode lShapedPolyJSON `shouldBe` Just lShapedPoly + A.decode emptyPolyJSON `shouldBe` Just emptyPoly + A.decode emptyMultiPolyJSON `shouldBe` Just emptyMultiPoly + A.decode singleLineMultiLineJSON `shouldBe` Just singleLineMultiLine + A.decode multiLineJSON `shouldBe` Just multiLine + A.decode emptyCollectionJSON `shouldBe` Just emptyCollection + A.decode bigassCollectionJSON `shouldBe` Just bigassCollection + (A.decode . BS.pack) "null" `shouldBe` Just NoGeometry + +-- >>> 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 +-- +testToJSON :: Spec +testToJSON = + describe "toJSON" $ + it "encode Feature Objects to GeoJSON" $ do + A.encode NoGeometry `shouldBe` "null" + (A.decode . A.encode) lShapedPoly `shouldBe` Just lShapedPoly + (A.decode . A.encode) emptyPoly `shouldBe` Just emptyPoly + (A.decode . A.encode) emptyMultiPoly `shouldBe` Just emptyMultiPoly + (A.decode . A.encode) singleLineMultiLine `shouldBe` Just singleLineMultiLine + (A.decode . A.encode) multiLine `shouldBe` Just multiLine + (A.decode . A.encode) emptyCollection `shouldBe` Just emptyCollection + (A.decode . A.encode) bigassCollection `shouldBe` Just bigassCollection diff --git a/test/Data/LineStringTests.hs b/test/Data/LineStringTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/LineStringTests.hs @@ -0,0 +1,85 @@ +module Data.LineStringTests where + +import Data.Foldable (Foldable (..)) +import Data.Validation (AccValidation (..)) +import Test.Tasty +import Test.Tasty.Hspec (Spec, context, describe, it, shouldBe, + testSpec) +import Test.Tasty.QuickCheck (Property, property, testProperty) +-- Local +import Arbitrary () +import Data.LineString + + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup "Data.LineStringTests" [qcTests, specs] + +qcTests :: TestTree +qcTests = testGroup "Data.LineStringTests.QuickCheck" + [ testProperty "Data.LineString.lineStringLength" testLineStringLength + , testProperty "Data.LineString.fromLineString" testFromLineString + , testProperty "Data.LineString.Foldable" testFoldable + ] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.LineString.fromList" testFromList + ] + pure $ testGroup "Data.LineStringTests.Spec" specs + +-- QuickCheck + +-- (\xs -> lineStringLength xs == (length (fromLineString xs))) (xs :: LineString Int) +-- +testLineStringLength :: LineString Int -> Property +testLineStringLength xs = property $ lineStringLength xs == length (fromLineString xs) + +-- (\xs -> length (fromLineString xs) >= 4) (xs :: LineString Int) +-- +testFromLineString :: LineString Int -> Property +testFromLineString xs = property $ length (fromLineString xs) >= 2 + +-- > (\xs -> (foldr (:) [] xs) == (fromLineString xs)) (xs :: LineString Int) +-- +-- > (\xs -> (lineStringHead xs) == (foldr'' (\a -> const a) 0 xs)) (xs :: LineString Int) +-- +testFoldable :: LineString Int -> Property +testFoldable xs = property $ (foldr (:) [] xs == fromLineString xs) && (lineStringHead xs == foldr' const 0 xs) + +-- Spec + +-- >>> fromList [] :: Validation ListToLineStringError (LineString Int) +-- Failure List Empty +-- +-- >>> fromList [0] :: Validation ListToLineStringError (LineString Int) +-- Failure Singleton List +-- +-- >>> fromList [0, 1] :: Validation ListToLineStringError (LineString Int) +-- Success [0,1] +-- +-- >>> fromList [0, 1, 2] :: Validation ListToLineStringError (LineString Int) +-- Success [0,1,2] +-- +-- >>> fromList [0, 1, 2, 4, 5, 0] :: Validation ListToLineStringError (LineString Int) +-- Success [0,1,2,4,5,0] +-- +testFromList :: Spec +testFromList = + describe "fromList" $ do + it "creates a LineString out of a list of elements" $ do + fromList ([0, 1] :: [Int]) `shouldBe` AccSuccess (makeLineString 0 1 []) + fromList ([0, 1, 2] :: [Int]) `shouldBe` AccSuccess (makeLineString 0 1 [2]) + fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` AccSuccess (makeLineString 0 1 [2, 4, 5, 0]) + context "when provided with invalid input" $ + it "fails" $ do + fromList ([] :: [Int]) `shouldBe` AccFailure ListEmpty + fromList ([0] :: [Int]) `shouldBe` AccFailure SingletonList + +-- TODO +-- (\xs -> safeLast (fromLineString xs) == Just (lineStringHead xs)) (xs :: LineString Int) +-- diff --git a/test/Data/LinearRingTests.hs b/test/Data/LinearRingTests.hs new file mode 100644 --- /dev/null +++ b/test/Data/LinearRingTests.hs @@ -0,0 +1,100 @@ +module Data.LinearRingTests where + +import Data.Foldable (Foldable (..)) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Validation (AccValidation (..)) +import Test.Tasty +import Test.Tasty.Hspec (Spec, context, describe, it, shouldBe, + testSpec) +import Test.Tasty.QuickCheck (Property, property, testProperty) +-- Local +import Arbitrary () +import Data.LinearRing + + +-- Tests + +tests :: IO TestTree +tests = do + specs <- specTests + pure $ testGroup "Data.LinearRingTests" [qcTests, specs] + +qcTests :: TestTree +qcTests = testGroup "Data.LinearRingTests.QuickCheck" + [ testProperty "Data.LinearRing.ringLength" testRingLength + , testProperty "Data.LinearRing.fromLinearRing" testFromLinearRing + , testProperty "Data.LinearRing.Foldable" testFoldable + ] + +specTests :: IO TestTree +specTests = do + specs <- sequence + [ testSpec "Data.LinearRing.fromList" testFromList + ] + pure $ testGroup "Data.LinearRingTests.Spec" specs + +-- QuickCheck + +-- > (\xs -> ringLength xs == (length (fromLinearRing xs))) (xs :: LinearRing Int) +-- +testRingLength :: LinearRing Int -> Property +testRingLength xs = property $ ringLength xs == length (fromLinearRing xs) + +-- > (\xs -> length (fromLinearRing xs) >= 4) (xs :: LinearRing Int) +-- +testFromLinearRing :: LinearRing Int -> Property +testFromLinearRing xs = property $ length (fromLinearRing xs) >= 4 + +-- > (\xs -> (foldr (:) [] xs) == (fromLinearRing xs)) (xs :: LinearRing Int) +-- +-- > (\xs -> (ringHead xs) == (foldr'' (\a -> const a) 0 xs)) (xs :: LinearRing Int) +-- +testFoldable :: LinearRing Int -> Property +testFoldable xs = property $ (foldr (:) [] xs == fromLinearRing xs) && (ringHead xs == foldr' const 0 xs) + +-- Spec + +-- >>> fromList [] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccFailure (List too short: (length = 0) :| []) +-- +-- >>> fromList [0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccFailure (List too short: (length = 1) :| []) +-- +-- >>> fromList [0, 1] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccFailure (List too short: (length = 2) :| []) +-- +-- >>> fromList [0, 1, 2] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccFailure (List too short: (length = 3) :| []) +-- +-- >>> fromList [0, 1, 2, 3] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccSuccess [0,1,2,0] +-- +-- >>> fromList [0, 1, 2, 4, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccSuccess [0,1,2,4,0] +-- +-- >>> fromList [0, 1, 2, 4, 5, 0] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccSuccess [0,1,2,4,5,0] + +-- >>> fromList [0, 1, 2, 4, 5, 6] :: AccValidation (NonEmpty (ListToLinearRingError Int)) (LinearRing Int) +-- AccSuccess [0,1,2,4,5,0] +-- +testFromList :: Spec +testFromList = + describe "fromList" $ do + it "creates a LinearRing out of a list of elements" $ do + fromList ([0, 1, 2, 3] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 []) + fromList ([0, 1, 2, 4, 0] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4]) + fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4, 5]) + fromList ([0, 1, 2, 4, 5, 6] :: [Int]) `shouldBe` AccSuccess (makeLinearRing 0 1 2 [4, 5]) + context "when provided with invalid input" $ + it "fails" $ do + fromList [] `shouldBe` AccFailure (ListTooShort 0 :| [] :: NonEmpty (ListToLinearRingError Int)) + fromList [0] `shouldBe` AccFailure (ListTooShort 1 :| [] :: NonEmpty (ListToLinearRingError Int)) + fromList [0, 1] `shouldBe` AccFailure (ListTooShort 2 :| [] :: NonEmpty (ListToLinearRingError Int)) + fromList [0, 1, 2] `shouldBe` AccFailure (ListTooShort 3 :| [] :: NonEmpty (ListToLinearRingError Int)) + +-- TODO +-- > (\xs -> safeLast (fromLinearRing xs) == Just (ringHead xs)) (xs :: LinearRing Int) +-- +-- > (\x xs -> length (foldrDropLast (:) [] (x : xs)) == length xs) (x :: Int) (xs :: [Int]) +-- diff --git a/test/Fixture.hs b/test/Fixture.hs new file mode 100644 --- /dev/null +++ b/test/Fixture.hs @@ -0,0 +1,279 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Fixture where + +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Data.Text as T +-- Local +import Data.Geospatial.Internal.BasicTypes (BoundingBoxWithoutCRS, + FeatureID (..), + GeoPositionWithoutCRS) +import Data.Geospatial.Internal.CRS (CRSObject (..)) +import Data.Geospatial.Internal.GeoFeature (GeoFeature (..)) +import Data.Geospatial.Internal.GeoFeatureCollection (GeoFeatureCollection (..)) +import Data.Geospatial.Internal.Geometry (GeospatialGeometry (..)) +import Data.Geospatial.Internal.Geometry.GeoLine (GeoLine (..)) +import Data.Geospatial.Internal.Geometry.GeoMultiLine (GeoMultiLine (..), + mergeGeoLines) +import Data.Geospatial.Internal.Geometry.GeoMultiPolygon (GeoMultiPolygon (..), + mergeGeoPolygons) +import Data.Geospatial.Internal.Geometry.GeoPolygon (GeoPolygon (..)) +import Data.LinearRing (LinearRing, makeLinearRing) +import Data.LineString (LineString, makeLineString) + + +-- CRS Data + +testLinkCRSJSON :: BS.ByteString +testLinkCRSJSON = "{\"type\":\"link\",\"properties\":{\"href\":\"www.google.com.au\",\"type\":\"proj4\"}}" + +testLinkCRS :: CRSObject +testLinkCRS = LinkedCRS "www.google.com.au" "proj4" + +testEPSGJSON :: BS.ByteString +testEPSGJSON = "{\"type\":\"epsg\",\"properties\":{\"code\":4326}}" + +testEPSG :: CRSObject +testEPSG = EPSG 4326 + +testNamedCRSJSON :: BS.ByteString +testNamedCRSJSON = "{\"type\":\"name\",\"properties\":{\"name\":\"urn:ogc:def:crs:OGC:1.3:CRS84\"}}" + +testNamedCRS :: CRSObject +testNamedCRS = NamedCRS "urn:ogc:def:crs:OGC:1.3:CRS84" + +-- Bounding Box Data + +lshapedPolyVertices :: [LinearRing GeoPositionWithoutCRS] +lshapedPolyVertices = [ makeLinearRing [120.0, -15.0] [127.0, -15.0] [127.0, -25.0] [[124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] ] + +lshapedPolyLineVertices :: LineString GeoPositionWithoutCRS +lshapedPolyLineVertices = makeLineString [120.0, -15.0] [127.0, -15.0] [[127.0, -25.0], [124.0, -25.0], [124.0, -18.0], [120.0, -18.0]] + + +emptyVertices :: [LinearRing GeoPositionWithoutCRS] +emptyVertices = [] + +emptyLineVertices :: [GeoPositionWithoutCRS] +emptyLineVertices = [] + + +testLatLonBBox :: BoundingBoxWithoutCRS +testLatLonBBox = [-32, 147.5, -29.5, 151.0] + +testLatLonBBoxJSON :: BS.ByteString +testLatLonBBoxJSON = "[-32,147.5,-29.5,151]" + + +testEmptyBBox :: BoundingBoxWithoutCRS +testEmptyBBox = [] + +testEmptyBBoxJSON :: BS.ByteString +testEmptyBBoxJSON = "[]" + +-- Geometry Data +-- +-- Upside down L Shaped Poly +-- +-- (120, -15) (127, -15) +-- *---------------------------* +-- | | +-- | | +-- | (124, -18) | +-- *---------------* | +-- (120, -18) | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- | | +-- *-----------* +-- (124, -25) (127, -25) +-- + +-- Polys +lShapedPolyJSON :: BS.ByteString +lShapedPolyJSON = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}" + +lShapedGeoPoly :: GeoPolygon +lShapedGeoPoly = GeoPolygon lshapedPolyVertices + +lShapedPoly :: GeospatialGeometry +lShapedPoly = Polygon lShapedGeoPoly + + +emptyPolyJSON :: BS.ByteString +emptyPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[]}" + +emptyGeoPoly :: GeoPolygon +emptyGeoPoly = GeoPolygon emptyVertices + +emptyPoly :: GeospatialGeometry +emptyPoly = Polygon emptyGeoPoly + +-- Multi Polys +emptyMultiPolyJSON :: BS.ByteString +emptyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[]}" + +emptyMultiGeoPoly :: GeoMultiPolygon +emptyMultiGeoPoly = GeoMultiPolygon [] + +emptyMultiPoly :: GeospatialGeometry +emptyMultiPoly = MultiPolygon emptyMultiGeoPoly + + +singlePolyMultiPolyJSON :: BS.ByteString +singlePolyMultiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]]}" + +singlePolyGeoMultiPoly :: GeoMultiPolygon +singlePolyGeoMultiPoly = mergeGeoPolygons [lShapedGeoPoly] + +singlePolyMultiPoly :: GeospatialGeometry +singlePolyMultiPoly = MultiPolygon singlePolyGeoMultiPoly + + +multiPolyJSON :: BS.ByteString +multiPolyJSON = "{\"type\":\"MultiPolygon\",\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],[]]}" + +geoMultiPoly :: GeoMultiPolygon +geoMultiPoly = mergeGeoPolygons [lShapedGeoPoly, emptyGeoPoly] + +multiPoly :: GeospatialGeometry +multiPoly = MultiPolygon geoMultiPoly + +-- Lines +lShapedLineJSON :: BS.ByteString +lShapedLineJSON = "{\"type\":\"LineString\",\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]}" + +lShapedGeoLine :: GeoLine +lShapedGeoLine = GeoLine lshapedPolyLineVertices + +lShapedLine :: GeospatialGeometry +lShapedLine = Line lShapedGeoLine + +-- Multi Lines +emptyMultiLineJSON :: BS.ByteString +emptyMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[]}" + +emptyMultiGeoLine :: GeoMultiLine +emptyMultiGeoLine = GeoMultiLine [] + +emptyMultiLine :: GeospatialGeometry +emptyMultiLine = MultiLine emptyMultiGeoLine + + +singleLineMultiLineJSON :: BS.ByteString +singleLineMultiLineJSON = "{\"type\":\"MultiLineString\",\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]]}" + +singleLineGeoMultiLine :: GeoMultiLine +singleLineGeoMultiLine = mergeGeoLines [lShapedGeoLine] + +singleLineMultiLine :: GeospatialGeometry +singleLineMultiLine = MultiLine singleLineGeoMultiLine + + +multiLineJSON :: BS.ByteString +multiLineJSON = "{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"}" + +geoMultiLine :: GeoMultiLine +geoMultiLine = mergeGeoLines [lShapedGeoLine, lShapedGeoLine] + +multiLine :: GeospatialGeometry +multiLine = MultiLine geoMultiLine + +-- Collection +emptyCollectionJSON :: BS.ByteString +emptyCollectionJSON = "{\"type\":\"GeometryCollection\",\"geometries\":[]}" + +emptyCollection :: GeospatialGeometry +emptyCollection = Collection [] + + +bigassCollectionJSON :: BS.ByteString +bigassCollectionJSON = "{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"}" + +bigassCollection :: GeospatialGeometry +bigassCollection = Collection [singleLineMultiLine, emptyMultiLine, multiLine, lShapedLine, multiPoly, singlePolyMultiPoly, lShapedPoly, emptyMultiPoly, lShapedPoly] + +-- Properties Data + +testProperties :: A.Value +testProperties = A.object [T.pack "depth" A..= (5 :: Int), T.pack "comment" A..= T.pack "Bore run over by dump truck"] + +-- Feature Data + +featureId :: Maybe FeatureID +featureId = Just $ FeatureIDText "GW001" + +bbox :: Maybe BoundingBoxWithoutCRS +bbox = Just testLatLonBBox + + +bigFeatureJSON :: BS.ByteString +bigFeatureJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" + +bigFeature :: GeoFeature A.Value +bigFeature = GeoFeature bbox bigassCollection testProperties featureId + + +featureWithNoPropertiesJSON :: BS.ByteString +featureWithNoPropertiesJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null}" + +featureWithNoProperties :: GeoFeature A.Value +featureWithNoProperties = GeoFeature bbox bigassCollection A.Null featureId + + +featureWithNoGeometryJSON :: BS.ByteString +featureWithNoGeometryJSON = "{\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"},\"geometry\":null,\"bbox\":[-32,147.5,-29.5,151],\"id\":\"GW001\"}" + +featureWithNoGeometry :: GeoFeature A.Value +featureWithNoGeometry = GeoFeature bbox NoGeometry testProperties featureId + + +featureWithNoIdJSON :: BS.ByteString +featureWithNoIdJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" + +featureWithNoId :: GeoFeature A.Value +featureWithNoId = GeoFeature bbox bigassCollection testProperties Nothing + + +featureWithNoBBoxJSON :: BS.ByteString +featureWithNoBBoxJSON = "{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}" + +featureWithNoBBox :: GeoFeature A.Value +featureWithNoBBox = GeoFeature Nothing bigassCollection testProperties featureId + +-- FeatureCollection Data + +features :: [GeoFeature A.Value] +features = [featureWithNoBBox, featureWithNoGeometry, featureWithNoBBox, featureWithNoId, featureWithNoProperties, bigFeature] + + +bigAssFeatureCollectionJSON :: BS.ByteString +bigAssFeatureCollectionJSON = "{\"bbox\":[-32,147.5,-29.5,151],\"features\":[{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}],\"type\":\"FeatureCollection\"}" + +bigAssFeatureCollection :: GeoFeatureCollection A.Value +bigAssFeatureCollection = GeoFeatureCollection bbox features + + +bigAssFeatureCollectionWithNoBBoxJSON :: BS.ByteString +bigAssFeatureCollectionWithNoBBoxJSON = "{\"features\":[{\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"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\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":null},{\"bbox\":[-32,147.5,-29.5,151],\"geometry\":{\"geometries\":[{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[],\"type\":\"MultiLineString\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]]],\"type\":\"MultiLineString\"},{\"coordinates\":[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18]],\"type\":\"LineString\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],[]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]]],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"},{\"coordinates\":[],\"type\":\"MultiPolygon\"},{\"coordinates\":[[[120,-15],[127,-15],[127,-25],[124,-25],[124,-18],[120,-18],[120,-15]]],\"type\":\"Polygon\"}],\"type\":\"GeometryCollection\"},\"id\":\"GW001\",\"type\":\"Feature\",\"properties\":{\"depth\":5,\"comment\":\"Bore run over by dump truck\"}}],\"type\":\"FeatureCollection\"}" + +bigAssFeatureCollectionWithNoBBox :: GeoFeatureCollection A.Value +bigAssFeatureCollectionWithNoBBox = GeoFeatureCollection Nothing features + + +emptyFeatureCollectionJSON :: BS.ByteString +emptyFeatureCollectionJSON = "{\"type\":\"FeatureCollection\",\"features\":[]}" + +emptyFeatureCollection :: GeoFeatureCollection A.Value +emptyFeatureCollection = GeoFeatureCollection Nothing [] + + +emptyFeatureCollectionWithBBoxJSON :: BS.ByteString +emptyFeatureCollectionWithBBoxJSON = "{\"type\":\"FeatureCollection\",\"features\":[],\"bbox\":[-32,147.5,-29.5,151]}" + +emptyFeatureCollectionWithBBox :: GeoFeatureCollection A.Value +emptyFeatureCollectionWithBBox = GeoFeatureCollection bbox [] diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,23 @@ +module Main (main) where + +import Test.Tasty +-- Local +import qualified Data.Geospatial.Internal.CRSTests as CRS +import qualified Data.Geospatial.Internal.GeoFeatureCollectionTests as FC +import qualified Data.Geospatial.Internal.GeoFeatureTests as F +import qualified Data.Geospatial.Internal.GeometryTests as G +import qualified Data.LinearRingTests as LR +import qualified Data.LineStringTests as LS + + +main :: IO () +main = do + tests <- sequence + [ LR.tests + , LS.tests + , CRS.tests + , FC.tests + , F.tests + , G.tests + ] + defaultMain (testGroup "tests" tests)