{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE NoImplicitPrelude #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.LineString
-- 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#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)

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)

import qualified Data.SeqHelper      as SeqHelper

-- |
-- a LineString has at least 2 elements
--
data LineString a = LineString a a (Sequence.Seq a) deriving (LineString a -> LineString a -> Bool
(LineString a -> LineString a -> Bool)
-> (LineString a -> LineString a -> Bool) -> Eq (LineString a)
forall a. Eq a => LineString a -> LineString a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineString a -> LineString a -> Bool
$c/= :: forall a. Eq a => LineString a -> LineString a -> Bool
== :: LineString a -> LineString a -> Bool
$c== :: forall a. Eq a => LineString a -> LineString a -> Bool
Eq, (forall x. LineString a -> Rep (LineString a) x)
-> (forall x. Rep (LineString a) x -> LineString a)
-> Generic (LineString a)
forall x. Rep (LineString a) x -> LineString a
forall x. LineString a -> Rep (LineString a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LineString a) x -> LineString a
forall a x. LineString a -> Rep (LineString a) x
$cto :: forall a x. Rep (LineString a) x -> LineString a
$cfrom :: forall a x. LineString a -> Rep (LineString a) x
Generic, LineString a -> ()
(LineString a -> ()) -> NFData (LineString a)
forall a. NFData a => LineString a -> ()
forall a. (a -> ()) -> NFData a
rnf :: LineString a -> ()
$crnf :: forall a. NFData a => LineString a -> ()
NFData)

