{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}
module Data.WKT.Point (module Data.WKT.Point) where
import Data.WKT.Classes
import Data.Maybe (isJust)
import Data.Attoparsec.Text
( asciiCI,
skipSpace,
double,
parseOnly, Parser )
import Data.WKT.Helpers (zmParser)
import Data.Text (pack, Text)
data Point a = Point{
forall a. Point a -> a
x :: a,
forall a. Point a -> a
y :: a,
forall a. Point a -> Maybe a
z :: Maybe a,
forall a. Point a -> Maybe a
m :: Maybe a
}
deriving (Point a -> Point a -> Bool
(Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool) -> Eq (Point a)
forall a. Eq a => Point a -> Point a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Point a -> Point a -> Bool
== :: Point a -> Point a -> Bool
$c/= :: forall a. Eq a => Point a -> Point a -> Bool
/= :: Point a -> Point a -> Bool
Eq, Eq (Point a)
Eq (Point a) =>
(Point a -> Point a -> Ordering)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Bool)
-> (Point a -> Point a -> Point a)
-> (Point a -> Point a -> Point a)
-> Ord (Point a)
Point a -> Point a -> Bool
Point a -> Point a -> Ordering
Point a -> Point a -> Point a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Point a)
forall a. Ord a => Point a -> Point a -> Bool
forall a. Ord a => Point a -> Point a -> Ordering
forall a. Ord a => Point a -> Point a -> Point a
$ccompare :: forall a. Ord a => Point a -> Point a -> Ordering
compare :: Point a -> Point a -> Ordering
$c< :: forall a. Ord a => Point a -> Point a -> Bool
< :: Point a -> Point a -> Bool
$c<= :: forall a. Ord a => Point a -> Point a -> Bool
<= :: Point a -> Point a -> Bool
$c> :: forall a. Ord a => Point a -> Point a -> Bool
> :: Point a -> Point a -> Bool
$c>= :: forall a. Ord a => Point a -> Point a -> Bool
>= :: Point a -> Point a -> Bool
$cmax :: forall a. Ord a => Point a -> Point a -> Point a
max :: Point a -> Point a -> Point a
$cmin :: forall a. Ord a => Point a -> Point a -> Point a
min :: Point a -> Point a -> Point a
Ord, (forall a b. (a -> b) -> Point a -> Point b)
-> (forall a b. a -> Point b -> Point a) -> Functor Point
forall a b. a -> Point b -> Point a
forall a b. (a -> b) -> Point a -> Point b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Point a -> Point b
fmap :: forall a b. (a -> b) -> Point a -> Point b
$c<$ :: forall a b. a -> Point b -> Point a
<$ :: forall a b. a -> Point b -> Point a
Functor)
instance Show a => Show (Point a) where
show :: Point a -> String
show (Point {a
x :: forall a. Point a -> a
x :: a
x,a
y :: forall a. Point a -> a
y :: a
y,Maybe a
z :: forall a. Point a -> Maybe a
z :: Maybe a
z,Maybe a
m :: forall a. Point a -> Maybe a
m :: Maybe a
m}) = String
pointValue
where
x' :: String
x' = a -> String
forall a. Show a => a -> String
show a
x
y' :: String
y' = a -> String
forall a. Show a => a -> String
show a
y
z' :: String
z' = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) Maybe a
z
m' :: String
m' = String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) Maybe a
m
pointValue :: String
pointValue = String
x' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
y' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
z' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
m'
instance Show a => ToWKT (Point a) where
toWKT :: Point a -> Text
toWKT Point a
point = Text
"Point" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
zmString Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Point a -> String
forall a. Show a => a -> String
show Point a
point) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
where
Point{Maybe a
z :: forall a. Point a -> Maybe a
z :: Maybe a
z,Maybe a
m :: forall a. Point a -> Maybe a
m :: Maybe a
m} = Point a
point
zmString :: Text
zmString
|Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
z Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m = Text
" ZM "
|Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
z = Text
" Z "
|Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m = Text
" M "
|Bool
otherwise = Text
" "
instance Valid (Point a) where
isValid :: Point a -> Bool
isValid (Point {}) = Bool
True
instance FromWKT Point where
fromWKT :: Text -> Point Double
fromWKT = (String -> Point Double)
-> (Point Double -> Point Double)
-> Either String (Point Double)
-> Point Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Point Double
forall a. HasCallStack => String -> a
error (String -> Point Double) -> ShowS -> String -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) Point Double -> Point Double
forall a. a -> a
id (Either String (Point Double) -> Point Double)
-> (Text -> Either String (Point Double)) -> Text -> Point Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Point Double) -> Text -> Either String (Point Double)
forall a. Parser a -> Text -> Either String a
parseOnly Parser (Point Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser
instance ParseableFromWKT Point where
wktParser :: Parser (Point Double)
wktParser = do
Parser ()
skipSpace
Text
_ <- Text -> Parser Text Text
asciiCI Text
"POINT"
(Text
zFlag, Text
mFlag) <- Parser (Text, Text)
zmParser
Text
_ <- Parser Text Text
"("
Text -> Text -> Parser (Point Double)
parsePoint Text
zFlag Text
mFlag
parsePoint :: Text -> Text -> Parser (Point Double)
parsePoint :: Text -> Text -> Parser (Point Double)
parsePoint Text
zFlag Text
mFlag = do
Parser ()
skipSpace
Double
x' <- Parser Double
double
Parser ()
skipSpace
Double
y' <- Parser Double
double
Parser ()
skipSpace
Maybe Double
z' <-
if Text
zFlag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then do
Double
z' <- Parser Double
double
Parser ()
skipSpace
Maybe Double -> Parser Text (Maybe Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> Parser Text (Maybe Double))
-> Maybe Double -> Parser Text (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
z'
else
Maybe Double -> Parser Text (Maybe Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
Maybe Double
m' <-
if Text
mFlag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then do
Double
m' <- Parser Double
double
Parser ()
skipSpace
Maybe Double -> Parser Text (Maybe Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Double -> Parser Text (Maybe Double))
-> Maybe Double -> Parser Text (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Double
forall a. a -> Maybe a
Just Double
m'
else
Maybe Double -> Parser Text (Maybe Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Double
forall a. Maybe a
Nothing
Point Double -> Parser (Point Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Point{x :: Double
x = Double
x',y :: Double
y = Double
y', z :: Maybe Double
z = Maybe Double
z', m :: Maybe Double
m = Maybe Double
m'}
pointDimension :: Point a -> Int
pointDimension :: forall a. Point a -> Int
pointDimension (Point a
_ a
_ Maybe a
z' Maybe a
m')
| Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m' = Int
4
| Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
z' = Int
3
| Bool
otherwise = Int
2