packages feed

geojson 4.0.4 → 4.1.0

raw patch · 32 files changed

+1128/−1032 lines, 32 filesdep −hlintdep ~aesondep ~bytestringdep ~containerssetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: hlint

Dependency ranges changed: aeson, bytestring, containers, deepseq, scientific, text, transformers, validation

API changes (from Hackage documentation)

- Data.Geospatial: bbox :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) (Maybe BoundingBoxWithoutCRS)
+ Data.Geospatial: bbox :: forall a_avv1. Lens' (GeoFeature a_avv1) (Maybe BoundingBoxWithoutCRS)
- Data.Geospatial: boundingbox :: forall a_a1hOi. Lens' (GeoFeatureCollection a_a1hOi) (Maybe BoundingBoxWithoutCRS)
+ Data.Geospatial: boundingbox :: forall a_ax15. Lens' (GeoFeatureCollection a_ax15) (Maybe BoundingBoxWithoutCRS)
- Data.Geospatial: class HasGeoPositionWithoutCRS c_agg5
+ Data.Geospatial: class HasGeoPositionWithoutCRS c_acGr
- Data.Geospatial: featureId :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) (Maybe FeatureID)
+ Data.Geospatial: featureId :: forall a_avv1. Lens' (GeoFeature a_avv1) (Maybe FeatureID)
- Data.Geospatial: geoPositionWithoutCRS :: HasGeoPositionWithoutCRS c_agg5 => Lens' c_agg5 GeoPositionWithoutCRS
+ Data.Geospatial: geoPositionWithoutCRS :: HasGeoPositionWithoutCRS c_acGr => Lens' c_acGr GeoPositionWithoutCRS
- Data.Geospatial: geofeatures :: forall a_a1hOi a_a1hQR. Lens (GeoFeatureCollection a_a1hOi) (GeoFeatureCollection a_a1hQR) (Seq (GeoFeature a_a1hOi)) (Seq (GeoFeature a_a1hQR))
+ Data.Geospatial: geofeatures :: forall a_ax15 a_ax3E. Lens (GeoFeatureCollection a_ax15) (GeoFeatureCollection a_ax3E) (Seq (GeoFeature a_ax15)) (Seq (GeoFeature a_ax3E))
- Data.Geospatial: geometry :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) GeospatialGeometry
+ Data.Geospatial: geometry :: forall a_avv1. Lens' (GeoFeature a_avv1) GeospatialGeometry
- Data.Geospatial: properties :: forall a_a1c7d a_a1ceF. Lens (GeoFeature a_a1c7d) (GeoFeature a_a1ceF) a_a1c7d a_a1ceF
+ Data.Geospatial: properties :: forall a_avv1 a_avCt. Lens (GeoFeature a_avv1) (GeoFeature a_avCt) a_avv1 a_avCt
- Data.Geospatial.Internal.BasicTypes: class HasGeoPositionWithoutCRS c_agg5
+ Data.Geospatial.Internal.BasicTypes: class HasGeoPositionWithoutCRS c_acGr
- Data.Geospatial.Internal.BasicTypes: geoPositionWithoutCRS :: HasGeoPositionWithoutCRS c_agg5 => Lens' c_agg5 GeoPositionWithoutCRS
+ Data.Geospatial.Internal.BasicTypes: geoPositionWithoutCRS :: HasGeoPositionWithoutCRS c_acGr => Lens' c_acGr GeoPositionWithoutCRS
- Data.Geospatial.Internal.GeoFeature: bbox :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) (Maybe BoundingBoxWithoutCRS)
+ Data.Geospatial.Internal.GeoFeature: bbox :: forall a_avv1. Lens' (GeoFeature a_avv1) (Maybe BoundingBoxWithoutCRS)
- Data.Geospatial.Internal.GeoFeature: featureId :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) (Maybe FeatureID)
+ Data.Geospatial.Internal.GeoFeature: featureId :: forall a_avv1. Lens' (GeoFeature a_avv1) (Maybe FeatureID)
- Data.Geospatial.Internal.GeoFeature: geometry :: forall a_a1c7d. Lens' (GeoFeature a_a1c7d) GeospatialGeometry
+ Data.Geospatial.Internal.GeoFeature: geometry :: forall a_avv1. Lens' (GeoFeature a_avv1) GeospatialGeometry
- Data.Geospatial.Internal.GeoFeature: properties :: forall a_a1c7d a_a1ceF. Lens (GeoFeature a_a1c7d) (GeoFeature a_a1ceF) a_a1c7d a_a1ceF
+ Data.Geospatial.Internal.GeoFeature: properties :: forall a_avv1 a_avCt. Lens (GeoFeature a_avv1) (GeoFeature a_avCt) a_avv1 a_avCt
- Data.Geospatial.Internal.GeoFeatureCollection: boundingbox :: forall a_a1hOi. Lens' (GeoFeatureCollection a_a1hOi) (Maybe BoundingBoxWithoutCRS)
+ Data.Geospatial.Internal.GeoFeatureCollection: boundingbox :: forall a_ax15. Lens' (GeoFeatureCollection a_ax15) (Maybe BoundingBoxWithoutCRS)
- Data.Geospatial.Internal.GeoFeatureCollection: geofeatures :: forall a_a1hOi a_a1hQR. Lens (GeoFeatureCollection a_a1hOi) (GeoFeatureCollection a_a1hQR) (Seq (GeoFeature a_a1hOi)) (Seq (GeoFeature a_a1hQR))
+ Data.Geospatial.Internal.GeoFeatureCollection: geofeatures :: forall a_ax15 a_ax3E. Lens (GeoFeatureCollection a_ax15) (GeoFeatureCollection a_ax3E) (Seq (GeoFeature a_ax15)) (Seq (GeoFeature a_ax3E))

Files