-- |
-- When converting a List to a LineString, here is a list of things that can go wrong:
--
--     * The list was empty
--     * The list only had one element
--
data ListToLineStringError =
        ListEmpty
    |   SingletonList
    deriving (ListToLineStringError -> ListToLineStringError -> Bool
(ListToLineStringError -> ListToLineStringError -> Bool)
-> (ListToLineStringError -> ListToLineStringError -> Bool)
-> Eq ListToLineStringError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListToLineStringError -> ListToLineStringError -> Bool
$c/= :: ListToLineStringError -> ListToLineStringError -> Bool
== :: ListToLineStringError -> ListToLineStringError -> Bool
$c== :: ListToLineStringError -> ListToLineStringError -> Bool
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 (SequenceToLineStringError -> SequenceToLineStringError -> Bool
(SequenceToLineStringError -> SequenceToLineStringError -> Bool)
-> (SequenceToLineStringError -> SequenceToLineStringError -> Bool)
-> Eq SequenceToLineStringError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SequenceToLineStringError -> SequenceToLineStringError -> Bool
$c/= :: SequenceToLineStringError -> SequenceToLineStringError -> Bool
== :: SequenceToLineStringError -> SequenceToLineStringError -> Bool
$c== :: SequenceToLineStringError -> SequenceToLineStringError -> Bool
Eq)

-- functions

-- |
-- returns the element at the head of the string
--
lineStringHead :: LineString a -> a
lineStringHead :: LineString a -> a
lineStringHead (LineString a
x a
_ Seq a
_) = a
x

-- |
-- returns the last element in the string
--
lineStringLast :: LineString a -> a
lineStringLast :: LineString a -> a
lineStringLast (LineString a
_ a
x Seq a
xs) = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Seq a -> Maybe a
forall a. Seq a -> Maybe a
safeLast Seq a
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 a -> Int
lineStringLength (LineString a
_ a
_ Seq a
xs) = Int
2 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.
--
fromLineString :: LineString a -> [a]
fromLineString :: LineString a -> [a]
fromLineString (LineString a
x a
y Seq a
zs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq a
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 :: [a] -> v ListToLineStringError (LineString a)
fromList []       = Tagged ListToLineStringError (Identity ListToLineStringError)
-> Tagged
     (v ListToLineStringError (LineString a))
     (Identity (v ListToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged ListToLineStringError (Identity ListToLineStringError)
 -> Tagged
      (v ListToLineStringError (LineString a))
      (Identity (v ListToLineStringError (LineString a))))
-> ListToLineStringError -> v ListToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# ListToLineStringError
ListEmpty
fromList [a
_]      = Tagged ListToLineStringError (Identity ListToLineStringError)
-> Tagged
     (v ListToLineStringError (LineString a))
     (Identity (v ListToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged ListToLineStringError (Identity ListToLineStringError)
 -> Tagged
      (v ListToLineStringError (LineString a))
      (Identity (v ListToLineStringError (LineString a))))
-> ListToLineStringError -> v ListToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# ListToLineStringError
SingletonList
fromList (a
x:a
y:[a]
zs) = Tagged (LineString a) (Identity (LineString a))
-> Tagged
     (v ListToLineStringError (LineString a))
     (Identity (v ListToLineStringError (LineString a)))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged (LineString a) (Identity (LineString a))
 -> Tagged
      (v ListToLineStringError (LineString a))
      (Identity (v ListToLineStringError (LineString a))))
-> LineString a -> v ListToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# a -> a -> Seq a -> LineString a
forall a. a -> a -> Seq a -> LineString a
LineString a
x a
y ([a] -> Seq a
forall a. [a] -> Seq a
Sequence.fromList [a]
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 :: (a -> a -> b) -> LineString a -> Seq b
combineToSeq a -> a -> b
combine (LineString a
a a
b Seq a
rest) = a -> a -> b
combine a
a a
b 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
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
Sequence.<| Seq a
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 -> Seq a
toSeq (LineString a
a a
b 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.<| Seq a
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 :: Seq a -> v SequenceToLineStringError (LineString a)
fromSeq v :: Seq a
v@(a
headS Sequence.:<| Seq a
tailS) =
  if Seq a -> Bool
forall a. Seq a -> Bool
Sequence.null Seq a
v then
    Tagged
  SequenceToLineStringError (Identity SequenceToLineStringError)
-> Tagged
     (v SequenceToLineStringError (LineString a))
     (Identity (v SequenceToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   SequenceToLineStringError (Identity SequenceToLineStringError)
 -> Tagged
      (v SequenceToLineStringError (LineString a))
      (Identity (v SequenceToLineStringError (LineString a))))
-> SequenceToLineStringError
-> v SequenceToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# SequenceToLineStringError
SingletonSequence
  else
    a -> Seq a -> v SequenceToLineStringError (LineString a)
forall (v :: * -> * -> *) a.
Validate v =>
a -> Seq a -> v SequenceToLineStringError (LineString a)
fromSeq' a
headS Seq a
tailS
fromSeq Seq a
_ = Tagged
  SequenceToLineStringError (Identity SequenceToLineStringError)
-> Tagged
     (v SequenceToLineStringError (LineString a))
     (Identity (v SequenceToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   SequenceToLineStringError (Identity SequenceToLineStringError)
 -> Tagged
      (v SequenceToLineStringError (LineString a))
      (Identity (v SequenceToLineStringError (LineString a))))
-> SequenceToLineStringError
-> v SequenceToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# SequenceToLineStringError
SequenceEmpty
{-# INLINE fromSeq #-}

fromSeq' :: (Validation.Validate v) => a -> Sequence.Seq a -> v SequenceToLineStringError (LineString a)
fromSeq' :: a -> Seq a -> v SequenceToLineStringError (LineString a)
fromSeq' a
first v :: Seq a
v@(a
headS Sequence.:<| Seq a
tailS) =
  if Seq a -> Bool
forall a. Seq a -> Bool
Sequence.null Seq a
v then
    Tagged
  SequenceToLineStringError (Identity SequenceToLineStringError)
-> Tagged
     (v SequenceToLineStringError (LineString a))
     (Identity (v SequenceToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   SequenceToLineStringError (Identity SequenceToLineStringError)
 -> Tagged
      (v SequenceToLineStringError (LineString a))
      (Identity (v SequenceToLineStringError (LineString a))))
-> SequenceToLineStringError
-> v SequenceToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# SequenceToLineStringError
SingletonSequence
  else
    Tagged (LineString a) (Identity (LineString a))
-> Tagged
     (v SequenceToLineStringError (LineString a))
     (Identity (v SequenceToLineStringError (LineString a)))
forall (f :: * -> * -> *) e a b.
Validate f =>
Prism (f e a) (f e b) a b
Validation._Success (Tagged (LineString a) (Identity (LineString a))
 -> Tagged
      (v SequenceToLineStringError (LineString a))
      (Identity (v SequenceToLineStringError (LineString a))))
-> LineString a -> v SequenceToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# a -> a -> Seq a -> LineString a
forall a. a -> a -> Seq a -> LineString a
LineString a
first a
headS Seq a
tailS
fromSeq' a
_ Seq a
_ = Tagged
  SequenceToLineStringError (Identity SequenceToLineStringError)
-> Tagged
     (v SequenceToLineStringError (LineString a))
     (Identity (v SequenceToLineStringError (LineString a)))
forall (f :: * -> * -> *) e1 a e2.
Validate f =>
Prism (f e1 a) (f e2 a) e1 e2
Validation._Failure (Tagged
   SequenceToLineStringError (Identity SequenceToLineStringError)
 -> Tagged
      (v SequenceToLineStringError (LineString a))
      (Identity (v SequenceToLineStringError (LineString a))))
-> SequenceToLineStringError
-> v SequenceToLineStringError (LineString a)
forall t b. AReview t b -> b -> t
# SequenceToLineStringError
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
makeLineString :: a -> a -> Seq a -> LineString a
makeLineString = a -> a -> Seq a -> LineString a
forall a. a -> a -> Seq a -> LineString a
LineString

-- instances

instance Show ListToLineStringError where
    show :: ListToLineStringError -> String
show ListToLineStringError
ListEmpty     = String
"List Empty"
    show ListToLineStringError
SingletonList = String
"Singleton List"

instance Show SequenceToLineStringError where
  show :: SequenceToLineStringError -> String
show SequenceToLineStringError
SequenceEmpty     = String
"Sequence Empty"
  show SequenceToLineStringError
SingletonSequence = String
"Singleton Sequence"

instance (Show a) => Show (LineString a) where
    show :: LineString a -> String
show  = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (LineString a -> [a]) -> LineString a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LineString a -> [a]
forall a. LineString a -> [a]
fromLineString

instance Functor LineString where
    fmap :: (a -> b) -> LineString a -> LineString b
fmap a -> b
f (LineString a
x a
y Seq a
zs) = b -> b -> Seq b -> LineString b
forall a. a -> a -> Seq a -> LineString a
LineString (a -> b
f a
x) (a -> b
f a
y) ((a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Seq a
zs)

-- | This will run through the line string.
--
instance Foldable LineString where
    --  foldr :: (a -> b -> b) -> b -> LineString a -> b
    foldr :: (a -> b -> b) -> b -> LineString a -> b
foldr a -> b -> b
f b
u (LineString a
x a
y Seq a
zs) = a -> b -> b
f a
x (a -> b -> b
f a
y ((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 b
u Seq a
zs))

instance Traversable LineString where
    --  sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
    sequenceA :: LineString (f a) -> f (LineString a)
sequenceA (LineString f a
fx f a
fy Seq (f a)
fzs) = a -> a -> Seq a -> LineString a
forall a. a -> a -> Seq a -> LineString a
LineString (a -> a -> Seq a -> LineString a)
-> f a -> f (a -> Seq a -> LineString a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fx f (a -> Seq a -> LineString a) -> f a -> f (Seq a -> LineString a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
fy f (Seq a -> LineString a) -> f (Seq a) -> f (LineString 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)
fzs

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

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

-- helpers

fromListValidated :: [a] -> Validation.Validation ListToLineStringError (LineString a)
fromListValidated :: [a] -> Validation ListToLineStringError (LineString a)
fromListValidated = [a] -> Validation ListToLineStringError (LineString a)
forall (v :: * -> * -> *) a.
Validate v =>
[a] -> v ListToLineStringError (LineString a)
fromList

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

-- safeLast :: (Sequence.Seq a) => Sequence.Seq a -> Maybe a
-- safeLast x = if Sequence.null x then Nothing else Just $ Sequence.last x
safeLast :: Sequence.Seq a -> Maybe a
safeLast :: Seq a -> Maybe a
safeLast Seq a
x = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
Sequence.viewr Seq a
x of
                ViewR a
Sequence.EmptyR -> Maybe a
forall a. Maybe a
Nothing
                Seq a
_ Sequence.:> a
b -> a -> Maybe a
forall a. a -> Maybe a
Just a
b
{-# INLINE safeLast #-}