{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE NoImplicitPrelude #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.LinearRing
-- Copyright    : (C) 2014-2019 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#polygon>
--
-- 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(..)
    -- * Functions
    ,   toSeq
    ,   combineToSeq
    ,   fromSeq
    ,   fromLinearRing
    ,   fromList
    ,   fromListWithEqCheck
    ,   makeLinearRing
    ,   ringHead
    ,   ringLength
    ) where

#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
import           Prelude             hiding (foldr)
#else
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

-- |
-- a LinearRing has at least 3 (distinct) elements
--
data LinearRing a = LinearRing a a a (Sequence.Seq a) deriving (LinearRing a -> LinearRing a -> Bool
(LinearRing a -> LinearRing a -> Bool)
-> (LinearRing a -> LinearRing a -> Bool) -> Eq (LinearRing a)
forall a. Eq a => LinearRing a -> LinearRing a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearRing a -> LinearRing a -> Bool
$c/= :: forall a. Eq a => LinearRing a -> LinearRing a -> Bool
== :: LinearRing a -> LinearRing a -> Bool
$c== :: forall a. Eq a => LinearRing a -> LinearRing a -> Bool
Eq, Int -> LinearRing a -> ShowS
[LinearRing a] -> ShowS
LinearRing a -> String
(Int -> LinearRing a -> ShowS)
-> (LinearRing a -> String)
-> ([LinearRing a] -> ShowS)
-> Show (LinearRing a)
forall a. Show a => Int -> LinearRing a -> ShowS
forall a. Show a => [LinearRing a] -> ShowS
forall a. Show a => LinearRing a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinearRing a] -> ShowS
$cshowList :: forall a. Show a => [LinearRing a] -> ShowS
show :: LinearRing a -> String
$cshow :: forall a. Show a => LinearRing a -> String
showsPrec :: Int -> LinearRing a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LinearRing a -> ShowS
Show, (forall x. LinearRing a -> Rep (LinearRing a) x)
-> (forall x. Rep (LinearRing a) x -> LinearRing a)
-> Generic (LinearRing a)
forall x. Rep (LinearRing a) x -> LinearRing a
forall x. LinearRing a -> Rep (LinearRing a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LinearRing a) x -> LinearRing a
forall a x. LinearRing a -> Rep (LinearRing a) x
$cto :: forall a x. Rep (LinearRing a) x -> LinearRing a
$cfrom :: forall a x. LinearRing a -> Rep (LinearRing a) x
Generic, LinearRing a -> ()
(LinearRing a -> ()) -> NFData (LinearRing a)
forall a. NFData a => LinearRing a -> ()
forall a. (a -> ()) -> NFData a
rnf :: LinearRing a -> ()
$crnf :: forall a. NFData a => LinearRing a -> ()
NFData)

-- |
-- When converting a List to a LinearRing there are some things that can go wrong
--
--     * 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 (ListToLinearRingError a -> ListToLinearRingError a -> Bool
(ListToLinearRingError a -> ListToLinearRingError a -> Bool)
-> (ListToLinearRingError a -> ListToLinearRingError a -> Bool)
-> Eq (ListToLinearRingError a)
forall a.
Eq a =>
ListToLinearRingError a -> ListToLinearRingError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListToLinearRingError a -> ListToLinearRingError a -> Bool
$c/= :: forall a.
Eq a =>
ListToLinearRingError a -> ListToLinearRingError a -> Bool
== :: ListToLinearRingError a -> ListToLinearRingError a -> Bool
$c== :: forall a.
Eq a =>
ListToLinearRingError a -> ListToLinearRingError a -> Bool
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
  | FirstNotEqualToLast a a
  deriving (SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
(SequenceToLinearRingError a
 -> SequenceToLinearRingError a -> Bool)
-> (SequenceToLinearRingError a
    -> SequenceToLinearRingError a -> Bool)
-> Eq (SequenceToLinearRingError a)
forall a.
Eq a =>
SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
$c/= :: forall a.
Eq a =>
SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
== :: SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
$c== :: forall a.
Eq a =>
SequenceToLinearRingError a -> SequenceToLinearRingError a -> Bool
Eq)

-- functions

-- |
-- returns the element at the head of the ring
--
ringHead :: LinearRing a -> a
ringHead :: LinearRing a -> a
ringHead (LinearRing a
x a
_ a
_ Seq a
_)   = a
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 a -> Int
ringLength (LinearRing a
_ a
_ a
_ Seq a
xs) = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
xs

-- |
-- This function converts it into a list and appends the given element to the end.
--
fromLinearRing :: LinearRing a -> [a]
fromLinearRing :: LinearRing a -> [a]
fromLinearRing (LinearRing a
x a
y a
z Seq a
ws) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
z a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a] -> [a]) -> [a] -> Seq a -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (:) [a
x] Seq a
ws

