{-# 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
            -- TODO: check if it's okay to have . or if I must always e.
            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
" "

-- Just here for completeness.
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'}

-- Helpers
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