{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.LineString (
LineString
, ListToLineStringError(..)
, VectorToLineStringError(..)
, toVector
, combineToVector
, fromVector
, fromLineString
, fromList
, Data.LineString.map
, Data.LineString.foldr
, Data.LineString.foldMap
, makeLineString
, lineStringHead
, lineStringLast
, lineStringLength
) where
import Prelude hiding (foldr)
import Control.Applicative (Applicative (..))
import Control.DeepSeq
import Control.Lens (( # ), (^?))
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..), ToJSON (..), Value)
import Data.Aeson.Types (Parser, typeMismatch)
import Data.Maybe (fromMaybe)
import qualified Data.Validation as Validation
import qualified Data.Vector.Storable as VectorStorable
import GHC.Generics (Generic)
data LineString a = LineString a a (VectorStorable.Vector a) deriving (Eq, Generic, NFData)
data ListToLineStringError =
ListEmpty
| SingletonList
deriving (Eq)
data VectorToLineStringError =
VectorEmpty
| SingletonVector
deriving (Eq)
lineStringHead :: LineString a -> a
lineStringHead (LineString x _ _) = x
lineStringLast :: (VectorStorable.Storable a) => LineString a -> a
lineStringLast (LineString _ x xs) = fromMaybe x (safeLast xs)
lineStringLength :: (VectorStorable.Storable a) => LineString a -> Int
lineStringLength (LineString _ _ xs) = 2 + VectorStorable.length xs
fromLineString :: (VectorStorable.Storable a) => LineString a -> [a]
fromLineString (LineString x y zs) = x : y : VectorStorable.toList zs
fromList :: (Validation.Validate v, VectorStorable.Storable a) => [a] -> v ListToLineStringError (LineString a)
fromList [] = Validation._Failure # ListEmpty
fromList [_] = Validation._Failure # SingletonList
fromList (x:y:zs) = Validation._Success # LineString x y (VectorStorable.fromList zs)
{-# INLINE fromList #-}
combineToVector :: (VectorStorable.Storable a, VectorStorable.Storable b) => (a -> a -> b) -> LineString a -> VectorStorable.Vector b
combineToVector combine (LineString a b rest) = VectorStorable.cons (combine a b) combineRest
where
combineRest =
if VectorStorable.null rest
then
VectorStorable.empty
else
(VectorStorable.zipWith combine <*> VectorStorable.tail) (VectorStorable.cons b rest)
{-# INLINE combineToVector #-}
toVector :: (VectorStorable.Storable a) => LineString a -> VectorStorable.Vector a
toVector (LineString a b rest) = VectorStorable.cons a (VectorStorable.cons b rest)
{-# INLINE toVector #-}
fromVector :: (Validation.Validate v, VectorStorable.Storable a) => VectorStorable.Vector a -> v VectorToLineStringError (LineString a)
fromVector v =
if VectorStorable.null v then
Validation._Failure # VectorEmpty
else
fromVector' (VectorStorable.head v) (VectorStorable.tail v)
{-# INLINE fromVector #-}
fromVector' :: (Validation.Validate v, VectorStorable.Storable a) => a -> VectorStorable.Vector a -> v VectorToLineStringError (LineString a)
fromVector' first v =
if VectorStorable.null v then
Validation._Failure # SingletonVector
else
Validation._Success # LineString first (VectorStorable.head v) (VectorStorable.tail v)
{-# INLINE fromVector' #-}
makeLineString :: (VectorStorable.Storable a) =>
a
-> a
-> VectorStorable.Vector a
-> LineString a
makeLineString = LineString
instance Show ListToLineStringError where
show ListEmpty = "List Empty"
show SingletonList = "Singleton List"
instance Show VectorToLineStringError where
show VectorEmpty = "Vector Empty"
show SingletonVector = "Singleton Vector"
instance (Show a, VectorStorable.Storable a) => Show (LineString a) where
show = show . fromLineString
map :: (VectorStorable.Storable a, VectorStorable.Storable b) => (a -> b) -> LineString a -> LineString b
map f (LineString x y zs) = LineString (f x) (f y) (VectorStorable.map f zs)
{-# INLINE map #-}
foldr :: (VectorStorable.Storable a) => (a -> b -> b) -> b -> LineString a -> b
foldr f u (LineString x y zs) = f x (f y (VectorStorable.foldr f u zs))
{-# INLINE foldr #-}
foldMap :: (Monoid m, VectorStorable.Storable a) => (a -> m) -> LineString a -> m
foldMap f = foldr (mappend . f) mempty
{-# INLINE foldMap #-}
instance (ToJSON a, VectorStorable.Storable a) => ToJSON (LineString a) where
toJSON = toJSON . fromLineString
instance (FromJSON a, Show a, VectorStorable.Storable a) => FromJSON (LineString a) where
parseJSON v = do
xs <- parseJSON v
let vxs = fromListValidated xs
maybe (parseError v (vxs ^? Validation._Failure)) return (vxs ^? Validation._Success)
fromListValidated :: (VectorStorable.Storable a) => [a] -> Validation.Validation ListToLineStringError (LineString a)
fromListValidated = fromList
parseError :: Value -> Maybe ListToLineStringError -> Parser b
parseError v = maybe mzero (\e -> typeMismatch (show e) v)
safeLast :: (VectorStorable.Storable a) => VectorStorable.Vector a -> Maybe a
safeLast x = if VectorStorable.null x then Nothing else Just $ VectorStorable.last x
{-# INLINE safeLast #-}