diff --git a/geojson.cabal b/geojson.cabal --- a/geojson.cabal +++ b/geojson.cabal @@ -1,5 +1,5 @@ -name: geojson -version: 3.0.0 +name: geojson +version: 3.0.1 license: BSD3 license-file: LICENCE author: Dom De Re @@ -27,7 +27,7 @@ source-repository this type: git location: https://github.com/indicatrix/hs-geojson.git - tag: 3.0.0 + tag: 3.0.1 library hs-source-dirs: src @@ -45,6 +45,7 @@ exposed-modules: Data.Geospatial , Data.LinearRing , Data.LineString + , Data.SeqHelper , Data.Geospatial.Internal.BasicTypes , Data.Geospatial.Internal.CRS , Data.Geospatial.Internal.GeoFeature diff --git a/src/Data/LineString.hs b/src/Data/LineString.hs --- a/src/Data/LineString.hs +++ b/src/Data/LineString.hs @@ -19,9 +19,9 @@ , ListToLineStringError(..) , VectorToLineStringError(..) -- * Functions - , toVector - , combineToVector - , fromVector + , toSeq + , combineToSeq + , fromSeq , fromLineString , fromList , makeLineString @@ -44,6 +44,8 @@ import qualified Data.Validation as Validation import GHC.Generics (Generic) +import qualified Data.SeqHelper as SeqHelper + -- | -- a LineString has at least 2 elements -- @@ -108,53 +110,49 @@ {-# INLINE fromList #-} -- | --- create a vector from a LineString by combining values. +-- create a sequence from a LineString by combining values. -- LineString 1 2 [3,4] (,) --> Vector [(1,2),(2,3),(3,4)] -- -combineToVector :: (a -> a -> b) -> LineString a -> Sequence.Seq b -combineToVector combine (LineString a b rest) = combine a b Sequence.<| combineRest +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 <*> sequenceTail) (b Sequence.<| rest) -{-# INLINE combineToVector #-} - -sequenceTail :: Sequence.Seq a -> Sequence.Seq a -sequenceTail (_ Sequence.:<| tailS) = tailS -sequenceTail _ = Sequence.empty + (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (b Sequence.<| rest) +{-# INLINE combineToSeq #-} -- | --- create a vector from a LineString. +-- create a sequence from a LineString. -- LineString 1 2 [3,4] --> Vector [1,2,3,4] -- -toVector :: LineString a -> Sequence.Seq a -toVector (LineString a b rest) = a Sequence.<| ( b Sequence.<| rest) -{-# INLINE toVector #-} +toSeq :: LineString a -> Sequence.Seq a +toSeq (LineString a b rest) = a Sequence.<| ( b Sequence.<| rest) +{-# INLINE toSeq #-} -- | --- creates a LineString out of a vector of elements, +-- creates a LineString out of a sequence of elements, -- if there are enough elements (needs at least 2) elements -- -fromVector :: (Validation.Validate v) => Sequence.Seq a -> v VectorToLineStringError (LineString a) -fromVector v@(headS Sequence.:<| tailS) = +fromSeq :: (Validation.Validate v) => Sequence.Seq a -> v VectorToLineStringError (LineString a) +fromSeq v@(headS Sequence.:<| tailS) = if Sequence.null v then Validation._Failure # SingletonVector else - fromVector' headS tailS -fromVector _ = Validation._Failure # VectorEmpty -{-# INLINE fromVector #-} + fromSeq' headS tailS +fromSeq _ = Validation._Failure # VectorEmpty +{-# INLINE fromSeq #-} -fromVector' :: (Validation.Validate v) => a -> Sequence.Seq a -> v VectorToLineStringError (LineString a) -fromVector' first v@(headS Sequence.:<| tailS) = +fromSeq' :: (Validation.Validate v) => a -> Sequence.Seq a -> v VectorToLineStringError (LineString a) +fromSeq' first v@(headS Sequence.:<| tailS) = if Sequence.null v then Validation._Failure # SingletonVector else Validation._Success # LineString first headS tailS -fromVector' _ _ = Validation._Failure # SingletonVector -{-# INLINE fromVector' #-} +fromSeq' _ _ = Validation._Failure # SingletonVector +{-# INLINE fromSeq' #-} -- | -- Creates a LineString @@ -216,6 +214,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.EmptyR -> Nothing _ Sequence.:> b -> Just b {-# INLINE safeLast #-} diff --git a/src/Data/LinearRing.hs b/src/Data/LinearRing.hs --- a/src/Data/LinearRing.hs +++ b/src/Data/LinearRing.hs @@ -21,9 +21,9 @@ , ListToLinearRingError(..) , VectorToLinearRingError(..) -- * Functions - , toVector - , combineToVector - , fromVector + , toSeq + , combineToSeq + , fromSeq , fromLinearRing , fromList , fromListWithEqCheck @@ -52,6 +52,8 @@ import qualified Data.Validation as Validation import GHC.Generics (Generic) +import qualified Data.SeqHelper as SeqHelper + -- | -- a LinearRing has at least 3 (distinct) elements -- @@ -130,41 +132,36 @@ fromListWithEqCheck xs = checkHeadAndLastEq xs *> fromList xs -- | --- create a vector from a LinearRing by combining values. +-- create a sequence from a LinearRing by combining values. -- LinearRing 1 2 3 [4,1] (,) --> Vector [(1,2),(2,3),(3,4),(4,1)] -- -combineToVector :: (a -> a -> b) -> LinearRing a -> Sequence.Seq b -combineToVector combine (LinearRing a b c rest) = combine a b Sequence.:<| (combine b c Sequence.:<| combineRest) +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 <*> sequenceTail) (c Sequence.<| rest) -{-# INLINE combineToVector #-} - -sequenceTail :: Sequence.Seq a -> Sequence.Seq a -sequenceTail (_ Sequence.:<| tailS) = tailS -sequenceTail _ = Sequence.empty + (Sequence.zipWith combine <*> SeqHelper.sequenceTail) (c Sequence.<| rest) +{-# INLINE combineToSeq #-} -- | --- create a vector from a LinearRing. +-- create a sequence from a LinearRing. -- LinearRing 1 2 3 [4,1] --> Vector [1,2,3,4,1)] -- -toVector :: LinearRing a -> Sequence.Seq a -toVector (LinearRing a b c rest) = a Sequence.:<| (b Sequence.:<| (c Sequence.:<| rest)) -{-# INLINE toVector #-} +toSeq :: LinearRing a -> Sequence.Seq a +toSeq (LinearRing a b c rest) = a Sequence.:<| (b Sequence.:<| (c Sequence.:<| rest)) +{-# INLINE toSeq #-} -- | -- creates a LinearRing out of a vector of elements, -- if there are enough elements (needs at least 3) elements -- --- fromVector (x:y:z:ws@(_:_)) = _Success # LinearRing x y z (fromListDropLast ws) --- fromList xs = _Failure # return (ListTooShort (length xs)) - -fromVector :: (Eq a, Show a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a)))) => Sequence.Seq a -> v (NonEmpty (VectorToLinearRingError a)) (LinearRing a) -fromVector as = +-- fromSeq (x:y:z:ws@(_:_)) = _Success # LinearRing x y z (fromListDropLast ws) +-- 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 (VectorToLinearRingError a)) (LinearRing a) +fromSeq as = case as of (first Sequence.:<| (second Sequence.:<| (third Sequence.:<| rest@(_ Sequence.:|> lastS)))) -> if first == lastS then @@ -178,7 +175,7 @@ Validation._Failure # pure (FirstNotEqualToLast first third) v -> Validation._Failure # pure (VectorTooShort (Sequence.length v)) _ -> Validation._Failure # pure (VectorTooShort 0) -{-# INLINE fromVector #-} +{-# INLINE fromSeq #-} -- | -- Creates a LinearRing @@ -266,9 +263,5 @@ fromListDropLast :: (Eq a) => [a] -> Sequence.Seq a fromListDropLast [] = Sequence.empty fromListDropLast [_] = Sequence.empty -fromListDropLast x = sequenceHead $ Sequence.fromList x +fromListDropLast x = SeqHelper.sequenceHead $ Sequence.fromList x --- All but the last -sequenceHead :: Sequence.Seq a -> Sequence.Seq a -sequenceHead (headS Sequence.:|> _) = headS -sequenceHead _ = Sequence.empty diff --git a/src/Data/SeqHelper.hs b/src/Data/SeqHelper.hs new file mode 100644 --- /dev/null +++ b/src/Data/SeqHelper.hs @@ -0,0 +1,27 @@ +------------------------------------------------------------------- +-- | +-- Module : Data.Geospatial.Internal.SeqHelpers +-- Copyright : (C) 2014-2018 HS-GeoJSON Project +-- License : BSD-style (see the file LICENSE.md) +-- Maintainer : Andrew Newman +-- +-- see Section 2.1.1 /Position/ in the GeoJSON Spec +------------------------------------------------------------------- +module Data.SeqHelper ( + sequenceHead + , sequenceTail + ) 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 +{-# INLINE sequenceHead #-} + +-- All but the first +sequenceTail :: Sequence.Seq a -> Sequence.Seq a +sequenceTail (_ Sequence.:<| tailS) = tailS +sequenceTail _ = Sequence.empty +{-# INLINE sequenceTail #-} diff --git a/test/Data/LineStringTests.hs b/test/Data/LineStringTests.hs --- a/test/Data/LineStringTests.hs +++ b/test/Data/LineStringTests.hs @@ -29,8 +29,8 @@ specTests = do specs <- sequence [ testSpec "Data.LineString.fromList" testFromList - , testSpec "Data.LineString.fromVector" testFromVector - , testSpec "Data.LineString.toVector" testToVector + , testSpec "Data.LineString.fromSeq" testFromVector + , testSpec "Data.LineString.toSeq" testToVector , testSpec "Data.LineString.combineToVector" testCombineToVector ] pure $ testGroup "Data.LineStringTests.Spec" specs @@ -87,29 +87,29 @@ testFromVector = describe "fromVector" $ do it "creates a LineString out of a Vector of elements" $ do - LineString.fromVector (Sequence.fromList [0, 1] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 Sequence.empty) - LineString.fromVector (Sequence.fromList [0, 1, 2] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2])) - LineString.fromVector (Sequence.fromList [0, 1, 2, 4, 5, 0] :: (Sequence.Seq Int)) `shouldBe` Success (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0])) + 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.fromVector (Sequence.fromList [] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.VectorEmpty - LineString.fromVector (Sequence.fromList [0] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.SingletonVector + LineString.fromSeq (Sequence.fromList [] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.VectorEmpty + LineString.fromSeq (Sequence.fromList [0] :: (Sequence.Seq Int)) `shouldBe` Failure LineString.SingletonVector testCombineToVector :: Spec testCombineToVector = describe "combineToVector" $ it "combine a LineString using PointXY" $ do - LineString.combineToVector BasicTypes.PointXY (LineString.makeLineString 0 1 Sequence.empty) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1] - LineString.combineToVector BasicTypes.PointXY (LineString.makeLineString 0 1 (Sequence.fromList [2])) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2] - LineString.combineToVector 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] + 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] testToVector :: Spec testToVector = describe "toVector" $ it "from a LineString to a vector" $ do - LineString.toVector (LineString.makeLineString 0 1 Sequence.empty) `shouldBe` Sequence.fromList ([0, 1] :: [Int]) - LineString.toVector (LineString.makeLineString 0 1 (Sequence.fromList [2])) `shouldBe` Sequence.fromList ([0, 1, 2] :: [Int]) - LineString.toVector (LineString.makeLineString 0 1 (Sequence.fromList [2, 4, 5, 0])) `shouldBe` Sequence.fromList ([0, 1, 2, 4, 5, 0] :: [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 -- (\xs -> safeLast (fromLineString xs) == Just (lineStringHead xs)) (xs :: LineString Int) diff --git a/test/Data/LinearRingTests.hs b/test/Data/LinearRingTests.hs --- a/test/Data/LinearRingTests.hs +++ b/test/Data/LinearRingTests.hs @@ -31,7 +31,7 @@ specTests = do specs <- sequence [ testSpec "Data.LinearRing.fromList" testFromList - , testSpec "Data.LinearRing.fromVector" testFromVector + , testSpec "Data.LinearRing.fromSeq" testFromVector , testSpec "Data.LinearRing.combineToVector" testCombineToVector , testSpec "Data.LinearRing.testToVector" testToVector ] @@ -101,32 +101,32 @@ testFromVector = describe "fromVector" $ do it "creates a LinearRing out of a vector of elements" $ do - LinearRing.fromVector (Sequence.fromList ([0, 1, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 0 Sequence.empty) - LinearRing.fromVector (Sequence.fromList ([0, 1, 2, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0])) - LinearRing.fromVector (Sequence.fromList ([0, 1, 2, 4, 0] :: [Int])) `shouldBe` Validation.Success (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [4, 0])) - LinearRing.fromVector (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.fromVector (Sequence.fromList []) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) - LinearRing.fromVector (Sequence.fromList [0]) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) - LinearRing.fromVector (Sequence.fromList [0, 1]) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) - LinearRing.fromVector (Sequence.fromList [0, 1, 2]) `shouldBe` Validation.Failure (LinearRing.FirstNotEqualToLast 0 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) + LinearRing.fromSeq (Sequence.fromList []) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 0 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) + LinearRing.fromSeq (Sequence.fromList [0]) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 1 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) + LinearRing.fromSeq (Sequence.fromList [0, 1]) `shouldBe` Validation.Failure (LinearRing.VectorTooShort 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) + LinearRing.fromSeq (Sequence.fromList [0, 1, 2]) `shouldBe` Validation.Failure (LinearRing.FirstNotEqualToLast 0 2 ListNonEmpty.:| [] :: ListNonEmpty.NonEmpty (LinearRing.VectorToLinearRingError Int)) testCombineToVector :: Spec testCombineToVector = describe "combineToVector" $ it "combine a LinearRing using tuples" $ do - LinearRing.combineToVector BasicTypes.PointXY (LinearRing.makeLinearRing 0 1 2 Sequence.empty) `shouldBe` Sequence.fromList [BasicTypes.PointXY 0 1, BasicTypes.PointXY 1 2] - LinearRing.combineToVector 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.combineToVector 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] testToVector :: Spec testToVector = describe "toVector" $ it "from a LinearRing to a vector" $ do - LinearRing.toVector (LinearRing.makeLinearRing 0 1 0 Sequence.empty) `shouldBe` Sequence.fromList ([0, 1, 0] :: [Int]) - LinearRing.toVector (LinearRing.makeLinearRing 0 1 2 (Sequence.fromList [0])) `shouldBe` Sequence.fromList ([0, 1, 2, 0] :: [Int]) - LinearRing.toVector (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]) -- TODO