LICENCE view
@@ -1,6 +1,6 @@ # BSD 3-Clause License -Copyright (c) 2014-2019, HS-GeoJSON Project+Copyright (c) 2014-2021, 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:
README.md view
@@ -4,6 +4,35 @@  ## Development +- We use [Ormolu](https://hackage.haskell.org/package/ormolu) for code formatting.++## Visual Studio Code Setup++Install Command Line Apps: ormolu and hlint.++Plugins:++- Haskell https://marketplace.visualstudio.com/items?itemName=haskell.haskell+- Haskell Syntax Highlighting https://marketplace.visualstudio.com/items?itemName=justusadam.language-haskell+- Haskell Linter https://marketplace.visualstudio.com/items?itemName=hoovercj.haskell-linter+- Run on Save https://marketplace.visualstudio.com/items?itemName=pucelle.run-on-save++One installed to reformat a file:++- Shift-Alt-F++Or configure Run on Save:++```+    {+        "globMatch": "{**/src/**/*.hs,**/test/**/*.hs}",+        "command": "ormolu --color always --check-idempotence --mode inplace ${file}",+        "runIn": "terminal",+        "runningStatusMessage": "Checking code style ${fileBasename}",+        "finishStatusMessage": "${fileBasename} checked"+    }+```+ Run tests: * `stack test :geojson-test` 
Setup.hs view
@@ -1,4 +1,3 @@- module Main (main) where  import Distribution.Simple
geojson.cabal view
@@ -1,5 +1,5 @@ name:                   geojson-version:                4.0.4+version:                4.1.0 license:                BSD3 license-file:           LICENCE author:                 Dom De Re@@ -27,20 +27,20 @@ source-repository       this     type:               git     location:           https://github.com/zellige/hs-geojson.git-    tag:                4.0.4+    tag:                4.1.0  library     hs-source-dirs:     src     build-depends:      base            >= 4.9 && < 5-                    ,   aeson           >= 0.8 && <1.6-                    ,   containers      >= 0.5.10.1-                    ,   deepseq         >= 1.4+                    ,   aeson           >= 2.0.1.0 && < 3+                    ,   containers      >= 0.5.7.1 && < 0.7+                    ,   deepseq         >= 1.4.2.0 && < 1.5                     ,   lens            >= 4.11                     ,   semigroups      >= 0.16-                    ,   text            >= 1.2-                    ,   scientific      >= 0.2.0-                    ,   transformers    >= 0.3-                    ,   validation      >= 1+                    ,   text            >= 1.2.3.0 && < 1.3+                    ,   scientific      >= 0.2.0 && < 0.4+                    ,   transformers    >= 0.3 && < 0.7+                    ,   validation      >= 1 && < 2.0                     ,   vector     exposed-modules:    Data.Geospatial                     ,   Data.LinearRing@@ -67,15 +67,15 @@     main-is:            Main.hs     type:               exitcode-stdio-1.0     build-depends:      base            >= 4.9 && < 5-                    ,   aeson           >= 0.8 && < 1.6-                    ,   bytestring      >= 0.10-                    ,   containers      >= 0.5.10.1+                    ,   aeson           >= 2.0.1.0 && < 3+                    ,   bytestring      >= 0.10.8.1 && < 0.12+                    ,   containers      >= 0.5.7.1  && < 0.7                     ,   geojson                     ,   tasty                     ,   tasty-hspec                     ,   tasty-quickcheck-                    ,   text            >= 1.2-                    ,   validation      >= 1+                    ,   text            >= 1.2.3.0  && < 1.3+                    ,   validation      >= 1 && < 2.0     other-modules:      Arbitrary                     ,   Fixture                     ,   Data.LinearRingTests@@ -85,16 +85,6 @@                     ,   Data.Geospatial.Internal.GeoFeatureCollectionTests                     ,   Data.Geospatial.Internal.GeoFeatureTests                     ,   Data.Geospatial.Internal.GeometryTests-    default-language:   Haskell2010-    ghc-options:        -Wall-                        -threaded--test-suite              geojson-hlint-    hs-source-dirs:     hlint-    main-is:            Main.hs-    type:               exitcode-stdio-1.0-    build-depends:      base            >= 4.9 && < 5-                    ,   hlint     default-language:   Haskell2010     ghc-options:        -Wall                         -threaded
− hlint/Main.hs
@@ -1,12 +0,0 @@-module Main where--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/", "test/", "hlint/", "--cpp-define=HLINT", "--cpp-ansi"] ++ args-    unless (null hlints) exitFailure
src/Data/Geospatial.hs view
@@ -1,82 +1,98 @@ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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------------------------------------------------------------------------module Data.Geospatial (-    -- * Types-        Latitude-    ,   Longitude-    ,   Easting-    ,   Northing-    ,   Altitude-    ,   FeatureID (..)-    ,   GeoPositionWithoutCRS (..)-    ,   GeoPosition (..)-    ,   GeoPoint (..), retrieveXY-    ,   PointXY (..)-    ,   PointXYZ (..)-    ,   PointXYZM (..)-    ,   GeoMultiPoint (..), splitGeoMultiPoint, mergeGeoPoints-    ,   GeoPolygon (..)-    ,   GeoMultiPolygon (..), splitGeoMultiPolygon, mergeGeoPolygons-    ,   GeoLine (..)-    ,   GeoMultiLine (..), splitGeoMultiLine, mergeGeoLines-    ,   GeospatialGeometry (..)-    ,   Name-    ,   Code-    ,   Href-    ,   FormatString-    ,   ProjectionType-    ,   CRSObject (..)-    ,   BoundingBoxWithoutCRS (..)-    ,   GeoFeature (..), reWrapGeometry-    ,   GeoFeatureCollection (..)+module Data.Geospatial+  ( -- * Types+    Latitude,+    Longitude,+    Easting,+    Northing,+    Altitude,+    FeatureID (..),+    GeoPositionWithoutCRS (..),+    GeoPosition (..),+    GeoPoint (..),+    retrieveXY,+    PointXY (..),+    PointXYZ (..),+    PointXYZM (..),+    GeoMultiPoint (..),+    splitGeoMultiPoint,+    mergeGeoPoints,+    GeoPolygon (..),+    GeoMultiPolygon (..),+    splitGeoMultiPolygon,+    mergeGeoPolygons,+    GeoLine (..),+    GeoMultiLine (..),+    splitGeoMultiLine,+    mergeGeoLines,+    GeospatialGeometry (..),+    Name,+    Code,+    Href,+    FormatString,+    ProjectionType,+    CRSObject (..),+    BoundingBoxWithoutCRS (..),+    GeoFeature (..),+    reWrapGeometry,+    GeoFeatureCollection (..),+     -- * Functions-    ,   stripCRSFromPosition-    ,   defaultCRS+    stripCRSFromPosition,+    defaultCRS,+     -- * Lenses+     -- ** Geometry Lenses-    ,   unGeoPoint-    ,   unGeoMultiPoint-    ,   unGeoPolygon-    ,   unGeoLine-    ,   unGeoMultiLine-    ,   unGeoMultiPolygon+    unGeoPoint,+    unGeoMultiPoint,+    unGeoPolygon,+    unGeoLine,+    unGeoMultiLine,+    unGeoMultiPolygon,+     -- ** Feature Lenses-    ,   bbox-    ,   geometry-    ,   properties-    ,   featureId-    ,   boundingbox-    ,   geofeatures+    bbox,+    geometry,+    properties,+    featureId,+    boundingbox,+    geofeatures,+     -- * Prisms+     -- ** BasicTypes-    ,   HasGeoPositionWithoutCRS(..)+    HasGeoPositionWithoutCRS (..),+     -- ** Geometry-    ,   _NoGeometry-    ,   _Point-    ,   _MultiPoint-    ,   _Polygon-    ,   _MultiPolygon-    ,   _Line-    ,   _MultiLine-    ,   _Collection+    _NoGeometry,+    _Point,+    _MultiPoint,+    _Polygon,+    _MultiPolygon,+    _Line,+    _MultiLine,+    _Collection,+     -- ** CRS-    ,   _NoCRS-    ,   _NamedCRS-    ,   _EPSG-    ,   _LinkedCRS-    ) where+    _NoCRS,+    _NamedCRS,+    _EPSG,+    _LinkedCRS,+  )+where -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+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.CRS+import Data.Geospatial.Internal.GeoFeature+import Data.Geospatial.Internal.GeoFeatureCollection+import Data.Geospatial.Internal.GeoPosition+import Data.Geospatial.Internal.Geometry
src/Data/Geospatial/Internal/BasicTypes.hs view
@@ -1,104 +1,113 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}  -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.BasicTypes--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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 (..)-    ,   retrieveXY-    ,   PointXY (..)-    ,   PointXYZ (..)-    ,   PointXYZM (..)-    ,   DoubleArray (..)-    ,   HasGeoPositionWithoutCRS(..)+module Data.Geospatial.Internal.BasicTypes+  ( -- * Coordinate types+    Latitude,+    Longitude,+    Easting,+    Northing,+    Altitude,+    GeoPositionWithoutCRS (..),+    retrieveXY,+    PointXY (..),+    PointXYZ (..),+    PointXYZM (..),+    DoubleArray (..),+    HasGeoPositionWithoutCRS (..),+     -- * CRS Reference types-    ,   Name-    ,   Code-    ,   Href-    ,   FormatString-    ,   ProjectionType+    Name,+    Code,+    Href,+    FormatString,+    ProjectionType,+     -- * Feature Types-    ,   BoundingBoxWithoutCRS (..)-    ,   FeatureID (..)-    ) where+    BoundingBoxWithoutCRS (..),+    FeatureID (..),+  )+where -import           Control.DeepSeq-import           Control.Lens.TH  (makeClassy)-import qualified Data.Aeson       as Aeson+import Control.DeepSeq+import Control.Lens.TH (makeClassy)+import qualified Data.Aeson as Aeson import qualified Data.Aeson.Types as AesonTypes-import qualified Data.Maybe       as DataMaybe-import qualified Data.Scientific  as Scientific-import qualified Data.Text        as Text-import qualified Data.Vector      as Vector-import           GHC.Generics+import qualified Data.Maybe as DataMaybe+import qualified Data.Scientific as Scientific+import qualified Data.Text as Text+import qualified Data.Vector as Vector+import GHC.Generics  type Latitude = Double+ type Longitude = Double+ type Easting = Double+ type Northing = Double+ type Altitude = Double  newtype DoubleArray = DoubleArray [Double] deriving (Eq, Show, Generic, NFData, Aeson.FromJSON, Aeson.ToJSON)  -- | (`GeoPositionWithoutCRS` is a catch all for indeterminate CRSs and for expression of positions -- before a CRS has been determined--- data PointXY = PointXY-    { _xyX :: !Double-    , _xyY :: !Double-    } deriving (Show, Eq, Generic, NFData)+  { _xyX :: !Double,+    _xyY :: !Double+  }+  deriving (Show, Eq, Generic, NFData)  data PointXYZ = PointXYZ-    { _xyzX :: !Double-    , _xyzY :: !Double-    , _xyzZ :: !Double-    } deriving (Show, Eq, Generic, NFData)+  { _xyzX :: !Double,+    _xyzY :: !Double,+    _xyzZ :: !Double+  }+  deriving (Show, Eq, Generic, NFData)  data PointXYZM = PointXYZM-    { _xyzmX :: !Double-    , _xyzmY :: !Double-    , _xyzmZ :: !Double-    , _xyzmM :: !Double-    } deriving (Show, Eq, Generic, NFData)+  { _xyzmX :: !Double,+    _xyzmY :: !Double,+    _xyzmZ :: !Double,+    _xyzmM :: !Double+  }+  deriving (Show, Eq, Generic, NFData)  data GeoPositionWithoutCRS = GeoEmpty | GeoPointXY PointXY | GeoPointXYZ PointXYZ | GeoPointXYZM PointXYZM deriving (Show, Eq, Generic, NFData)  makeClassy ''GeoPositionWithoutCRS  _toDoubleArray :: GeoPositionWithoutCRS -> [Double]-_toDoubleArray GeoEmpty                           = []-_toDoubleArray (GeoPointXY (PointXY x y))         = [x, y]-_toDoubleArray (GeoPointXYZ (PointXYZ x y z))     = [x, y, z]+_toDoubleArray GeoEmpty = []+_toDoubleArray (GeoPointXY (PointXY x y)) = [x, y]+_toDoubleArray (GeoPointXYZ (PointXYZ x y z)) = [x, y, z] _toDoubleArray (GeoPointXYZM (PointXYZM x y z m)) = [x, y, z, m]  _toGeoPoint :: DoubleArray -> Maybe GeoPositionWithoutCRS-_toGeoPoint (DoubleArray [])           = Just GeoEmpty-_toGeoPoint (DoubleArray [x, y])       = Just $ GeoPointXY (PointXY x y)-_toGeoPoint (DoubleArray [x, y, z])    = Just $ GeoPointXYZ (PointXYZ x y z)+_toGeoPoint (DoubleArray []) = Just GeoEmpty+_toGeoPoint (DoubleArray [x, y]) = Just $ GeoPointXY (PointXY x y)+_toGeoPoint (DoubleArray [x, y, z]) = Just $ GeoPointXYZ (PointXYZ x y z) _toGeoPoint (DoubleArray [x, y, z, m]) = Just $ GeoPointXYZM (PointXYZM x y z m)-_toGeoPoint _                          = Nothing+_toGeoPoint _ = Nothing  retrieveXY :: GeoPositionWithoutCRS -> PointXY retrieveXY position =   case position of-    GeoEmpty                             -> undefined -- TODO - Fix - represent this like WKB - NaN value-    (GeoPointXY p)                       -> p-    (GeoPointXYZ (PointXYZ pX pY _))     -> PointXY pX pY+    GeoEmpty -> undefined -- TODO - Fix - represent this like WKB - NaN value+    (GeoPointXY p) -> p+    (GeoPointXYZ (PointXYZ pX pY _)) -> PointXY pX pY     (GeoPointXYZM (PointXYZM pX pY _ _)) -> PointXY pX pY {-# INLINE retrieveXY #-} @@ -109,38 +118,41 @@   toJSON a = Aeson.toJSON $ _toDoubleArray a  instance Aeson.FromJSON GeoPositionWithoutCRS where---  parseJSON :: Value -> Parser a+  --  parseJSON :: Value -> Parser a   parseJSON o = do     x <- Aeson.parseJSON o     DataMaybe.maybe (fail "Illegal coordinates") pure (_toGeoPoint x)  type Name = Text.Text+ type Code = Int+ type Href = Text.Text+ type FormatString = Text.Text+ type ProjectionType = Text.Text  -- Feature Types -data FeatureID =-        FeatureIDText Text.Text-    |   FeatureIDNumber Int deriving (Show, Eq, Generic, NFData)+data FeatureID+  = FeatureIDText Text.Text+  | FeatureIDNumber Int+  deriving (Show, Eq, Generic, NFData)  instance Aeson.FromJSON FeatureID where-    parseJSON (Aeson.Number nID) =-        case x of-            Nothing -> fail "Not an integer value"-            Just z  -> pure $ FeatureIDNumber z-        where-            x = Scientific.toBoundedInteger nID :: Maybe Int-    parseJSON (Aeson.String sID) = pure $ FeatureIDText sID-    parseJSON _                  = fail "unknown id type"-+  parseJSON (Aeson.Number nID) =+    case x of+      Nothing -> fail "Not an integer value"+      Just z -> pure $ FeatureIDNumber z+    where+      x = Scientific.toBoundedInteger nID :: Maybe Int+  parseJSON (Aeson.String sID) = pure $ FeatureIDText sID+  parseJSON _ = fail "unknown id type"  instance Aeson.ToJSON FeatureID where-    toJSON (FeatureIDText a)   = Aeson.String a-    toJSON (FeatureIDNumber b) = Aeson.Number (fromInteger $ toInteger b :: Scientific.Scientific)-+  toJSON (FeatureIDText a) = Aeson.String a+  toJSON (FeatureIDNumber b) = Aeson.Number (fromInteger $ toInteger b :: Scientific.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@@ -151,7 +163,8 @@ data BoundingBoxWithoutCRS   = BoundingBoxWithoutCRSXY PointXY PointXY   | BoundingBoxWithoutCRSXYZ PointXYZ PointXYZ-  | BoundingBoxWithoutCRSXYZM PointXYZM PointXYZM deriving (Eq, Show, Generic, NFData)+  | BoundingBoxWithoutCRSXYZM PointXYZM PointXYZM+  deriving (Eq, Show, Generic, NFData)  instance Aeson.FromJSON BoundingBoxWithoutCRS where   parseJSON json = do
src/Data/Geospatial/Internal/CRS.hs view
@@ -1,48 +1,58 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.CRS--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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(..)+module Data.Geospatial.Internal.CRS+  ( -- * Types+    CRSObject (..),+     -- * Functions-    ,   defaultCRS-    -- * Prisms-    ,   _NoCRS-    ,   _NamedCRS-    ,   _EPSG-    ,   _LinkedCRS-    ) where+    defaultCRS, -import           Data.Geospatial.Internal.BasicTypes+    -- * Prisms+    _NoCRS,+    _NamedCRS,+    _EPSG,+    _LinkedCRS,+  )+where -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)+import Control.Lens (makePrisms)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    Object,+    ToJSON (..),+    Value (..),+    object,+    (.:),+    (.=),+  )+import qualified Data.Aeson.Key as AesonKey+import Data.Aeson.Types (Parser)+import Data.Geospatial.Internal.BasicTypes+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)+data CRSObject+  = NoCRS+  | NamedCRS !Name+  | EPSG Code+  | LinkedCRS !Href !FormatString+  deriving (Show, Eq)  makePrisms ''CRSObject @@ -58,32 +68,30 @@ -- 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+  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+  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+  props <- obj .: "properties"+  props .: AesonKey.fromText 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+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
src/Data/Geospatial/Internal/GeoFeature.hs view
@@ -1,56 +1,65 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoImplicitPrelude #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.GeoFeature--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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(..)+module Data.Geospatial.Internal.GeoFeature+  ( -- * Types+    GeoFeature (..),+     -- * Lenses-    ,   bbox-    ,   geometry-    ,   properties-    ,   featureId-    -- * Utils-    ,   reWrapGeometry-    ) where+    bbox,+    geometry,+    properties,+    featureId, -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry-import           Data.Geospatial.Internal.Geometry.Aeson+    -- * Utils+    reWrapGeometry,+  )+where -import           Control.Applicative                     ((<$>), (<*>))-import           Control.DeepSeq-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           GHC.Generics                            (Generic)-import           Prelude                                 (Eq (..), Show, ($))+import Control.Applicative ((<$>), (<*>))+import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    Value (..),+    object,+    (.:),+    (.:?),+    (.=),+  )+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry+import Data.Geospatial.Internal.Geometry.Aeson+import Data.List ((++))+import Data.Maybe (Maybe)+import Data.Text (Text)+import GHC.Generics (Generic)+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,+data GeoFeature a = GeoFeature+  { _bbox :: Maybe BoundingBoxWithoutCRS,+    _geometry :: GeospatialGeometry,     _properties :: a,-    _featureId  :: Maybe FeatureID } deriving (Show, Eq, Generic, NFData)+    _featureId :: Maybe FeatureID+  }+  deriving (Show, Eq, Generic, NFData)  reWrapGeometry :: GeoFeature a -> GeospatialGeometry -> GeoFeature a reWrapGeometry (GeoFeature bbox _ props fId) geom = GeoFeature bbox geom props fId@@ -60,26 +69,23 @@ -- 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+  --  parseJSON :: Value -> Parse a+  parseJSON (Object obj) = do+    objType <- obj .: "type"+    if objType /= ("Feature" :: Text)+      then mzero+      else+        GeoFeature+          <$> obj .:? "bbox"+          <*> obj .: "geometry"+          <*> obj .: "properties"+          <*> obj .:? "id"+  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]+  --  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]
src/Data/Geospatial/Internal/GeoFeatureCollection.hs view
@@ -1,71 +1,74 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoImplicitPrelude #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.GeoFeature--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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+module Data.Geospatial.Internal.GeoFeatureCollection+  ( -- * Types+    GeoFeatureCollection (..), -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.GeoFeature-import           Data.Geospatial.Internal.Geometry.Aeson+    -- * Lenses+    boundingbox,+    geofeatures,+  )+where -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 qualified Data.Sequence                           as Sequence-import           Data.Text                               (Text)-import           Prelude                                 (Eq (..), Show, ($))+import Control.Applicative ((<$>), (<*>))+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    Value (..),+    object,+    (.:),+    (.:?),+    (.=),+  )+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.GeoFeature+import Data.Geospatial.Internal.Geometry.Aeson+import Data.List ((++))+import Data.Maybe (Maybe (..))+import qualified Data.Sequence as Sequence+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 :: Sequence.Seq (GeoFeature a)-    } deriving (Show, Eq)+  { _boundingbox :: Maybe BoundingBoxWithoutCRS,+    _geofeatures :: Sequence.Seq (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+  --  parseJSON :: Value -> Parse a+  parseJSON (Object obj) = do+    objType <- obj .: "type"+    if objType /= ("FeatureCollection" :: Text)+      then mzero+      else+        GeoFeatureCollection+          <$> obj .:? "bbox"+          <*> obj .: "features"+  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]+  --  toJSON :: a -> Value+  toJSON (GeoFeatureCollection bbox' features) = object $ baseAttributes ++ optAttributes "bbox" bbox'+    where+      baseAttributes = ["type" .= ("FeatureCollection" :: Text), "features" .= features]
src/Data/Geospatial/Internal/GeoPosition.hs view
@@ -1,38 +1,38 @@ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.GeoPosition--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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(..)+module Data.Geospatial.Internal.GeoPosition+  ( -- * Type+    GeoPosition (..),+     -- * Functions-    ,   stripCRSFromPosition-    ) where+    stripCRSFromPosition,+  )+where  import qualified Data.Geospatial.Internal.BasicTypes as 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 BasicTypes.Longitude BasicTypes.Latitude-    |   LonLatAlt BasicTypes.Longitude BasicTypes.Latitude BasicTypes.Altitude-    |   EastingNorthing BasicTypes.Easting BasicTypes.Northing-    |   EastingNorthingAlt BasicTypes.Easting BasicTypes.Northing BasicTypes.Altitude+data GeoPosition+  = LonLat BasicTypes.Longitude BasicTypes.Latitude+  | LonLatAlt BasicTypes.Longitude BasicTypes.Latitude BasicTypes.Altitude+  | EastingNorthing BasicTypes.Easting BasicTypes.Northing+  | EastingNorthingAlt BasicTypes.Easting BasicTypes.Northing BasicTypes.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 -> BasicTypes.GeoPositionWithoutCRS-stripCRSFromPosition (LonLat lon lat)                           = BasicTypes.GeoPointXY $ BasicTypes.PointXY lon lat-stripCRSFromPosition (LonLatAlt lon lat alt)                    = BasicTypes.GeoPointXYZ $ BasicTypes.PointXYZ lon lat alt-stripCRSFromPosition (EastingNorthing easting northing)         = BasicTypes.GeoPointXY $ BasicTypes.PointXY easting northing-stripCRSFromPosition (EastingNorthingAlt easting northing alt)  = BasicTypes.GeoPointXYZ $ BasicTypes.PointXYZ easting northing alt--+stripCRSFromPosition (LonLat lon lat) = BasicTypes.GeoPointXY $ BasicTypes.PointXY lon lat+stripCRSFromPosition (LonLatAlt lon lat alt) = BasicTypes.GeoPointXYZ $ BasicTypes.PointXYZ lon lat alt+stripCRSFromPosition (EastingNorthing easting northing) = BasicTypes.GeoPointXY $ BasicTypes.PointXY easting northing+stripCRSFromPosition (EastingNorthingAlt easting northing alt) = BasicTypes.GeoPointXYZ $ BasicTypes.PointXYZ easting northing alt
src/Data/Geospatial/Internal/Geometry.hs view
@@ -1,115 +1,126 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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(..), retrieveXY-    ,   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+module Data.Geospatial.Internal.Geometry+  ( -- * Types+    GeoPoint (..),+    retrieveXY,+    GeoMultiPoint (..),+    splitGeoMultiPoint,+    mergeGeoPoints,+    GeoPolygon (..),+    GeoMultiPolygon (..),+    splitGeoMultiPolygon,+    mergeGeoPolygons,+    GeoLine (..),+    GeoMultiLine (..),+    splitGeoMultiLine,+    mergeGeoLines,+    GeospatialGeometry (..), -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+    -- * Lenses+    unGeoPoint,+    unGeoMultiPoint,+    unGeoPolygon,+    unGeoMultiPolygon,+    unGeoLine,+    unGeoMultiLine, -import           Control.DeepSeq-import           Control.Lens                                      (makePrisms)-import           Control.Monad                                     (mzero)-import           Data.Aeson                                        (FromJSON (..),-                                                                    ToJSON (..),-                                                                    Value (..),-                                                                    object,-                                                                    (.:), (.=))-import           Data.Aeson.Types                                  (Parser)-import qualified Data.Sequence                                     as Sequence-import           Data.Text                                         (Text)-import           GHC.Generics                                      (Generic)+    -- * Prisms+    _NoGeometry,+    _Point,+    _MultiPoint,+    _Polygon,+    _MultiPolygon,+    _Line,+    _MultiLine,+    _Collection,+  )+where +import Control.DeepSeq+import Control.Lens (makePrisms)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    Value (..),+    object,+    (.:),+    (.=),+  )+import Data.Aeson.Types (Parser)+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 qualified Data.Sequence as Sequence+import Data.Text (Text)+import GHC.Generics (Generic)  -- | 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 (Sequence.Seq GeospatialGeometry) deriving (Show, Eq, Generic, NFData)+data GeospatialGeometry+  = NoGeometry+  | Point GeoPoint+  | MultiPoint GeoMultiPoint+  | Polygon GeoPolygon+  | MultiPolygon GeoMultiPolygon+  | Line GeoLine+  | MultiLine GeoMultiLine+  | Collection (Sequence.Seq GeospatialGeometry)+  deriving (Show, Eq, Generic, NFData)  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+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")+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-        ]+  --  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+  --  parseJSON :: Value -> Parser a+  parseJSON Null = return NoGeometry+  parseJSON (Object obj) = do+    geometryType <- obj .: "type"+    geometryFromAeson geometryType (Object obj)+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/Aeson.hs view
@@ -1,58 +1,63 @@ {-# LANGUAGE OverloadedStrings #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geosptial.Geometry.Aeson--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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+module Data.Geospatial.Internal.Geometry.Aeson+  ( -- * Geometry+    readGeometryGeoAeson,+    makeGeometryGeoAeson, -import           Control.Monad       (mzero)-import           Data.Aeson          (FromJSON (..), Object, ToJSON (..), Value,-                                      object, (.:), (.:?), (.=))-import           Data.Aeson.Types    (Pair, Parser)-import           Data.Text           (Text)+    -- * Optional fields+    optValFromObj,+    optAttributes,+  )+where +import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    Object,+    ToJSON (..),+    Value,+    object,+    (.:),+    (.:?),+    (.=),+  )+import qualified Data.Aeson.Key as AesonKey+import Data.Aeson.Types (Pair, Parser)+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+  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]+  object ["type" .= typeString, "coordinates" .= coordinates]  -- | get an optional value out of a JSON object:--- optValFromObj :: (FromJSON a) => Text -> Object -> Parser (Maybe a)-optValFromObj = flip (.:?)+optValFromObj t = flip (.:?) (AesonKey.fromText t)  -- | 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]+optAttributes _ Nothing = []+optAttributes name (Just x) = [AesonKey.fromText name .= x]
src/Data/Geospatial/Internal/Geometry/GeoLine.hs view
@@ -1,44 +1,47 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoLine--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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+module Data.Geospatial.Internal.Geometry.GeoLine+  ( -- * Type+    GeoLine (..), -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import           Data.LineString+    -- * Lenses+    unGeoLine,+  )+where -import           Control.DeepSeq-import           Control.Lens                            (makeLenses)-import           Control.Monad                           (mzero)-import           Data.Aeson                              (FromJSON (..),-                                                          ToJSON (..),-                                                          Value (..))-import           GHC.Generics                            (Generic)+import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    Value (..),+  )+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import Data.LineString+import GHC.Generics (Generic) -newtype GeoLine = GeoLine { _unGeoLine :: LineString GeoPositionWithoutCRS } deriving (Show, Eq, Generic, NFData)+newtype GeoLine = GeoLine {_unGeoLine :: LineString GeoPositionWithoutCRS} deriving (Show, Eq, Generic, NFData)  makeLenses ''GeoLine  -- instances  instance ToJSON GeoLine where---  toJSON :: a -> Value-    toJSON = makeGeometryGeoAeson "LineString" . _unGeoLine+  --  toJSON :: a -> Value+  toJSON = makeGeometryGeoAeson "LineString" . _unGeoLine  instance FromJSON GeoLine where---  parseJSON :: Value -> Parser a-    parseJSON (Object o) = readGeometryGeoAeson "LineString" GeoLine o-    parseJSON _          = mzero+  --  parseJSON :: Value -> Parser a+  parseJSON (Object o) = readGeometryGeoAeson "LineString" GeoLine o+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/GeoMultiLine.hs view
@@ -1,45 +1,48 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoMultiLine--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 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+module Data.Geospatial.Internal.Geometry.GeoMultiLine+  ( -- * Type+    GeoMultiLine (..), -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import           Data.Geospatial.Internal.Geometry.GeoLine-import           Data.LineString+    -- * Lenses+    unGeoMultiLine, -import           Control.DeepSeq-import           Control.Lens                              (makeLenses)-import           Control.Monad                             (mzero)-import           Data.Aeson                                (FromJSON (..),-                                                            ToJSON (..),-                                                            Value (..))-import qualified Data.Sequence                             as Sequence-import           GHC.Generics                              (Generic)+    -- * To Points+    splitGeoMultiLine,+    mergeGeoLines,+  )+where +import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    Value (..),+  )+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import Data.Geospatial.Internal.Geometry.GeoLine+import Data.LineString+import qualified Data.Sequence as Sequence+import GHC.Generics (Generic) -newtype GeoMultiLine    = GeoMultiLine { _unGeoMultiLine :: Sequence.Seq(LineString GeoPositionWithoutCRS) } deriving (Show, Eq, Generic, NFData)+newtype GeoMultiLine = GeoMultiLine {_unGeoMultiLine :: Sequence.Seq (LineString GeoPositionWithoutCRS)} deriving (Show, Eq, Generic, NFData)  makeLenses ''GeoMultiLine - -- | Split GeoMultiLine coordinates into multiple GeoLines-splitGeoMultiLine:: GeoMultiLine -> Sequence.Seq GeoLine+splitGeoMultiLine :: GeoMultiLine -> Sequence.Seq GeoLine splitGeoMultiLine = fmap GeoLine . _unGeoMultiLine  -- | Merge multiple GeoLines into one GeoMultiLine@@ -49,10 +52,10 @@ -- instances  instance ToJSON GeoMultiLine where---  toJSON :: a -> Value-    toJSON = makeGeometryGeoAeson "MultiLineString" . _unGeoMultiLine+  --  toJSON :: a -> Value+  toJSON = makeGeometryGeoAeson "MultiLineString" . _unGeoMultiLine  instance FromJSON GeoMultiLine where---  parseJSON :: Value -> Parser a-    parseJSON (Object o)    = readGeometryGeoAeson "MultiLineString" GeoMultiLine o-    parseJSON _             = mzero+  --  parseJSON :: Value -> Parser a+  parseJSON (Object o) = readGeometryGeoAeson "MultiLineString" GeoMultiLine o+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/GeoMultiPoint.hs view
@@ -1,40 +1,43 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoMultiPoint--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman------------------------------------------------------------------------module Data.Geospatial.Internal.Geometry.GeoMultiPoint (-    -- * Type-        GeoMultiPoint(..)+module Data.Geospatial.Internal.Geometry.GeoMultiPoint+  ( -- * Type+    GeoMultiPoint (..),+     -- * Lenses-    ,   unGeoMultiPoint-    -- * To Points-    ,   splitGeoMultiPoint, mergeGeoPoints-    ) where+    unGeoMultiPoint, -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import           Data.Geospatial.Internal.Geometry.GeoPoint+    -- * To Points+    splitGeoMultiPoint,+    mergeGeoPoints,+  )+where -import           Control.DeepSeq-import           Control.Lens                               (makeLenses)-import           Control.Monad                              (mzero)-import qualified Data.Aeson                                 as Aeson-import qualified Data.Sequence                              as Sequence-import           GHC.Generics                               (Generic)+import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import qualified Data.Aeson as Aeson+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import Data.Geospatial.Internal.Geometry.GeoPoint+import qualified Data.Sequence as Sequence+import GHC.Generics (Generic) -newtype GeoMultiPoint = GeoMultiPoint { _unGeoMultiPoint :: Sequence.Seq GeoPositionWithoutCRS } deriving (Show, Eq, Generic, NFData)+newtype GeoMultiPoint = GeoMultiPoint {_unGeoMultiPoint :: Sequence.Seq GeoPositionWithoutCRS} deriving (Show, Eq, Generic, NFData)  makeLenses ''GeoMultiPoint  -- | Split GeoMultiPoint coordinates into multiple GeoPoints-splitGeoMultiPoint:: GeoMultiPoint -> Sequence.Seq GeoPoint+splitGeoMultiPoint :: GeoMultiPoint -> Sequence.Seq GeoPoint splitGeoMultiPoint = fmap GeoPoint . _unGeoMultiPoint  -- | Merge multiple GeoPoints into one GeoMultiPoint@@ -50,4 +53,4 @@ instance Aeson.FromJSON GeoMultiPoint where   --  parseJSON :: Value -> Parser a   parseJSON (Aeson.Object o) = readGeometryGeoAeson "MultiPoint" GeoMultiPoint o-  parseJSON _          = mzero+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/GeoMultiPolygon.hs view
@@ -1,36 +1,39 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoMultiPolygon--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman------------------------------------------------------------------------module Data.Geospatial.Internal.Geometry.GeoMultiPolygon (-    -- * Type-        GeoMultiPolygon(..)+module Data.Geospatial.Internal.Geometry.GeoMultiPolygon+  ( -- * Type+    GeoMultiPolygon (..),+     -- * Lenses-    ,   unGeoMultiPolygon-    -- * To Polygons-    ,   splitGeoMultiPolygon, mergeGeoPolygons-    ) where+    unGeoMultiPolygon, -import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import           Data.Geospatial.Internal.Geometry.GeoPolygon as GeoPolygon-import qualified Data.LinearRing                              as LinearRing+    -- * To Polygons+    splitGeoMultiPolygon,+    mergeGeoPolygons,+  )+where -import           Control.DeepSeq-import           Control.Lens                                 (makeLenses)-import           Control.Monad                                (mzero)-import qualified Data.Aeson                                   as Aeson-import qualified Data.Sequence                                as Sequence-import           GHC.Generics                                 (Generic)+import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import qualified Data.Aeson as Aeson+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import Data.Geospatial.Internal.Geometry.GeoPolygon as GeoPolygon+import qualified Data.LinearRing as LinearRing+import qualified Data.Sequence as Sequence+import GHC.Generics (Generic) -newtype GeoMultiPolygon = GeoMultiPolygon { _unGeoMultiPolygon :: Sequence.Seq (Sequence.Seq (LinearRing.LinearRing GeoPositionWithoutCRS)) } deriving (Show, Eq, Generic, NFData)+newtype GeoMultiPolygon = GeoMultiPolygon {_unGeoMultiPolygon :: Sequence.Seq (Sequence.Seq (LinearRing.LinearRing GeoPositionWithoutCRS))} deriving (Show, Eq, Generic, NFData)  -- | Split GeoMultiPolygon coordinates into multiple GeoPolygons splitGeoMultiPolygon :: GeoMultiPolygon -> Sequence.Seq GeoPolygon@@ -50,5 +53,5 @@  instance Aeson.FromJSON GeoMultiPolygon where   --  parseJSON :: Value -> Parser a-  parseJSON (Aeson.Object o)    = readGeometryGeoAeson "MultiPolygon" GeoMultiPolygon o-  parseJSON _             = mzero+  parseJSON (Aeson.Object o) = readGeometryGeoAeson "MultiPolygon" GeoMultiPolygon o+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/GeoPoint.hs view
@@ -1,41 +1,41 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoPoint--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman------------------------------------------------------------------------module Data.Geospatial.Internal.Geometry.GeoPoint (-    -- * Type-        GeoPoint(..)-    ,   unGeoPoint-    ,   retrieveXY-    ) where--import           Control.DeepSeq-import           Control.Lens                            (makeLenses)-import           Control.Monad                           (mzero)-import qualified Data.Aeson                              as Aeson-import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import           GHC.Generics                            (Generic)+module Data.Geospatial.Internal.Geometry.GeoPoint+  ( -- * Type+    GeoPoint (..),+    unGeoPoint,+    retrieveXY,+  )+where +import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import qualified Data.Aeson as Aeson+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import GHC.Generics (Generic) -newtype GeoPoint = GeoPoint { _unGeoPoint :: GeoPositionWithoutCRS } deriving (Show, Eq, Generic, NFData)+newtype GeoPoint = GeoPoint {_unGeoPoint :: GeoPositionWithoutCRS} deriving (Show, Eq, Generic, NFData)  makeLenses ''GeoPoint  -- instances  instance Aeson.ToJSON GeoPoint where---  toJSON :: a -> Value-    toJSON = makeGeometryGeoAeson "Point" . _unGeoPoint+  --  toJSON :: a -> Value+  toJSON = makeGeometryGeoAeson "Point" . _unGeoPoint  instance Aeson.FromJSON GeoPoint where---  parseJSON :: Value -> Parser a-    parseJSON (Aeson.Object o) = readGeometryGeoAeson "Point" GeoPoint o-    parseJSON _                = mzero+  --  parseJSON :: Value -> Parser a+  parseJSON (Aeson.Object o) = readGeometryGeoAeson "Point" GeoPoint o+  parseJSON _ = mzero
src/Data/Geospatial/Internal/Geometry/GeoPolygon.hs view
@@ -1,32 +1,34 @@-{-# LANGUAGE DeriveAnyClass  #-}-{-# LANGUAGE DeriveGeneric   #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.Geometry.GeoPolygon--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman------------------------------------------------------------------------module Data.Geospatial.Internal.Geometry.GeoPolygon (-    -- * Type-        GeoPolygon(..)+module Data.Geospatial.Internal.Geometry.GeoPolygon+  ( -- * Type+    GeoPolygon (..),+     -- * Lenses-    ,   unGeoPolygon-    ) where+    unGeoPolygon,+  )+where -import           Control.DeepSeq-import           Control.Lens                            (makeLenses)-import           Control.Monad                           (mzero)-import qualified Data.Aeson                              as Aeson-import           Data.Geospatial.Internal.BasicTypes-import           Data.Geospatial.Internal.Geometry.Aeson-import qualified Data.LinearRing                         as LinearRing-import qualified Data.Sequence                           as Sequence-import           GHC.Generics                            (Generic)+import Control.DeepSeq+import Control.Lens (makeLenses)+import Control.Monad (mzero)+import qualified Data.Aeson as Aeson+import Data.Geospatial.Internal.BasicTypes+import Data.Geospatial.Internal.Geometry.Aeson+import qualified Data.LinearRing as LinearRing+import qualified Data.Sequence as Sequence+import GHC.Generics (Generic) -newtype GeoPolygon = GeoPolygon { _unGeoPolygon :: Sequence.Seq (LinearRing.LinearRing GeoPositionWithoutCRS) } deriving (Show, Eq, Generic, NFData)+newtype GeoPolygon = GeoPolygon {_unGeoPolygon :: Sequence.Seq (LinearRing.LinearRing GeoPositionWithoutCRS)} deriving (Show, Eq, Generic, NFData)  -- Sequence.Seq (LinearRing.LinearRing DoubleArray) @@ -41,4 +43,4 @@ instance Aeson.FromJSON GeoPolygon where   --  parseJSON :: Value -> Parser a   parseJSON (Aeson.Object o) = readGeometryGeoAeson "Polygon" GeoPolygon o-  parseJSON _                = mzero+  parseJSON _ = mzero
src/Data/LineString.hs view
@@ -1,53 +1,52 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.LineString--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman -- -- Refer to the GeoJSON Spec <http://geojson.org/geojson-spec.html#linestring> -- -- A LinearString is a List with at least 2 elements------------------------------------------------------------------------module Data.LineString (-    -- * Type-        LineString-    ,   ListToLineStringError(..)-    ,   SequenceToLineStringError(..)-    -- * Functions-    ,   toSeq-    ,   combineToSeq-    ,   fromSeq-    ,   fromLineString-    ,   fromList-    ,   makeLineString-    ,   lineStringHead-    ,   lineStringLast-    ,   lineStringLength-    ) where--import           Prelude             hiding (foldr)+module Data.LineString+  ( -- * Type+    LineString,+    ListToLineStringError (..),+    SequenceToLineStringError (..), -import           Control.DeepSeq-import           Control.Lens        (( # ), (^?))-import           Control.Monad       (mzero)-import           Data.Aeson          (FromJSON (..), ToJSON (..), Value)-import           Data.Aeson.Types    (Parser, typeMismatch)-import qualified Data.Foldable       as Foldable-import           Data.Maybe          (fromMaybe)-import qualified Data.Sequence       as Sequence-import qualified Data.Validation     as Validation-import           GHC.Generics        (Generic)+    -- * Functions+    toSeq,+    combineToSeq,+    fromSeq,+    fromLineString,+    fromList,+    makeLineString,+    lineStringHead,+    lineStringLast,+    lineStringLength,+  )+where -import qualified Data.SeqHelper      as SeqHelper+import Control.DeepSeq+import Control.Lens ((#), (^?))+import Control.Monad (mzero)+import Data.Aeson (FromJSON (..), ToJSON (..), Value)+import Data.Aeson.Types (Parser, typeMismatch)+import qualified Data.Foldable as Foldable+import Data.Maybe (fromMaybe)+import qualified Data.SeqHelper as SeqHelper+import qualified Data.Sequence as Sequence+import qualified Data.Validation as Validation+import GHC.Generics (Generic)+import Prelude hiding (foldr)  -- | -- a LineString has at least 2 elements--- data LineString a = LineString a a (Sequence.Seq a) deriving (Eq, Generic, NFData)  -- |@@ -55,151 +54,138 @@ -- --     * The list was empty --     * The list only had one element----data ListToLineStringError =-        ListEmpty-    |   SingletonList-    deriving (Eq)+data ListToLineStringError+  = ListEmpty+  | SingletonList+  deriving (Eq)  -- | -- When converting a Sequence to a LineString, here is a list of things that can go wrong: -- --     * The sequence was empty --     * The sequence only had one element----data SequenceToLineStringError =-       SequenceEmpty-   |   SingletonSequence-   deriving (Eq)+data SequenceToLineStringError+  = SequenceEmpty+  | SingletonSequence+  deriving (Eq)  -- functions  -- | -- returns the element at the head of the string--- lineStringHead :: LineString a -> a lineStringHead (LineString x _ _) = x  -- | -- returns the last element in the string--- lineStringLast :: LineString a -> a lineStringLast (LineString _ x xs) = fromMaybe x (safeLast xs)  -- | -- returns the number of elements in the list, including the replicated element at the end of the list.--- lineStringLength :: LineString a -> Int lineStringLength (LineString _ _ xs) = 2 + Sequence.length xs  -- | -- This function converts it into a list and appends the given element to the end.--- fromLineString :: LineString a -> [a] fromLineString (LineString x y zs) = x : y : Foldable.toList zs  -- | -- creates a LineString out of a list of elements, -- if there are enough elements (needs at least 2) elements--- fromList :: (Validation.Validate v) => [a] -> v ListToLineStringError (LineString a)-fromList []       = Validation._Failure # ListEmpty-fromList [_]      = Validation._Failure # SingletonList-fromList (x:y:zs) = Validation._Success # LineString x y (Sequence.fromList zs)+fromList [] = Validation._Failure # ListEmpty+fromList [_] = Validation._Failure # SingletonList+fromList (x : y : zs) = Validation._Success # LineString x y (Sequence.fromList zs) {-# INLINE fromList #-}  -- | -- create a sequence from a LineString by combining values. -- LineString 1 2 [3,4] (,) --> Sequence [(1,2),(2,3),(3,4)]--- combineToSeq :: (a -> a -> b) -> LineString a -> Sequence.Seq b combineToSeq combine (LineString a b rest) = combine a b Sequence.<| combineRest-    where-        combineRest =-          if Sequence.null rest-            then-              Sequence.empty-            else-              (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (b Sequence.<| rest)+  where+    combineRest =+      if Sequence.null rest+        then Sequence.empty+        else (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (b Sequence.<| rest) {-# INLINE combineToSeq #-}  -- | -- create a sequence from a LineString. -- LineString 1 2 [3,4] --> Sequence [1,2,3,4]--- toSeq :: LineString a -> Sequence.Seq a-toSeq (LineString a b rest) = a Sequence.<| ( b  Sequence.<| rest)+toSeq (LineString a b rest) = a Sequence.<| (b Sequence.<| rest) {-# INLINE toSeq #-}  -- | -- creates a LineString out of a sequence of elements, -- if there are enough elements (needs at least 2) elements--- fromSeq :: (Validation.Validate v) => Sequence.Seq a -> v SequenceToLineStringError (LineString a) fromSeq v@(headS Sequence.:<| tailS) =-  if Sequence.null v then-    Validation._Failure # SingletonSequence-  else-    fromSeq' headS tailS+  if Sequence.null v+    then Validation._Failure # SingletonSequence+    else fromSeq' headS tailS fromSeq _ = Validation._Failure # SequenceEmpty {-# INLINE fromSeq #-}  fromSeq' :: (Validation.Validate v) => a -> Sequence.Seq a -> v SequenceToLineStringError (LineString a) fromSeq' first v@(headS Sequence.:<| tailS) =-  if Sequence.null v then-    Validation._Failure # SingletonSequence-  else-    Validation._Success # LineString first headS tailS+  if Sequence.null v+    then Validation._Failure # SingletonSequence+    else Validation._Success # LineString first headS tailS fromSeq' _ _ = Validation._Failure # SingletonSequence {-# INLINE fromSeq' #-}  -- | -- Creates a LineString -- @makeLineString x y zs@ creates a `LineString` homomorphic to the list @[x, y] ++ zs@--- makeLineString ::-       a                        -- ^ The first element-    -> a                        -- ^ The second element-    -> Sequence.Seq a  -- ^ The rest of the optional elements-    -> LineString a+  -- | The first element+  a ->+  -- | The second element+  a ->+  -- | The rest of the optional elements+  Sequence.Seq a ->+  LineString a makeLineString = LineString  -- instances  instance Show ListToLineStringError where-    show ListEmpty     = "List Empty"-    show SingletonList = "Singleton List"+  show ListEmpty = "List Empty"+  show SingletonList = "Singleton List"  instance Show SequenceToLineStringError where-  show SequenceEmpty     = "Sequence Empty"+  show SequenceEmpty = "Sequence Empty"   show SingletonSequence = "Singleton Sequence"  instance (Show a) => Show (LineString a) where-    show  = show . fromLineString+  show = show . fromLineString  instance Functor LineString where-    fmap f (LineString x y zs) = LineString (f x) (f y) (fmap f zs)+  fmap f (LineString x y zs) = LineString (f x) (f y) (fmap f zs)  -- | This will run through the line string.--- instance Foldable LineString where-    --  foldr :: (a -> b -> b) -> b -> LineString a -> b-    foldr f u (LineString x y zs) = f x (f y (Foldable.foldr f u zs))+  --  foldr :: (a -> b -> b) -> b -> LineString a -> b+  foldr f u (LineString x y zs) = f x (f y (Foldable.foldr f u zs))  instance Traversable LineString where-    --  sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)-    sequenceA (LineString fx fy fzs) = LineString <$> fx <*> fy <*> sequenceA fzs+  --  sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)+  sequenceA (LineString fx fy fzs) = LineString <$> fx <*> fy <*> sequenceA fzs  instance (ToJSON a) => ToJSON (LineString a) where---  toJSON :: a -> Value-    toJSON = toJSON . fromLineString+  --  toJSON :: a -> Value+  toJSON = toJSON . fromLineString  instance (FromJSON a, Show a) => FromJSON (LineString a) where---  parseJSON :: Value -> Parser a-    parseJSON v = do-        xs <- parseJSON v-        let vxs = fromListValidated xs-        maybe (parseError v (vxs ^? Validation._Failure)) return (vxs ^? Validation._Success)+  --  parseJSON :: Value -> Parser a+  parseJSON v = do+    xs <- parseJSON v+    let vxs = fromListValidated xs+    maybe (parseError v (vxs ^? Validation._Failure)) return (vxs ^? Validation._Success)  -- helpers @@ -213,6 +199,6 @@ -- safeLast x = if Sequence.null x then Nothing else Just $ Sequence.last x safeLast :: Sequence.Seq a -> Maybe a safeLast x = case Sequence.viewr x of-                Sequence.EmptyR -> Nothing-                _ Sequence.:> b -> Just b+  Sequence.EmptyR -> Nothing+  _ Sequence.:> b -> Just b {-# INLINE safeLast #-}
src/Data/LinearRing.hs view
@@ -1,11 +1,13 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NoImplicitPrelude #-}+ -------------------------------------------------------------------+ -- | -- Module       : Data.LinearRing--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman --@@ -13,24 +15,24 @@ -- -- A LinearRing is a List with at least 4 elements, where the -- first element is expected to be the same as the last.------------------------------------------------------------------------module Data.LinearRing (-    -- * Type-        LinearRing-    ,   ListToLinearRingError(..)-    ,   SequenceToLinearRingError(..)+module Data.LinearRing+  ( -- * Type+    LinearRing,+    ListToLinearRingError (..),+    SequenceToLinearRingError (..),+     -- * Functions-    ,   toSeq-    ,   combineToSeq-    ,   fromSeq-    ,   fromLinearRing-    ,   fromList-    ,   fromListWithEqCheck-    ,   makeLinearRing-    ,   ringHead-    ,   ringLength-    ) where+    toSeq,+    combineToSeq,+    fromSeq,+    fromLinearRing,+    fromList,+    fromListWithEqCheck,+    makeLinearRing,+    ringHead,+    ringLength,+  )+where  #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800 import           Prelude             hiding (foldr)@@ -38,23 +40,21 @@ import           Prelude #endif -import           Control.DeepSeq-import           Control.Lens        (( # ), (^?))-import           Control.Monad       (mzero)-import           Data.Aeson          (FromJSON (..), ToJSON (..), Value)-import           Data.Aeson.Types    (Parser, typeMismatch)-import qualified Data.Foldable       as Foldable-import           Data.List           (intercalate)-import           Data.List.NonEmpty  as NL (NonEmpty, toList)-import qualified Data.Sequence       as Sequence-import qualified Data.Validation     as Validation-import           GHC.Generics        (Generic)--import qualified Data.SeqHelper      as SeqHelper+import Control.DeepSeq+import Control.Lens ((#), (^?))+import Control.Monad (mzero)+import Data.Aeson (FromJSON (..), ToJSON (..), Value)+import Data.Aeson.Types (Parser, typeMismatch)+import qualified Data.Foldable as Foldable+import Data.List (intercalate)+import Data.List.NonEmpty as NL (NonEmpty, toList)+import qualified Data.SeqHelper as SeqHelper+import qualified Data.Sequence as Sequence+import qualified Data.Validation as Validation+import GHC.Generics (Generic)  -- | -- a LinearRing has at least 3 (distinct) elements--- data LinearRing a = LinearRing a a a (Sequence.Seq a) deriving (Eq, Show, Generic, NFData)  -- |@@ -63,20 +63,18 @@ --     * The list can be too short --     * The head may not be equal to the last element in the list (NB this is not currently checked due to performance concerns, --       and it also doesnt make much sense since its likely to contain doubles)----data ListToLinearRingError a =-        ListTooShort Int-    |   HeadNotEqualToLast a a-    deriving (Eq)+data ListToLinearRingError a+  = ListTooShort Int+  | HeadNotEqualToLast a a+  deriving (Eq)  -- | -- When converting a Sequence to a LinearRing there are some things that can go wrong -- --     * The sequence can be too short --     * The head may not be equal to the last element in the list----data SequenceToLinearRingError a =-    SequenceTooShort Int+data SequenceToLinearRingError a+  = SequenceTooShort Int   | FirstNotEqualToLast a a   deriving (Eq) @@ -84,19 +82,16 @@  -- | -- returns the element at the head of the ring--- ringHead :: LinearRing a -> a-ringHead (LinearRing x _ _ _)   = x+ringHead (LinearRing x _ _ _) = x  -- | -- returns the number of elements in the list, including the replicated element at the end of the list.--- ringLength :: LinearRing a -> Int ringLength (LinearRing _ _ _ xs) = 4 + Sequence.length xs  -- | -- This function converts it into a list and appends the given element to the end.--- fromLinearRing :: LinearRing a -> [a] fromLinearRing (LinearRing x y z ws) = x : y : z : Foldable.foldr (:) [x] ws @@ -116,38 +111,32 @@ -- And be aware that the last element of the list will be dropped. -- -- Unfortunately it doesn't check that the last element is the same as the first at the moment...--- fromList :: (Eq a, Show a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a)))) => [a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)-fromList (x:y:z:ws@(_:_)) = Validation._Success # LinearRing x y z (fromListDropLast ws)-fromList xs               = Validation._Failure # pure (ListTooShort (length xs))+fromList (x : y : z : ws@(_ : _)) = Validation._Success # LinearRing x y z (fromListDropLast ws)+fromList xs = Validation._Failure # pure (ListTooShort (length xs)) {-# INLINE fromList #-}  -- | -- The expensive version of fromList that checks whether the head and last elements -- are equal.--- fromListWithEqCheck :: (Eq a, Show a, Validation.Validate v, Applicative (v (NonEmpty (ListToLinearRingError a)))) => [a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a) fromListWithEqCheck xs = checkHeadAndLastEq xs *> fromList xs  -- | -- create a sequence from a LinearRing by combining values. -- LinearRing 1 2 3 [4,1] (,) --> Seq [(1,2),(2,3),(3,4),(4,1)]--- combineToSeq :: (a -> a -> b) -> LinearRing a -> Sequence.Seq b combineToSeq combine (LinearRing a b c rest) = combine a b Sequence.:<| (combine b c Sequence.:<| combineRest)-    where-        combineRest =-          if Sequence.null rest-            then-              Sequence.empty-            else-              (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (c Sequence.<| rest)+  where+    combineRest =+      if Sequence.null rest+        then Sequence.empty+        else (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (c Sequence.<| rest) {-# INLINE combineToSeq #-}  -- | -- create a sequence from a LinearRing. -- LinearRing 1 2 3 [4,1] --> Seq [1,2,3,4,1)]--- toSeq :: LinearRing a -> Sequence.Seq a toSeq (LinearRing a b c rest) = a Sequence.:<| (b Sequence.:<| (c Sequence.:<| rest)) {-# INLINE toSeq #-}@@ -160,18 +149,16 @@ -- fromSeq xs                = _Failure # return (ListTooShort (length xs)) fromSeq :: (Eq a, Show a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a)))) => Sequence.Seq a -> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a) fromSeq as =-    case as of-        (first Sequence.:<| (second Sequence.:<| (third Sequence.:<| rest@(_ Sequence.:|> lastS)))) ->-            if first == lastS then-                Validation._Success # LinearRing first second third rest-            else-                Validation._Failure # pure (FirstNotEqualToLast first lastS)-        (first Sequence.:<| (second Sequence.:<| (third Sequence.:<| _))) ->-            if first == third then-                Validation._Success # LinearRing first second third Sequence.empty-            else-                Validation._Failure # pure (FirstNotEqualToLast first third)-        v -> Validation._Failure # pure (SequenceTooShort (Sequence.length v))+  case as of+    (first Sequence.:<| (second Sequence.:<| (third Sequence.:<| rest@(_ Sequence.:|> lastS)))) ->+      if first == lastS+        then Validation._Success # LinearRing first second third rest+        else Validation._Failure # pure (FirstNotEqualToLast first lastS)+    (first Sequence.:<| (second Sequence.:<| (third Sequence.:<| _))) ->+      if first == third+        then Validation._Success # LinearRing first second third Sequence.empty+        else Validation._Failure # pure (FirstNotEqualToLast first third)+    v -> Validation._Failure # pure (SequenceTooShort (Sequence.length v)) {-# INLINE fromSeq #-}  -- |@@ -181,53 +168,55 @@ -- be closed, makeLinearRing will close it off. -- -- Repeating the first element is just redundant.----makeLinearRing :: (Eq a, Show a) =>-       a                        -- ^ The first element-    -> a                        -- ^ The second element-    -> a                        -- ^ The third element-    -> Sequence.Seq a  -- ^ The rest of the optional elements (WITHOUT the first element repeated at the end)-    -> LinearRing a+makeLinearRing ::+  (Eq a, Show a) =>+  -- | The first element+  a ->+  -- | The second element+  a ->+  -- | The third element+  a ->+  -- | The rest of the optional elements (WITHOUT the first element repeated at the end)+  Sequence.Seq a ->+  LinearRing a makeLinearRing = LinearRing  -- instances  instance (Show a) => Show (ListToLinearRingError a) where-    show (ListTooShort n) = "List too short: (length = " ++ show n ++ ")"-    show (HeadNotEqualToLast h l) = "head (" ++ show h ++ ") /= last(" ++ show l ++ ")"+  show (ListTooShort n) = "List too short: (length = " ++ show n ++ ")"+  show (HeadNotEqualToLast h l) = "head (" ++ show h ++ ") /= last(" ++ show l ++ ")"  instance (Show a) => Show (SequenceToLinearRingError a) where-    show (SequenceTooShort n) = "Sequence too short: (length = " ++ show n ++ ")"-    show (FirstNotEqualToLast h l) = "head (" ++ show h ++ ") /= last(" ++ show l ++ ")"+  show (SequenceTooShort n) = "Sequence too short: (length = " ++ show n ++ ")"+  show (FirstNotEqualToLast h l) = "head (" ++ show h ++ ") /= last(" ++ show l ++ ")"  instance Functor LinearRing where-    fmap f (LinearRing x y z ws) = LinearRing (f x) (f y) (f z) (fmap f ws)+  fmap f (LinearRing x y z ws) = LinearRing (f x) (f y) (f z) (fmap f ws)  -- | This instance of Foldable will run through the entire ring, closing the -- loop by also passing the initial element in again at the end.--- 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 (Foldable.foldr f (f x u) ws)))+  --  foldr :: (a -> b -> b) -> b -> LinearRing a -> b+  foldr f u (LinearRing x y z ws) = f x (f y (f z (Foldable.foldr f (f x u) ws)))  -- | -- When traversing this Structure, the Applicative context -- of the last element will be appended to the end to close the loop--- instance Traversable LinearRing where-    --  sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)-    sequenceA (LinearRing fx fy fz fws) = (LinearRing <$> fx <*> fy <*> fz <*> sequenceA fws) <* fx+  --  sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)+  sequenceA (LinearRing fx fy fz fws) = (LinearRing <$> fx <*> fy <*> fz <*> sequenceA fws) <* fx  instance (ToJSON a) => ToJSON (LinearRing a) where---  toJSON :: a -> Value-    toJSON = toJSON . fromLinearRing+  --  toJSON :: a -> Value+  toJSON = toJSON . fromLinearRing  instance (Eq a, FromJSON a, Show a) => FromJSON (LinearRing a) where---  parseJSON :: Value -> Parser a-    parseJSON v = do-        xs <- parseJSON v-        let vxs = fromListAcc xs-        maybe (parseError v (vxs ^? Validation._Failure)) return (vxs ^? Validation._Success)+  --  parseJSON :: Value -> Parser a+  parseJSON v = do+    xs <- parseJSON v+    let vxs = fromListAcc xs+    maybe (parseError v (vxs ^? Validation._Failure)) return (vxs ^? Validation._Success)  -- helpers @@ -240,25 +229,25 @@ parseError :: (Show a) => Value -> Maybe (NonEmpty (ListToLinearRingError a)) -> Parser b parseError v = maybe mzero (\e -> typeMismatch (showErrors e) v) -checkHeadAndLastEq :: (Eq a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a))))-    => [a]-    -> v (NonEmpty (ListToLinearRingError a)) ()+checkHeadAndLastEq ::+  (Eq a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a)))) =>+  [a] ->+  v (NonEmpty (ListToLinearRingError a)) () checkHeadAndLastEq = maybe (Validation._Failure # pure (ListTooShort 0)) (\(h, l) -> if h == l then Validation._Success # () else Validation._Failure # pure (HeadNotEqualToLast h l)) . mhl-    where-        mhl ::[a] -> Maybe (a, a)-        mhl xs = (,) <$> safeHead xs <*> safeLast xs+  where+    mhl :: [a] -> Maybe (a, a)+    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-safeLast [x]    = Just x-safeLast (_:xs) = safeLast xs+safeLast [] = Nothing+safeLast [x] = Just x+safeLast (_ : xs) = safeLast xs  fromListDropLast :: (Eq a) => [a] -> Sequence.Seq a-fromListDropLast []  = Sequence.empty+fromListDropLast [] = Sequence.empty fromListDropLast [_] = Sequence.empty-fromListDropLast x   = SeqHelper.sequenceHead $ Sequence.fromList x-+fromListDropLast x = SeqHelper.sequenceHead $ Sequence.fromList x
src/Data/SeqHelper.hs view
@@ -1,33 +1,34 @@ -------------------------------------------------------------------+ -- | -- Module       : Data.Geospatial.Internal.SeqHelpers--- Copyright    : (C) 2014-2019 HS-GeoJSON Project+-- Copyright    : (C) 2014-2021 HS-GeoJSON Project -- License      : BSD-style (see the file LICENSE.md) -- Maintainer   : Andrew Newman---------------------------------------------------------------------module Data.SeqHelper (-  sequenceHead-  , sequenceTail-  , removeNextDuplicate-  ) where+module Data.SeqHelper+  ( sequenceHead,+    sequenceTail,+    removeNextDuplicate,+  )+where  import qualified Data.Sequence as Sequence  -- All but the last sequenceHead :: Sequence.Seq a -> Sequence.Seq a sequenceHead (headS Sequence.:|> _) = headS-sequenceHead _                      = Sequence.empty+sequenceHead _ = Sequence.empty {-# INLINE sequenceHead #-}  -- All but the first sequenceTail :: Sequence.Seq a -> Sequence.Seq a sequenceTail (_ Sequence.:<| tailS) = tailS-sequenceTail _                      = Sequence.empty+sequenceTail _ = Sequence.empty {-# INLINE sequenceTail #-}  removeNextDuplicate :: Eq a => Sequence.Seq a -> Sequence.Seq a-removeNextDuplicate Sequence.Empty                     = Sequence.empty+removeNextDuplicate Sequence.Empty = Sequence.empty removeNextDuplicate xs@(_ Sequence.:<| Sequence.Empty) = xs removeNextDuplicate (x Sequence.:<| tailXs@(y Sequence.:<| _))-  | x /= y    = x Sequence.<| removeNextDuplicate tailXs+  | x /= y = x Sequence.<| removeNextDuplicate tailXs   | otherwise = removeNextDuplicate tailXs
test/Arbitrary.hs view
@@ -2,12 +2,11 @@  module Arbitrary where -import           Test.Tasty.QuickCheck (Arbitrary, arbitrary)- -- Local-import           Data.LinearRing       (LinearRing, makeLinearRing)-import           Data.LineString       (LineString, makeLineString) +import Data.LineString (LineString, makeLineString)+import Data.LinearRing (LinearRing, makeLinearRing)+import Test.Tasty.QuickCheck (Arbitrary, arbitrary)  instance (Arbitrary a, Eq a, Show a) => Arbitrary (LinearRing a) where   arbitrary = makeLinearRing <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
test/Data/Geospatial/Internal/CRSTests.hs view
@@ -2,15 +2,20 @@  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)+import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy.Char8 as BS -- Local-import           Data.Geospatial.Internal.CRS-import           Fixture-+import Data.Geospatial.Internal.CRS+import Fixture+import Test.Tasty+import Test.Tasty.Hspec+  ( Spec,+    context,+    describe,+    it,+    shouldBe,+    testSpec,+  )  -- Tests @@ -21,10 +26,11 @@  specTests :: IO TestTree specTests = do-  specs <- sequence-    [ testSpec "Data.Geospatial.Internal.CRS.fromJSON" testFromJSON-    , testSpec "Data.Geospatial.Internal.CRS.toJSON" testToJSON-    ]+  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@@ -45,9 +51,9 @@ testFromJSON =   describe "fromJSON" $ do     it "decode CRS Objects from GeoJSON" $ do-      A.decode testLinkCRSJSON  `shouldBe` Just testLinkCRS+      A.decode testLinkCRSJSON `shouldBe` Just testLinkCRS       A.decode testNamedCRSJSON `shouldBe` Just testNamedCRS-      A.decode testEPSGJSON     `shouldBe` Just testEPSG+      A.decode testEPSGJSON `shouldBe` Just testEPSG     context "when provided with invalid input" $       it "fails" $         (A.decode . BS.pack) "null" `shouldBe` Just NoCRS@@ -68,9 +74,9 @@ testToJSON =   describe "toJSON" $ do     it "encode CRS Objects to GeoJSON" $ do-      (A.decode . A.encode) testLinkCRS  `shouldBe` Just testLinkCRS+      (A.decode . A.encode) testLinkCRS `shouldBe` Just testLinkCRS       (A.decode . A.encode) testNamedCRS `shouldBe` Just testNamedCRS-      (A.decode . A.encode) testEPSG     `shouldBe` Just testEPSG+      (A.decode . A.encode) testEPSG `shouldBe` Just testEPSG     context "when provided with invalid input" $       it "fails" $-      A.encode NoCRS `shouldBe` "null"+        A.encode NoCRS `shouldBe` "null"
test/Data/Geospatial/Internal/GeoFeatureCollectionTests.hs view
@@ -1,11 +1,10 @@ module Data.Geospatial.Internal.GeoFeatureCollectionTests where -import qualified Data.Aeson       as A-import           Test.Tasty-import           Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec)+import qualified Data.Aeson as A -- Local-import           Fixture-+import Fixture+import Test.Tasty+import Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec)  -- Tests @@ -16,13 +15,13 @@  specTests :: IO TestTree specTests = do-  specs <- sequence-    [ testSpec "Data.Geospatial.Internal.GeoFeatureCollection.fromJSON" testFromJSON-    , testSpec "Data.Geospatial.Internal.GeoFeatureCollection.toJSON" testToJSON-    ]+  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@@ -41,10 +40,10 @@ testFromJSON =   describe "fromJSON" $     it "decode FeatureCollection Objects from GeoJSON" $ do-      A.decode bigAssFeatureCollectionJSON           `shouldBe` Just bigAssFeatureCollection+      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 emptyFeatureCollectionWithBBoxJSON `shouldBe` Just emptyFeatureCollectionWithBBox+      A.decode emptyFeatureCollectionJSON `shouldBe` Just emptyFeatureCollection  -- >>> (A.decode . A.encode) bigAssFeatureCollection == Just bigAssFeatureCollection -- True@@ -62,7 +61,7 @@ testToJSON =   describe "toJSON" $     it "encode FeatureCollection Objects to GeoJSON" $ do-      (A.decode . A.encode) bigAssFeatureCollection           `shouldBe` Just bigAssFeatureCollection+      (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+      (A.decode . A.encode) emptyFeatureCollectionWithBBox `shouldBe` Just emptyFeatureCollectionWithBBox+      (A.decode . A.encode) emptyFeatureCollection `shouldBe` Just emptyFeatureCollection
test/Data/Geospatial/Internal/GeoFeatureTests.hs view
@@ -1,11 +1,10 @@ module Data.Geospatial.Internal.GeoFeatureTests where -import qualified Data.Aeson       as A-import           Test.Tasty-import           Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec)+import qualified Data.Aeson as A -- Local-import           Fixture-+import Fixture+import Test.Tasty+import Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec)  -- Tests @@ -16,10 +15,11 @@  specTests :: IO TestTree specTests = do-  specs <- sequence-    [ testSpec "Data.Geospatial.Internal.GeoFeature.fromJSON" testFromJSON-    , testSpec "Data.Geospatial.Internal.GeoFeature.toJSON" testToJSON-    ]+  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@@ -43,11 +43,11 @@ testFromJSON =   describe "fromJSON" $     it "decode Feature Objects from GeoJSON" $ do-      A.decode bigFeatureJSON              `shouldBe` Just bigFeature+      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 featureWithNoIdJSON `shouldBe` Just featureWithNoId+      A.decode featureWithNoBBoxJSON `shouldBe` Just featureWithNoBBox+      A.decode featureWithNoGeometryJSON `shouldBe` Just featureWithNoGeometry  -- >>> (A.decode . A.encode) bigFeature == Just bigFeature -- True@@ -68,8 +68,8 @@ testToJSON =   describe "toJSON" $     it "encode Feature Objects to GeoJSON" $ do-      (A.decode . A.encode) bigFeature              `shouldBe` Just bigFeature+      (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+      (A.decode . A.encode) featureWithNoId `shouldBe` Just featureWithNoId+      (A.decode . A.encode) featureWithNoBBox `shouldBe` Just featureWithNoBBox+      (A.decode . A.encode) featureWithNoGeometry `shouldBe` Just featureWithNoGeometry
test/Data/Geospatial/Internal/GeometryTests.hs view
@@ -2,14 +2,19 @@  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)+import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy.Char8 as BS -- Local-import           Data.Geospatial.Internal.Geometry-import           Fixture+import Data.Geospatial.Internal.Geometry+import Fixture+import Test.Tasty+import Test.Tasty.Hspec+  ( Spec,+    describe,+    it,+    shouldBe,+    testSpec,+  )  -- Tests @@ -20,10 +25,11 @@  specTests :: IO TestTree specTests = do-  specs <- sequence-    [ testSpec "Data.Geospatial.Internal.Geometry.fromJSON" testFromJSON-    , testSpec "Data.Geospatial.Internal.Geometry.toJSON" testToJSON-    ]+  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@@ -57,14 +63,14 @@ 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 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.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"@@ -94,11 +100,11 @@ 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.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+      (A.decode . A.encode) multiLine `shouldBe` Just multiLine+      (A.decode . A.encode) emptyCollection `shouldBe` Just emptyCollection+      (A.decode . A.encode) bigassCollection `shouldBe` Just bigassCollection
test/Data/LineStringTests.hs view
@@ -1,16 +1,26 @@ module Data.LineStringTests where -import qualified Data.Sequence                       as Sequence-import           Data.Validation                     (Validation (..))-import           Test.Tasty-import           Test.Tasty.Hspec                    (Spec, context, describe,-                                                      it, shouldBe, testSpec)-import           Test.Tasty.QuickCheck               (Property, property,-                                                      testProperty) -- Local-import           Arbitrary                           ()+import Arbitrary () import qualified Data.Geospatial.Internal.BasicTypes as BasicTypes-import qualified Data.LineString                     as LineString+import qualified Data.LineString as LineString+import qualified Data.Sequence as Sequence+import Data.Validation (Validation (..))+import Test.Tasty+import Test.Tasty.Hspec+  ( Spec,+    context,+    describe,+    it,+    shouldBe,+    testSpec,+  )+import Test.Tasty.QuickCheck+  ( Property,+    property,+    testProperty,+  )+ -- Tests  tests :: IO TestTree@@ -19,20 +29,23 @@   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-  ]+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-    , testSpec "Data.LineString.fromSeq" testFromSequence-    , testSpec "Data.LineString.toSeq" testToSequence-    , testSpec "Data.LineString.combineToSequence" testCombineToSequence-    ]+  specs <-+    sequence+      [ testSpec "Data.LineString.fromList" testFromList,+        testSpec "Data.LineString.fromSeq" testFromSequence,+        testSpec "Data.LineString.toSeq" testToSequence,+        testSpec "Data.LineString.combineToSequence" testCombineToSequence+      ]   pure $ testGroup "Data.LineStringTests.Spec" specs  -- QuickCheck@@ -75,40 +88,40 @@ testFromList =   describe "fromList" $ do     it "creates a LineString out of a list of elements" $ do-      LineString.fromList ([0, 1] :: [Int])             `shouldBe` Success (LineString.makeLineString 0 1 Sequence.empty)-      LineString.fromList ([0, 1, 2] :: [Int])          `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2]))+      LineString.fromList ([0, 1] :: [Int]) `shouldBe` Success (LineString.makeLineString 0 1 Sequence.empty)+      LineString.fromList ([0, 1, 2] :: [Int]) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2]))       LineString.fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0]))     context "when provided with invalid input" $       it "fails" $ do-        LineString.fromList ([] :: [Int])  `shouldBe` Failure LineString.ListEmpty+        LineString.fromList ([] :: [Int]) `shouldBe` Failure LineString.ListEmpty         LineString.fromList ([0] :: [Int]) `shouldBe` Failure LineString.SingletonList  testFromSequence :: Spec testFromSequence =   describe "fromSeq" $ do     it "creates a LineString out of a Sequence of elements" $ do-      LineString.fromSeq (Sequence.fromList [0, 1] :: (Sequence.Seq Int))             `shouldBe` Success (LineString.makeLineString 0 1 Sequence.empty)-      LineString.fromSeq (Sequence.fromList [0, 1, 2] :: (Sequence.Seq Int))          `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2]))+      LineString.fromSeq (Sequence.fromList [0, 1] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 Sequence.empty)+      LineString.fromSeq (Sequence.fromList [0, 1, 2] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2]))       LineString.fromSeq (Sequence.fromList [0, 1, 2, 4, 5, 0] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0]))     context "when provided with invalid input" $       it "fails" $ do-        LineString.fromSeq (Sequence.fromList [] :: (Sequence.Seq Int))  `shouldBe` Failure LineString.SequenceEmpty+        LineString.fromSeq (Sequence.fromList [] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.SequenceEmpty         LineString.fromSeq (Sequence.fromList [0] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.SingletonSequence  testCombineToSequence :: Spec testCombineToSequence =   describe "combineToSeq" $     it "combine a LineString using PointXY" $ do-      LineString.combineToSeq BasicTypes.PointXY (LineString.makeLineString 0 1 Sequence.empty)                   `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1]-      LineString.combineToSeq BasicTypes.PointXY (LineString.makeLineString 0 1 (Sequence.fromList [2]))          `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2]+      LineString.combineToSeq BasicTypes.PointXY (LineString.makeLineString 0 1 Sequence.empty) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1]+      LineString.combineToSeq BasicTypes.PointXY (LineString.makeLineString 0 1 (Sequence.fromList [2])) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2]       LineString.combineToSeq BasicTypes.PointXY (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0])) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2, BasicTypes.PointXY 2 4, BasicTypes.PointXY 4 5, BasicTypes.PointXY 5 0]  testToSequence :: Spec testToSequence =   describe "toSeq" $     it "from a LineString to a Sequence" $ do-      LineString.toSeq (LineString.makeLineString 0 1 Sequence.empty)                   `shouldBe` Sequence.fromList ([0, 1] :: [Int])-      LineString.toSeq (LineString.makeLineString 0 1 (Sequence.fromList [2]))          `shouldBe` Sequence.fromList ([0, 1, 2] :: [Int])+      LineString.toSeq (LineString.makeLineString 0 1 Sequence.empty) `shouldBe` Sequence.fromList ([0, 1] :: [Int])+      LineString.toSeq (LineString.makeLineString 0 1 (Sequence.fromList [2])) `shouldBe` Sequence.fromList ([0, 1, 2] :: [Int])       LineString.toSeq (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0])) `shouldBe` Sequence.fromList ([0, 1, 2, 4, 5, 0] :: [Int])  -- TODO
test/Data/LinearRingTests.hs view
@@ -1,17 +1,26 @@ module Data.LinearRingTests where -import qualified Data.List.NonEmpty                  as ListNonEmpty-import qualified Data.Sequence                       as Sequence-import qualified Data.Validation                     as Validation-import           Test.Tasty-import           Test.Tasty.Hspec                    (Spec, context, describe,-                                                      it, shouldBe, testSpec)-import           Test.Tasty.QuickCheck               (Property, property,-                                                      testProperty) -- Local-import           Arbitrary                           ()+import Arbitrary () import qualified Data.Geospatial.Internal.BasicTypes as BasicTypes-import qualified Data.LinearRing                     as LinearRing+import qualified Data.LinearRing as LinearRing+import qualified Data.List.NonEmpty as ListNonEmpty+import qualified Data.Sequence as Sequence+import qualified Data.Validation as Validation+import Test.Tasty+import Test.Tasty.Hspec+  ( Spec,+    context,+    describe,+    it,+    shouldBe,+    testSpec,+  )+import Test.Tasty.QuickCheck+  ( Property,+    property,+    testProperty,+  )  -- Tests @@ -21,21 +30,24 @@   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-  ]+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-    , testSpec "Data.LinearRing.fromSeq" testFromSequence-    , testSpec "Data.LinearRing.combineToSequence" testCombineToSequence-    , testSpec "Data.LinearRing.toSequence" testToSequence-    , testSpec "Data.LinearRing.foldMap" testFoldMap-    ]+  specs <-+    sequence+      [ testSpec "Data.LinearRing.fromList" testFromList,+        testSpec "Data.LinearRing.fromSeq" testFromSequence,+        testSpec "Data.LinearRing.combineToSequence" testCombineToSequence,+        testSpec "Data.LinearRing.toSequence" testToSequence,+        testSpec "Data.LinearRing.foldMap" testFoldMap+      ]   pure $ testGroup "Data.LinearRingTests.Spec" specs  -- QuickCheck@@ -87,54 +99,53 @@ testFromList =   describe "fromList" $ do     it "creates a LinearRing out of a list of elements" $ do-      LinearRing.fromList ([0, 1, 2, 3] :: [Int])       `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 Sequence.empty)-      LinearRing.fromList ([0, 1, 2, 4, 0] :: [Int])    `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4]))-      LinearRing.fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4,5]))-      LinearRing.fromList ([0, 1, 2, 4, 5, 6] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4,5]))+      LinearRing.fromList ([0, 1, 2, 3] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 Sequence.empty)+      LinearRing.fromList ([0, 1, 2, 4, 0] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4]))+      LinearRing.fromList ([0, 1, 2, 4, 5, 0] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 5]))+      LinearRing.fromList ([0, 1, 2, 4, 5, 6] :: [Int]) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 5]))     context "when provided with invalid input" $       it "fails" $ do-        LinearRing.fromList []        `shouldBe` Validation.Failure (LinearRing.ListTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))-        LinearRing.fromList [0]       `shouldBe` Validation.Failure (LinearRing.ListTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))-        LinearRing.fromList [0, 1]    `shouldBe` Validation.Failure (LinearRing.ListTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))+        LinearRing.fromList [] `shouldBe` Validation.Failure (LinearRing.ListTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))+        LinearRing.fromList [0] `shouldBe` Validation.Failure (LinearRing.ListTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))+        LinearRing.fromList [0, 1] `shouldBe` Validation.Failure (LinearRing.ListTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))         LinearRing.fromList [0, 1, 2] `shouldBe` Validation.Failure (LinearRing.ListTooShort 3 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.ListToLinearRingError Int))  testFromSequence :: Spec testFromSequence =   describe "fromSeq" $ do     it "creates a LinearRing out of a Sequence of elements" $ do-      LinearRing.fromSeq (Sequence.fromList ([0, 1, 0] :: [Int]))         `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 0 Sequence.empty)-      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 0] :: [Int]))      `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0]))-      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 4, 0] :: [Int]))   `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 0]))-      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 4, 5, 0]:: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 5, 0]))+      LinearRing.fromSeq (Sequence.fromList ([0, 1, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 0 Sequence.empty)+      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0]))+      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 4, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 0]))+      LinearRing.fromSeq (Sequence.fromList ([0, 1, 2, 4, 5, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 5, 0]))     context "when provided with invalid input" $       it "fails" $ do-        LinearRing.fromSeq (Sequence.fromList [])        `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))-        LinearRing.fromSeq (Sequence.fromList [0])       `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))-        LinearRing.fromSeq (Sequence.fromList [0, 1])    `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))+        LinearRing.fromSeq (Sequence.fromList []) `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))+        LinearRing.fromSeq (Sequence.fromList [0]) `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))+        LinearRing.fromSeq (Sequence.fromList [0, 1]) `shouldBe` Validation.Failure (LinearRing.SequenceTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))         LinearRing.fromSeq (Sequence.fromList [0, 1, 2]) `shouldBe` Validation.Failure (LinearRing.FirstNotEqualToLast 0 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.SequenceToLinearRingError Int))  testCombineToSequence :: Spec testCombineToSequence =   describe "combineToSeq" $     it "combine a LinearRing using tuples" $ do-      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 Sequence.empty)             `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2]-      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4]))    `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2, BasicTypes.PointXY 2 4]-      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4,5]))  `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2, BasicTypes.PointXY 2 4, BasicTypes.PointXY 4 5]+      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 Sequence.empty) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2]+      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4])) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2, BasicTypes.PointXY 2 4]+      LinearRing.combineToSeq BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 5])) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2, BasicTypes.PointXY 2 4, BasicTypes.PointXY 4 5]  testToSequence :: Spec testToSequence =   describe "toSeq" $     it "from a LinearRing to a Sequence" $ do-      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 0 Sequence.empty)             `shouldBe` Sequence.fromList ([0, 1, 0] :: [Int])-      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0]))    `shouldBe` Sequence.fromList ([0, 1, 2, 0] :: [Int])-      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4,0]))  `shouldBe` Sequence.fromList ([0, 1, 2, 4, 0] :: [Int])+      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 0 Sequence.empty) `shouldBe` Sequence.fromList ([0, 1, 0] :: [Int])+      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0])) `shouldBe` Sequence.fromList ([0, 1, 2, 0] :: [Int])+      LinearRing.toSeq (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 0])) `shouldBe` Sequence.fromList ([0, 1, 2, 4, 0] :: [Int])  testFoldMap :: Spec testFoldMap =   describe "foldMap" $     it "foldMap of a LinearRing" $       foldMap (\x -> Sequence.singleton (x + 1)) (LinearRing.makeLinearRing 0 1 2 Sequence.empty) `shouldBe` Sequence.fromList ([1, 2, 3, 1] :: [Int])-  -- TODO -- > (\xs -> safeLast (fromLinearRing xs) == Just (ringHead xs)) (xs :: LinearRing Int)
test/Data/SeqHelperTests.hs view
@@ -1,11 +1,11 @@ module Data.SeqHelperTests where -import qualified Data.Sequence    as Sequence-import           Test.Tasty-import           Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec) -- Local-import           Arbitrary        ()-import qualified Data.SeqHelper   as SeqHelper+import Arbitrary ()+import qualified Data.SeqHelper as SeqHelper+import qualified Data.Sequence as Sequence+import Test.Tasty+import Test.Tasty.Hspec (Spec, describe, it, shouldBe, testSpec)  -- Tests 
test/Fixture.hs view
@@ -2,25 +2,29 @@  module Fixture where -import qualified Data.Aeson                                        as Aeson-import qualified Data.ByteString.Lazy.Char8                        as BS-import qualified Data.Text                                         as T+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Key as AesonKey+import qualified Data.ByteString.Lazy.Char8 as BS -- Local-import qualified Data.Geospatial.Internal.BasicTypes               as BasicTypes-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.GeoPoint        (GeoPoint (..))-import           Data.Geospatial.Internal.Geometry.GeoPolygon      (GeoPolygon (..))-import qualified Data.LinearRing                                   as LinearRing-import qualified Data.LineString                                   as LineString-import qualified Data.Sequence                                     as Sequence+import qualified Data.Geospatial.Internal.BasicTypes as BasicTypes+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.GeoPoint (GeoPoint (..))+import Data.Geospatial.Internal.Geometry.GeoPolygon (GeoPolygon (..))+import qualified Data.LineString as LineString+import qualified Data.LinearRing as LinearRing+import qualified Data.Sequence as Sequence  -- CRS Data @@ -48,7 +52,7 @@ mkGeoPoint x y = BasicTypes.GeoPointXY $ BasicTypes.PointXY x y  lshapedPolyVertices :: Sequence.Seq (LinearRing.LinearRing BasicTypes.GeoPositionWithoutCRS)-lshapedPolyVertices =  Sequence.fromList [LinearRing.makeLinearRing (mkGeoPoint 120.0 (-15.0)) (mkGeoPoint 127.0 (-15.0)) (mkGeoPoint 127.0 (-25.0)) (Sequence.fromList [mkGeoPoint 124.0 (-25.0), mkGeoPoint 124.0 (-18.0), mkGeoPoint 120.0 (-18.0)])]+lshapedPolyVertices = Sequence.fromList [LinearRing.makeLinearRing (mkGeoPoint 120.0 (-15.0)) (mkGeoPoint 127.0 (-15.0)) (mkGeoPoint 127.0 (-25.0)) (Sequence.fromList [mkGeoPoint 124.0 (-25.0), mkGeoPoint 124.0 (-18.0), mkGeoPoint 120.0 (-18.0)])]  lshapedPolyLineVertices :: LineString.LineString BasicTypes.GeoPositionWithoutCRS lshapedPolyLineVertices = LineString.makeLineString (mkGeoPoint 120.0 (-15.0)) (mkGeoPoint 127.0 (-15.0)) (Sequence.fromList [mkGeoPoint 127.0 (-25.0), mkGeoPoint 124.0 (-25.0), mkGeoPoint 124.0 (-18.0), mkGeoPoint 120.0 (-18.0)])@@ -67,7 +71,9 @@ -- Upside down L Shaped Poly -- -- (120, -15)                (127, -15)--- *---------------------------*++-- * ---------------------------*+ -- |                           | -- |                           | -- |             (124, -18)    |@@ -81,7 +87,6 @@ --                 |           | --                 *-----------* --               (124, -25)  (127, -25)---  -- Points pointJSON :: BS.ByteString@@ -103,7 +108,6 @@ lShapedPoly :: GeospatialGeometry lShapedPoly = Polygon lShapedGeoPoly - emptyPolyJSON :: BS.ByteString emptyPolyJSON = "{\"type\":\"Polygon\",\"coordinates\":[]}" @@ -195,7 +199,7 @@ -- Properties Data  testProperties :: Aeson.Value-testProperties = Aeson.object [T.pack "depth" Aeson..= (5 :: Int), T.pack "comment" Aeson..= T.pack "Bore run over by dump truck"]+testProperties = Aeson.object [AesonKey.fromText "depth" Aeson..= (5 :: Int), AesonKey.fromText "comment" Aeson..= AesonKey.fromText "Bore run over by dump truck"]  -- Feature Data 
test/Main.hs view
@@ -1,25 +1,25 @@ module Main (main) where -import           Test.Tasty -- Local-import qualified Data.Geospatial.Internal.CRSTests                  as CRS+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-import qualified Data.SeqHelperTests                                as SH-+import qualified Data.Geospatial.Internal.GeoFeatureTests as F+import qualified Data.Geospatial.Internal.GeometryTests as G+import qualified Data.LineStringTests as LS+import qualified Data.LinearRingTests as LR+import qualified Data.SeqHelperTests as SH+import Test.Tasty  main :: IO () main = do-  tests <- sequence-    [ LR.tests-    , LS.tests-    , SH.tests-    , CRS.tests-    , FC.tests-    , F.tests-    , G.tests-    ]+  tests <-+    sequence+      [ LR.tests,+        LS.tests,+        SH.tests,+        CRS.tests,+        FC.tests,+        F.tests,+        G.tests+      ]   defaultMain (testGroup "tests" tests)