-- |
-- creates a LinearRing out of a list of elements,
-- if there arent enough elements (needs at least 4) elements
--
-- This version doesnt check equality of the head and tail in case
-- you wish to use it for elements with no Eq instance defined.
--
-- Also its a list, finding the last element could be expensive with large
-- lists.  So just follow the spec and make sure the ring is closed.
--
-- Ideally the Spec would be modified to remove the redundant last element from the Polygons/LineRings.
-- Its just going to waste bandwidth...
--
-- 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 :: [a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromList (a
x:a
y:a
z:ws :: [a]
ws@(a
_:[a]
_)) = Tagged (LinearRing a) (Identity (LinearRing a))
-> Tagged
     (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))
     (Identity (v (NonEmpty (ListToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged (LinearRing a) (Identity (LinearRing a))
 -> Tagged
      (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))
      (Identity (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))))
-> LinearRing a
-> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# a -> a -> a -> Seq a -> LinearRing a
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing a
x a
y a
z ([a] -> Seq a
forall a. Eq a => [a] -> Seq a
fromListDropLast [a]
ws)
fromList [a]
xs               = Tagged
  (NonEmpty (ListToLinearRingError a))
  (Identity (NonEmpty (ListToLinearRingError a)))
-> Tagged
     (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))
     (Identity (v (NonEmpty (ListToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (ListToLinearRingError a))
   (Identity (NonEmpty (ListToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))
      (Identity (v (NonEmpty (ListToLinearRingError a)) (LinearRing a))))
-> NonEmpty (ListToLinearRingError a)
-> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# ListToLinearRingError a -> NonEmpty (ListToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ListToLinearRingError a
forall a. Int -> ListToLinearRingError a
ListTooShort ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
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 :: [a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromListWithEqCheck [a]
xs = [a] -> v (NonEmpty (ListToLinearRingError a)) ()
forall a (v :: * -> * -> *).
(Eq a, Validate v,
 Functor (v (NonEmpty (ListToLinearRingError a)))) =>
[a] -> v (NonEmpty (ListToLinearRingError a)) ()
checkHeadAndLastEq [a]
xs v (NonEmpty (ListToLinearRingError a)) ()
-> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
-> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall a (v :: * -> * -> *).
(Eq a, Show a, Validate v,
 Functor (v (NonEmpty (ListToLinearRingError a)))) =>
[a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromList [a]
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 :: (a -> a -> b) -> LinearRing a -> Seq b
combineToSeq a -> a -> b
combine (LinearRing a
a a
b a
c Seq a
rest) = a -> a -> b
combine a
a a
b b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
Sequence.:<| (a -> a -> b
combine a
b a
c b -> Seq b -> Seq b
forall a. a -> Seq a -> Seq a
Sequence.:<| Seq b
combineRest)
    where
        combineRest :: Seq b
combineRest =
          if Seq a -> Bool
forall a. Seq a -> Bool
Sequence.null Seq a
rest
            then
              Seq b
forall a. Seq a
Sequence.empty
            else
              ((a -> a -> b) -> Seq a -> Seq a -> Seq b
forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Sequence.zipWith a -> a -> b
combine (Seq a -> Seq a -> Seq b) -> (Seq a -> Seq a) -> Seq a -> Seq b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Seq a -> Seq a
forall a. Seq a -> Seq a
SeqHelper.sequenceTail) (a
c a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Sequence.<| Seq a
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 -> Seq a
toSeq (LinearRing a
a a
b a
c Seq a
rest) = a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Sequence.:<| (a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Sequence.:<| (a
c a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Sequence.:<| Seq a
rest))
{-# INLINE toSeq #-}

-- |
-- creates a LinearRing out of a sequence of elements,
-- if there are enough elements (needs at least 3) elements
--
-- 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 (SequenceToLinearRingError a)) (LinearRing a)
fromSeq :: Seq a -> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
fromSeq Seq a
as =
    case Seq a
as of
        (a
first Sequence.:<| (a
second Sequence.:<| (a
third Sequence.:<| rest :: Seq a
rest@(Seq a
_ Sequence.:|> a
lastS)))) ->
            if a
first a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
lastS then
                Tagged (LinearRing a) (Identity (LinearRing a))
-> Tagged
     (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
     (Identity
        (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged (LinearRing a) (Identity (LinearRing a))
 -> Tagged
      (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
      (Identity
         (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))))
-> LinearRing a
-> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# a -> a -> a -> Seq a -> LinearRing a
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing a
first a
second a
third Seq a
rest
            else
                Tagged
  (NonEmpty (SequenceToLinearRingError a))
  (Identity (NonEmpty (SequenceToLinearRingError a)))
-> Tagged
     (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
     (Identity
        (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (SequenceToLinearRingError a))
   (Identity (NonEmpty (SequenceToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
      (Identity
         (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))))
-> NonEmpty (SequenceToLinearRingError a)
-> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# SequenceToLinearRingError a
-> NonEmpty (SequenceToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> SequenceToLinearRingError a
forall a. a -> a -> SequenceToLinearRingError a
FirstNotEqualToLast a
first a
lastS)
        (a
first Sequence.:<| (a
second Sequence.:<| (a
third Sequence.:<| Seq a
_))) ->
            if a
first a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
third then
                Tagged (LinearRing a) (Identity (LinearRing a))
-> Tagged
     (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
     (Identity
        (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged (LinearRing a) (Identity (LinearRing a))
 -> Tagged
      (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
      (Identity
         (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))))
-> LinearRing a
-> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# a -> a -> a -> Seq a -> LinearRing a
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing a
first a
second a
third Seq a
forall a. Seq a
Sequence.empty
            else
                Tagged
  (NonEmpty (SequenceToLinearRingError a))
  (Identity (NonEmpty (SequenceToLinearRingError a)))
-> Tagged
     (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
     (Identity
        (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (SequenceToLinearRingError a))
   (Identity (NonEmpty (SequenceToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
      (Identity
         (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))))
-> NonEmpty (SequenceToLinearRingError a)
-> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# SequenceToLinearRingError a
-> NonEmpty (SequenceToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> SequenceToLinearRingError a
forall a. a -> a -> SequenceToLinearRingError a
FirstNotEqualToLast a
first a
third)
        Seq a
v -> Tagged
  (NonEmpty (SequenceToLinearRingError a))
  (Identity (NonEmpty (SequenceToLinearRingError a)))
-> Tagged
     (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
     (Identity
        (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (SequenceToLinearRingError a))
   (Identity (NonEmpty (SequenceToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))
      (Identity
         (v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a))))
-> NonEmpty (SequenceToLinearRingError a)
-> v (NonEmpty (SequenceToLinearRingError a)) (LinearRing a)
forall t b. AReview t b -> b -> t
# SequenceToLinearRingError a
-> NonEmpty (SequenceToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> SequenceToLinearRingError a
forall a. Int -> SequenceToLinearRingError a
SequenceTooShort (Seq a -> Int
forall a. Seq a -> Int
Sequence.length Seq a
v))
{-# INLINE fromSeq #-}

-- |
-- Creates a LinearRing
-- @makeLinearRing x y z xs@ creates a `LinearRing` homomorphic to the list @[x, y, z] ++ xs@
-- the list @xs@ should NOT contain the first element repeated, i.e the loop does not need to
-- 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 :: a -> a -> a -> Seq a -> LinearRing a
makeLinearRing = a -> a -> a -> Seq a -> LinearRing a
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing

-- instances

instance (Show a) => Show (ListToLinearRingError a) where
    show :: ListToLinearRingError a -> String
show (ListTooShort Int
n) = String
"List too short: (length = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (HeadNotEqualToLast a
h a
l) = String
"head (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") /= last(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance (Show a) => Show (SequenceToLinearRingError a) where
    show :: SequenceToLinearRingError a -> String
show (SequenceTooShort Int
n) = String
"Sequence too short: (length = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    show (FirstNotEqualToLast a
h a
l) = String
"head (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") /= last(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

instance Functor LinearRing where
    fmap :: (a -> b) -> LinearRing a -> LinearRing b
fmap a -> b
f (LinearRing a
x a
y a
z Seq a
ws) = b -> b -> b -> Seq b -> LinearRing b
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing (a -> b
f a
x) (a -> b
f a
y) (a -> b
f a
z) ((a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
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 :: (a -> b -> b) -> b -> LinearRing a -> b
foldr a -> b -> b
f b
u (LinearRing a
x a
y a
z Seq a
ws) = a -> b -> b
f a
x (a -> b -> b
f a
y (a -> b -> b
f a
z ((a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> b -> b
f (a -> b -> b
f a
x b
u) Seq a
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 (f a) -> f (LinearRing a)
sequenceA (LinearRing f a
fx f a
fy f a
fz Seq (f a)
fws) = (a -> a -> a -> Seq a -> LinearRing a
forall a. a -> a -> a -> Seq a -> LinearRing a
LinearRing (a -> a -> a -> Seq a -> LinearRing a)
-> f a -> f (a -> a -> Seq a -> LinearRing a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx f (a -> a -> Seq a -> LinearRing a)
-> f a -> f (a -> Seq a -> LinearRing a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fy f (a -> Seq a -> LinearRing a) -> f a -> f (Seq a -> LinearRing a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fz f (Seq a -> LinearRing a) -> f (Seq a) -> f (LinearRing a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Seq (f a) -> f (Seq a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA Seq (f a)
fws) f (LinearRing a) -> f a -> f (LinearRing a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* f a
fx

instance (ToJSON a) => ToJSON (LinearRing a) where
--  toJSON :: a -> Value
    toJSON :: LinearRing a -> Value
toJSON = [a] -> Value
forall a. ToJSON a => a -> Value
toJSON ([a] -> Value) -> (LinearRing a -> [a]) -> LinearRing a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinearRing a -> [a]
forall a. LinearRing a -> [a]
fromLinearRing

instance (Eq a, FromJSON a, Show a) => FromJSON (LinearRing a) where
--  parseJSON :: Value -> Parser a
    parseJSON :: Value -> Parser (LinearRing a)
parseJSON Value
v = do
        [a]
xs <- Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        let vxs :: Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
vxs = [a]
-> Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall a.
(Eq a, Show a) =>
[a]
-> Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromListAcc [a]
xs
        Parser (LinearRing a)
-> (LinearRing a -> Parser (LinearRing a))
-> Maybe (LinearRing a)
-> Parser (LinearRing a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value
-> Maybe (NonEmpty (ListToLinearRingError a))
-> Parser (LinearRing a)
forall a b.
Show a =>
Value -> Maybe (NonEmpty (ListToLinearRingError a)) -> Parser b
parseError Value
v (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
vxs Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
-> Getting
     (First (NonEmpty (ListToLinearRingError a)))
     (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a))
     (NonEmpty (ListToLinearRingError a))
-> Maybe (NonEmpty (ListToLinearRingError a))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (NonEmpty (ListToLinearRingError a)))
  (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a))
  (NonEmpty (ListToLinearRingError a))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure)) LinearRing a -> Parser (LinearRing a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
vxs Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
-> Getting
     (First (LinearRing a))
     (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a))
     (LinearRing a)
-> Maybe (LinearRing a)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (LinearRing a))
  (Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a))
  (LinearRing a)
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success)

-- helpers

fromListAcc :: (Eq a, Show a) => [a] -> Validation.Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromListAcc :: [a]
-> Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromListAcc = [a]
-> Validation (NonEmpty (ListToLinearRingError a)) (LinearRing a)
forall a (v :: * -> * -> *).
(Eq a, Show a, Validate v,
 Functor (v (NonEmpty (ListToLinearRingError a)))) =>
[a] -> v (NonEmpty (ListToLinearRingError a)) (LinearRing a)
fromList

showErrors :: (Show a) => NonEmpty (ListToLinearRingError a) -> String
showErrors :: NonEmpty (ListToLinearRingError a) -> String
showErrors = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> (NonEmpty (ListToLinearRingError a) -> [String])
-> NonEmpty (ListToLinearRingError a)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NL.toList (NonEmpty String -> [String])
-> (NonEmpty (ListToLinearRingError a) -> NonEmpty String)
-> NonEmpty (ListToLinearRingError a)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListToLinearRingError a -> String)
-> NonEmpty (ListToLinearRingError a) -> NonEmpty String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListToLinearRingError a -> String
forall a. Show a => a -> String
show

parseError :: (Show a) => Value -> Maybe (NonEmpty (ListToLinearRingError a)) -> Parser b
parseError :: Value -> Maybe (NonEmpty (ListToLinearRingError a)) -> Parser b
parseError Value
v = Parser b
-> (NonEmpty (ListToLinearRingError a) -> Parser b)
-> Maybe (NonEmpty (ListToLinearRingError a))
-> Parser b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Parser b
forall (m :: * -> *) a. MonadPlus m => m a
mzero (\NonEmpty (ListToLinearRingError a)
e -> String -> Value -> Parser b
forall a. String -> Value -> Parser a
typeMismatch (NonEmpty (ListToLinearRingError a) -> String
forall a. Show a => NonEmpty (ListToLinearRingError a) -> String
showErrors NonEmpty (ListToLinearRingError a)
e) Value
v)

checkHeadAndLastEq :: (Eq a, Validation.Validate v, Functor (v (NonEmpty (ListToLinearRingError a))))
    => [a]
    -> v (NonEmpty (ListToLinearRingError a)) ()
checkHeadAndLastEq :: [a] -> v (NonEmpty (ListToLinearRingError a)) ()
checkHeadAndLastEq = v (NonEmpty (ListToLinearRingError a)) ()
-> ((a, a) -> v (NonEmpty (ListToLinearRingError a)) ())
-> Maybe (a, a)
-> v (NonEmpty (ListToLinearRingError a)) ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Tagged
  (NonEmpty (ListToLinearRingError a))
  (Identity (NonEmpty (ListToLinearRingError a)))
-> Tagged
     (v (NonEmpty (ListToLinearRingError a)) ())
     (Identity (v (NonEmpty (ListToLinearRingError a)) ()))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (ListToLinearRingError a))
   (Identity (NonEmpty (ListToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (ListToLinearRingError a)) ())
      (Identity (v (NonEmpty (ListToLinearRingError a)) ())))
-> NonEmpty (ListToLinearRingError a)
-> v (NonEmpty (ListToLinearRingError a)) ()
forall t b. AReview t b -> b -> t
# ListToLinearRingError a -> NonEmpty (ListToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ListToLinearRingError a
forall a. Int -> ListToLinearRingError a
ListTooShort Int
0)) (\(a
h, a
l) -> if a
h a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
l then Tagged () (Identity ())
-> Tagged
     (v (NonEmpty (ListToLinearRingError a)) ())
     (Identity (v (NonEmpty (ListToLinearRingError a)) ()))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged () (Identity ())
 -> Tagged
      (v (NonEmpty (ListToLinearRingError a)) ())
      (Identity (v (NonEmpty (ListToLinearRingError a)) ())))
-> () -> v (NonEmpty (ListToLinearRingError a)) ()
forall t b. AReview t b -> b -> t
# () else Tagged
  (NonEmpty (ListToLinearRingError a))
  (Identity (NonEmpty (ListToLinearRingError a)))
-> Tagged
     (v (NonEmpty (ListToLinearRingError a)) ())
     (Identity (v (NonEmpty (ListToLinearRingError a)) ()))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   (NonEmpty (ListToLinearRingError a))
   (Identity (NonEmpty (ListToLinearRingError a)))
 -> Tagged
      (v (NonEmpty (ListToLinearRingError a)) ())
      (Identity (v (NonEmpty (ListToLinearRingError a)) ())))
-> NonEmpty (ListToLinearRingError a)
-> v (NonEmpty (ListToLinearRingError a)) ()
forall t b. AReview t b -> b -> t
# ListToLinearRingError a -> NonEmpty (ListToLinearRingError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a -> ListToLinearRingError a
forall a. a -> a -> ListToLinearRingError a
HeadNotEqualToLast a
h a
l)) (Maybe (a, a) -> v (NonEmpty (ListToLinearRingError a)) ())
-> ([a] -> Maybe (a, a))
-> [a]
-> v (NonEmpty (ListToLinearRingError a)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, a)
forall a. [a] -> Maybe (a, a)
mhl
    where
        mhl ::[a] -> Maybe (a, a)
        mhl :: [a] -> Maybe (a, a)
mhl [a]
xs = (,) (a -> a -> (a, a)) -> Maybe a -> Maybe (a -> (a, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe a
forall a. [a] -> Maybe a
safeHead [a]
xs Maybe (a -> (a, a)) -> Maybe a -> Maybe (a, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a] -> Maybe a
forall a. [a] -> Maybe a
safeLast [a]
xs

safeHead :: [a] -> Maybe a
safeHead :: [a] -> Maybe a
safeHead []    = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

safeLast :: [a] -> Maybe a
safeLast :: [a] -> Maybe a
safeLast []     = Maybe a
forall a. Maybe a
Nothing
safeLast [a
x]    = a -> Maybe a
forall a. a -> Maybe a
Just a
x
safeLast (a
_:[a]
xs) = [a] -> Maybe a
forall a. [a] -> Maybe a
safeLast [a]
xs

fromListDropLast :: (Eq a) => [a] -> Sequence.Seq a
fromListDropLast :: [a] -> Seq a
fromListDropLast []  = Seq a
forall a. Seq a
Sequence.empty
fromListDropLast [a
_] = Seq a
forall a. Seq a
Sequence.empty
fromListDropLast [a]
x   = Seq a -> Seq a
forall a. Seq a -> Seq a
SeqHelper.sequenceHead (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ [a] -> Seq a
forall a. [a] -> Seq a
Sequence.fromList [a]
x