{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveFunctor #-}

module Data.WKT.MultiLineString (module Data.WKT.MultiLineString) where

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

newtype MultiLineString a where
  MultiLineString :: [LineString a] -> MultiLineString a
  deriving ((forall a b. (a -> b) -> MultiLineString a -> MultiLineString b)
-> (forall a b. a -> MultiLineString b -> MultiLineString a)
-> Functor MultiLineString
forall a b. a -> MultiLineString b -> MultiLineString a
forall a b. (a -> b) -> MultiLineString a -> MultiLineString 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) -> MultiLineString a -> MultiLineString b
fmap :: forall a b. (a -> b) -> MultiLineString a -> MultiLineString b
$c<$ :: forall a b. a -> MultiLineString b -> MultiLineString a
<$ :: forall a b. a -> MultiLineString b -> MultiLineString a
Functor, MultiLineString a -> MultiLineString a -> Bool
(MultiLineString a -> MultiLineString a -> Bool)
-> (MultiLineString a -> MultiLineString a -> Bool)
-> Eq (MultiLineString a)
forall a. Eq a => MultiLineString a -> MultiLineString a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MultiLineString a -> MultiLineString a -> Bool
== :: MultiLineString a -> MultiLineString a -> Bool
$c/= :: forall a. Eq a => MultiLineString a -> MultiLineString a -> Bool
/= :: MultiLineString a -> MultiLineString a -> Bool
Eq)

instance Show a => Show (MultiLineString a) where
    show :: MultiLineString a -> String
show (MultiLineString [LineString a]
lineStrings) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
lines'
        where
            lines' :: [String]
lines' = LineString a -> String
forall a. Show a => a -> String
showP (LineString a -> String) -> [LineString a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LineString a]
lineStrings

instance Show a => ToWKT (MultiLineString a) where
    toWKT :: MultiLineString a -> Text
toWKT MultiLineString a
multiLineString = Text
"MultiLineString" 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 (MultiLineString a -> String
forall a. Show a => a -> String
show MultiLineString a
multiLineString) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        where
            (MultiLineString [LineString a]
lineStrings) = MultiLineString a
multiLineString
            (LineString [Point a]
firstLine) = [LineString a] -> LineString a
forall a. HasCallStack => [a] -> a
head [LineString a]
lineStrings
            first :: Point a
first = [Point a] -> Point a
forall a. HasCallStack => [a] -> a
head [Point a]
firstLine
            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 (MultiLineString a) where
    isValid :: MultiLineString a -> Bool
isValid (MultiLineString [LineString a]
lines') = (LineString a -> Bool) -> [LineString a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LineString a -> Bool
forall a. Valid a => a -> Bool
isValid [LineString a]
lines'

instance FromWKT MultiLineString where
    fromWKT :: Text -> MultiLineString Double
fromWKT = (String -> MultiLineString Double)
-> (MultiLineString Double -> MultiLineString Double)
-> Either String (MultiLineString Double)
-> MultiLineString Double
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> MultiLineString Double
forall a. HasCallStack => String -> a
error (String -> MultiLineString Double)
-> ShowS -> String -> MultiLineString Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show) MultiLineString Double -> MultiLineString Double
forall a. a -> a
id (Either String (MultiLineString Double) -> MultiLineString Double)
-> (Text -> Either String (MultiLineString Double))
-> Text
-> MultiLineString Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (MultiLineString Double)
-> Text -> Either String (MultiLineString Double)
forall a. Parser a -> Text -> Either String a
parseOnly Parser (MultiLineString Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser

instance ParseableFromWKT MultiLineString where
    wktParser :: Parser (MultiLineString Double)
wktParser = do
        Parser ()
skipSpace
        Text
_ <- Text -> Parser Text Text
asciiCI Text
"MULTILINESTRING"
        (Text
zFlag, Text
mFlag) <- Parser (Text, Text)
zmParser
        Text
_ <- Parser Text Text
"("
        Text -> Text -> Parser (MultiLineString Double)
parseMultiLineString Text
zFlag Text
mFlag
        
parseMultiLineString :: Text -> Text -> Parser (MultiLineString Double)
parseMultiLineString :: Text -> Text -> Parser (MultiLineString Double)
parseMultiLineString Text
zFlag Text
mFlag = [LineString Double] -> MultiLineString Double
forall a. [LineString a] -> MultiLineString a
MultiLineString ([LineString Double] -> MultiLineString Double)
-> Parser Text [LineString Double]
-> Parser (MultiLineString Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Parser Text [LineString Double]
lineStringParser Text
zFlag Text
mFlag
            where
                lineStringParser :: Text -> Text -> Parser Text [LineString Double]
lineStringParser Text
zFlag' Text
mFlag' = do
                    Parser ()
skipSpace
                    Text
_ <- Parser Text Text
"("
                    LineString Double
newLineString <- Text -> Text -> Parser (LineString Double)
parseLineString 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
                        [LineString Double] -> Parser Text [LineString Double]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return [LineString Double
newLineString]
                    else
                        (LineString Double
newLineString LineString Double -> [LineString Double] -> [LineString Double]
forall a. a -> [a] -> [a]
:) ([LineString Double] -> [LineString Double])
-> Parser Text [LineString Double]
-> Parser Text [LineString Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
"," Parser Text Text
-> Parser Text [LineString Double]
-> Parser Text [LineString 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 [LineString Double]
lineStringParser Text
zFlag' Text
mFlag')