{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}

-------------------------------------------------------------------

-- |
-- Module       : Data.LineString
-- 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 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 (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 ::
  -- | The first element
  a ->
  -- | The second element
  a ->
  -- | The rest of the optional elements
  Sequence.Seq a ->
  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 #-}