{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveFunctor #-}

module Data.WKT.LineString (module Data.WKT.LineString) where

import Data.WKT.Classes
import Data.WKT.Point (Point(..), parsePoint, pointDimension)
import Data.List (intercalate)
import Data.WKT.Helpers (generateZMString, zmParser)
import Data.Text (pack, Text)
import Data.Attoparsec.Text
    ( asciiCI,
      skipSpace,
      parseOnly, Parser )
import Control.Applicative ((<|>))

newtype LineString a = LineString [Point 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
$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
/= :: LineString a -> LineString a -> Bool
Eq, (forall a b. (a -> b) -> LineString a -> LineString b)
-> (forall a b. a -> LineString b -> LineString a)
-> Functor LineString
forall a b. a -> LineString b -> LineString a
forall a b. (a -> b) -> LineString a -> LineString 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) -> LineString a -> LineString b
fmap :: forall a b. (a -> b) -> LineString a -> LineString b
$c<$ :: forall a b. a -> LineString b -> LineString a
<$ :: forall a b. a -> LineString b -> LineString a
Functor)
instance Show a => Show (LineString a) where
    show :: LineString a -> String
show (LineString [Point a]
line) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (Point a -> String
forall a. Show a => a -> String
show (Point a -> String) -> [Point a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
line)

instance Show a => ToWKT (LineString a) where
    toWKT :: LineString a -> Text
toWKT LineString a
lineString
        | [Point a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Point a]
line = Text
"EMPTY"
        | Bool
otherwise = Text
"LineString" 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 (LineString a -> String
forall a. Show a => a -> String
show LineString a
lineString) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        where
            LineString [Point a]
line = LineString a
lineString
            first :: Point a
first = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head [Point a]
line
            z' :: Maybe a
z' = Point a -> Maybe a
forall a. Point a -> Maybe a
z Point a
first
            m' :: Maybe a
m' = Point a -> Maybe a
forall a. Point a -> Maybe a
m Point a
first

            zmString :: Text
zmString = Maybe a -> Maybe a -> Text
forall a. Maybe a -> Maybe a -> Text
generateZMString Maybe a
z' Maybe a
m'

instance Valid (LineString a) where
    isValid :: LineString a -> Bool
isValid (LineString []) = Bool
True
    isValid (LineString (Point a
fpoint:[Point a]
tpoints)) = (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
fpointDimension) [Int]
tpointDimensions
        where
            fpointDimension :: Int
fpointDimension = Point a -> Int
forall a. Point a -> Int
pointDimension Point a
fpoint
            tpointDimensions :: [Int]
tpointDimensions = Point a -> Int
forall a. Point a -> Int
pointDimension (Point a -> Int) -> [Point a] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point a]
tpoints

instance FromWKT LineString where
    fromWKT :: Text -> LineString Double
fromWKT = (String -> LineString Double)
-> (LineString Double -> LineString Double)
-> Either String (LineString Double)
-> LineString Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> LineString Double
forall a. HasCallStack => String -> a
error (String -> LineString Double)
-> ShowS -> String -> LineString Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) LineString Double -> LineString Double
forall a. a -> a
id (Either String (LineString Double) -> LineString Double)
-> (Text -> Either String (LineString Double))
-> Text
-> LineString Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (LineString Double)
-> Text -> Either String (LineString Double)
forall a. Parser a -> Text -> Either String a
parseOnly Parser (LineString Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser
instance ParseableFromWKT LineString where
    wktParser :: Parser (LineString Double)
wktParser = do
        Parser ()
skipSpace
        Text
_ <- Text -> Parser Text Text
asciiCI Text
"LINESTRING"
        (Text
zFlag, Text
mFlag) <- Parser (Text, Text)
zmParser
        Text
_ <- Parser Text Text
"("
        Text -> Text -> Parser (LineString Double)
parseLineString Text
zFlag Text
mFlag

parseLineString :: Text -> Text -> Parser (LineString Double)
parseLineString :: Text -> Text -> Parser (LineString Double)
parseLineString Text
zFlag Text
mFlag = [Point Double] -> LineString Double
forall a. [Point a] -> LineString a
LineString ([Point Double] -> LineString Double)
-> Parser Text [Point Double] -> Parser (LineString Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Parser Text [Point Double]
pointsParser Text
zFlag Text
mFlag
    where
        pointsParser :: Text -> Text -> Parser Text [Point Double]
pointsParser Text
zFlag' Text
mFlag' = do
            Parser ()
skipSpace
            Point Double
newPoint <- Text -> Text -> Parser (Point Double)
parsePoint Text
zFlag' Text
mFlag'        
            Parser ()
skipSpace            
            Text
closing <- Parser Text Text
")" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
""
            if Text
closing Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"" then
                [Point Double] -> Parser Text [Point Double]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [Point Double
newPoint]
            else
                (Point Double
newPoint Point Double -> [Point Double] -> [Point Double]
forall a. a -> [a] -> [a]
:) ([Point Double] -> [Point Double])
-> Parser Text [Point Double] -> Parser Text [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"," Parser Text Text
-> Parser Text [Point Double] -> Parser Text [Point Double]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Text -> Parser Text [Point Double]
pointsParser Text
zFlag' Text
mFlag')