{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE InstanceSigs #-}

module Data.WKT.Geometries (module Data.WKT.Geometries) where

import Data.WKT.Point (Point(..))
import Data.WKT.LineString (LineString(..))
import Data.WKT.Polygon (Polygon(..))
import Data.WKT.MultiPoint (MultiPoint(..))
import Data.WKT.MultiLineString (MultiLineString(..))
import Data.WKT.MultiPolygon (MultiPolygon(..))
import Data.WKT.GeometryCollection (GeometryCollection(..))
import Data.WKT.Classes
import Data.Attoparsec.Text (Parser, atEnd, parseOnly, skipSpace)
import Control.Applicative ((<|>))


-- | All WKT geometries.
data Geometries a = Geometries{
    forall a. Geometries a -> [Point a]
points              :: [Point a],
    forall a. Geometries a -> [LineString a]
lineStrings         :: [LineString a],
    forall a. Geometries a -> [Polygon a]
polygons            :: [Polygon a],
    -- triangles           :: [Triangle a]
    forall a. Geometries a -> [MultiPoint a]
multiPoints         :: [MultiPoint a],
    forall a. Geometries a -> [MultiLineString a]
multiLineString     :: [MultiLineString a],
    forall a. Geometries a -> [MultiPolygon a]
multiPolygon        :: [MultiPolygon a],
    -- tins                :: [TINs a]
    forall a. Geometries a -> [GeometryCollection a]
geometryCollections :: [GeometryCollection a]
}  
    deriving ((forall a b. (a -> b) -> Geometries a -> Geometries b)
-> (forall a b. a -> Geometries b -> Geometries a)
-> Functor Geometries
forall a b. a -> Geometries b -> Geometries a
forall a b. (a -> b) -> Geometries a -> Geometries 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) -> Geometries a -> Geometries b
fmap :: forall a b. (a -> b) -> Geometries a -> Geometries b
$c<$ :: forall a b. a -> Geometries b -> Geometries a
<$ :: forall a b. a -> Geometries b -> Geometries a
Functor)

instance Semigroup (Geometries a) where
    Geometries a
geometry1 <> :: Geometries a -> Geometries a -> Geometries a
<> Geometries a
geometry2 = Geometries{
        points :: [Point a]
points = Geometries a -> [Point a]
forall a. Geometries a -> [Point a]
points Geometries a
geometry1 [Point a] -> [Point a] -> [Point a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [Point a]
forall a. Geometries a -> [Point a]
points Geometries a
geometry2,
        lineStrings :: [LineString a]
lineStrings = Geometries a -> [LineString a]
forall a. Geometries a -> [LineString a]
lineStrings Geometries a
geometry1 [LineString a] -> [LineString a] -> [LineString a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [LineString a]
forall a. Geometries a -> [LineString a]
lineStrings Geometries a
geometry2,
        polygons :: [Polygon a]
polygons = Geometries a -> [Polygon a]
forall a. Geometries a -> [Polygon a]
polygons Geometries a
geometry1 [Polygon a] -> [Polygon a] -> [Polygon a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [Polygon a]
forall a. Geometries a -> [Polygon a]
polygons Geometries a
geometry2,
        -- triangles = triangles geometry1 <> triangles geometry2,
        multiPoints :: [MultiPoint a]
multiPoints = Geometries a -> [MultiPoint a]
forall a. Geometries a -> [MultiPoint a]
multiPoints Geometries a
geometry1 [MultiPoint a] -> [MultiPoint a] -> [MultiPoint a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [MultiPoint a]
forall a. Geometries a -> [MultiPoint a]
multiPoints Geometries a
geometry2,
        multiLineString :: [MultiLineString a]
multiLineString = Geometries a -> [MultiLineString a]
forall a. Geometries a -> [MultiLineString a]
multiLineString Geometries a
geometry1 [MultiLineString a] -> [MultiLineString a] -> [MultiLineString a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [MultiLineString a]
forall a. Geometries a -> [MultiLineString a]
multiLineString Geometries a
geometry2,
        multiPolygon :: [MultiPolygon a]
multiPolygon = Geometries a -> [MultiPolygon a]
forall a. Geometries a -> [MultiPolygon a]
multiPolygon Geometries a
geometry1 [MultiPolygon a] -> [MultiPolygon a] -> [MultiPolygon a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [MultiPolygon a]
forall a. Geometries a -> [MultiPolygon a]
multiPolygon Geometries a
geometry2,
        -- tins = tins geometry1 <> tins geometry2,
        geometryCollections :: [GeometryCollection a]
geometryCollections = Geometries a -> [GeometryCollection a]
forall a. Geometries a -> [GeometryCollection a]
geometryCollections Geometries a
geometry1 [GeometryCollection a]
-> [GeometryCollection a] -> [GeometryCollection a]
forall a. Semigroup a => a -> a -> a
<> Geometries a -> [GeometryCollection a]
forall a. Geometries a -> [GeometryCollection a]
geometryCollections Geometries a
geometry2
    }

instance Monoid (Geometries a) where
    mempty :: Geometries a
mempty = Geometries a
forall a. Geometries a
emptyGeometry

emptyGeometry :: Geometries a
emptyGeometry :: forall a. Geometries a
emptyGeometry = [Point a]
-> [LineString a]
-> [Polygon a]
-> [MultiPoint a]
-> [MultiLineString a]
-> [MultiPolygon a]
-> [GeometryCollection a]
-> Geometries a
forall a.
[Point a]
-> [LineString a]
-> [Polygon a]
-> [MultiPoint a]
-> [MultiLineString a]
-> [MultiPolygon a]
-> [GeometryCollection a]
-> Geometries a
Geometries [] [] [] [] [] [] []

instance Show a => Show (Geometries a) where
    show :: Geometries a -> String
show Geometries a
geometry = 
        String
"points: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Point a] -> String
forall a. Show a => a -> String
show (Geometries a -> [Point a]
forall a. Geometries a -> [Point a]
points Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"lineStrings: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [LineString a] -> String
forall a. Show a => a -> String
show (Geometries a -> [LineString a]
forall a. Geometries a -> [LineString a]
lineStrings Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"polygons: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Polygon a] -> String
forall a. Show a => a -> String
show (Geometries a -> [Polygon a]
forall a. Geometries a -> [Polygon a]
polygons Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        -- "triangles: " <> show (triangles geometry) <> "\n" <>
        String
"multiPoints: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [MultiPoint a] -> String
forall a. Show a => a -> String
show (Geometries a -> [MultiPoint a]
forall a. Geometries a -> [MultiPoint a]
multiPoints Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"multiLineString: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [MultiLineString a] -> String
forall a. Show a => a -> String
show (Geometries a -> [MultiLineString a]
forall a. Geometries a -> [MultiLineString a]
multiLineString Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        String
"multiPolygon: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [MultiPolygon a] -> String
forall a. Show a => a -> String
show (Geometries a -> [MultiPolygon a]
forall a. Geometries a -> [MultiPolygon a]
multiPolygon Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
        -- "TINs: " <> show (tins geometry) <> "\n" <>
        String
"geometryCollections: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [GeometryCollection a] -> String
forall a. Show a => a -> String
show (Geometries a -> [GeometryCollection a]
forall a. Geometries a -> [GeometryCollection a]
geometryCollections Geometries a
geometry) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n"

instance Show a => ToWKT (Geometries a) where
    toWKT :: Geometries a -> Text
toWKT Geometries a
geometry = 
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((Point a -> Text) -> [Point a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text) -> (Point a -> Text) -> Point a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Point a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [Point a]
forall a. Geometries a -> [Point a]
points Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((LineString a -> Text) -> [LineString a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text) -> (LineString a -> Text) -> LineString a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.LineString a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [LineString a]
forall a. Geometries a -> [LineString a]
lineStrings Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((Polygon a -> Text) -> [Polygon a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text) -> (Polygon a -> Text) -> Polygon a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Polygon a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [Polygon a]
forall a. Geometries a -> [Polygon a]
polygons Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        -- foldl (<>) "" (map ((<>"\n").toWKT) (triangles geometry)) <>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((MultiPoint a -> Text) -> [MultiPoint a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text) -> (MultiPoint a -> Text) -> MultiPoint a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MultiPoint a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [MultiPoint a]
forall a. Geometries a -> [MultiPoint a]
multiPoints Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((MultiLineString a -> Text) -> [MultiLineString a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text)
-> (MultiLineString a -> Text) -> MultiLineString a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MultiLineString a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [MultiLineString a]
forall a. Geometries a -> [MultiLineString a]
multiLineString Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((MultiPolygon a -> Text) -> [MultiPolygon a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text)
-> (MultiPolygon a -> Text) -> MultiPolygon a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MultiPolygon a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [MultiPolygon a]
forall a. Geometries a -> [MultiPolygon a]
multiPolygon Geometries a
geometry)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        -- foldl (<>) "" (map ((<>"\n").toWKT) (tins geometry)) <>
        (Text -> Text -> Text) -> Text -> [Text] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ((GeometryCollection a -> Text) -> [GeometryCollection a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n")(Text -> Text)
-> (GeometryCollection a -> Text) -> GeometryCollection a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.GeometryCollection a -> Text
forall a. ToWKT a => a -> Text
toWKT) (Geometries a -> [GeometryCollection a]
forall a. Geometries a -> [GeometryCollection a]
geometryCollections Geometries a
geometry))

instance Eq a => Valid (Geometries a) where
    isValid :: Geometries a -> Bool
isValid Geometries a
geometry = 
        (Point a -> Bool) -> [Point a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [Point a]
forall a. Geometries a -> [Point a]
points Geometries a
geometry) Bool -> Bool -> Bool
&&
        (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 (Geometries a -> [LineString a]
forall a. Geometries a -> [LineString a]
lineStrings Geometries a
geometry) Bool -> Bool -> Bool
&&
        (Polygon a -> Bool) -> [Polygon a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Polygon a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [Polygon a]
forall a. Geometries a -> [Polygon a]
polygons Geometries a
geometry) Bool -> Bool -> Bool
&&
        -- all isValid (triangles geometry) &&
        (MultiPoint a -> Bool) -> [MultiPoint a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MultiPoint a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [MultiPoint a]
forall a. Geometries a -> [MultiPoint a]
multiPoints Geometries a
geometry) Bool -> Bool -> Bool
&&
        (MultiLineString a -> Bool) -> [MultiLineString a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MultiLineString a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [MultiLineString a]
forall a. Geometries a -> [MultiLineString a]
multiLineString Geometries a
geometry) Bool -> Bool -> Bool
&&
        (MultiPolygon a -> Bool) -> [MultiPolygon a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all MultiPolygon a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [MultiPolygon a]
forall a. Geometries a -> [MultiPolygon a]
multiPolygon Geometries a
geometry) Bool -> Bool -> Bool
&&
        -- all isValid (tins geometry) &&
        (GeometryCollection a -> Bool) -> [GeometryCollection a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GeometryCollection a -> Bool
forall a. Valid a => a -> Bool
isValid (Geometries a -> [GeometryCollection a]
forall a. Geometries a -> [GeometryCollection a]
geometryCollections Geometries a
geometry)

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

instance ParseableFromWKT Geometries where
    wktParser :: Parser (Geometries Double)
    wktParser :: Parser (Geometries Double)
wktParser = do
        Parser ()
skipSpace
        Bool
atEnd' <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd
        if Bool
atEnd' then Geometries Double -> Parser (Geometries Double)
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return Geometries Double
forall a. Geometries a
emptyGeometry else do
            Geometries Double
parsedValue <-  Parser (Geometries Double)
pointParser Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
lineStringParser  Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
polygonParser Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
multiPointParser Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
multiLineStringParser Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
multiPolygonParser Parser (Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
                            Parser (Geometries Double)
geometryCollectionParser
            (Geometries Double -> Geometries Double -> Geometries Double
forall a. Semigroup a => a -> a -> a
<> Geometries Double
parsedValue) (Geometries Double -> Geometries Double)
-> Parser (Geometries Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Geometries Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser

        where
            pointParser :: Parser (Geometries Double)
pointParser = (\Point Double
p -> Geometries Double
forall a. Geometries a
emptyGeometry{points = [p]}) (Point Double -> Geometries Double)
-> Parser Text (Point Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (Point Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (Point Double))
            lineStringParser :: Parser (Geometries Double)
lineStringParser = (\LineString Double
l -> Geometries Double
forall a. Geometries a
emptyGeometry{lineStrings = [l]}) (LineString Double -> Geometries Double)
-> Parser Text (LineString Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (LineString Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (LineString Double))
            polygonParser :: Parser (Geometries Double)
polygonParser = (\Polygon Double
p -> Geometries Double
forall a. Geometries a
emptyGeometry{polygons = [p]}) (Polygon Double -> Geometries Double)
-> Parser Text (Polygon Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (Polygon Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (Polygon Double))
            multiPointParser :: Parser (Geometries Double)
multiPointParser = (\MultiPoint Double
mp -> Geometries Double
forall a. Geometries a
emptyGeometry{multiPoints = [mp]}) (MultiPoint Double -> Geometries Double)
-> Parser Text (MultiPoint Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (MultiPoint Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (MultiPoint Double))
            multiLineStringParser :: Parser (Geometries Double)
multiLineStringParser = (\MultiLineString Double
ml -> Geometries Double
forall a. Geometries a
emptyGeometry{multiLineString = [ml]}) (MultiLineString Double -> Geometries Double)
-> Parser Text (MultiLineString Double)
-> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (MultiLineString Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (MultiLineString Double))
            multiPolygonParser :: Parser (Geometries Double)
multiPolygonParser = (\MultiPolygon Double
mp -> Geometries Double
forall a. Geometries a
emptyGeometry{multiPolygon = [mp]}) (MultiPolygon Double -> Geometries Double)
-> Parser Text (MultiPolygon Double) -> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (MultiPolygon Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (MultiPolygon Double))
            geometryCollectionParser :: Parser (Geometries Double)
geometryCollectionParser = (\GeometryCollection Double
gc -> Geometries Double
forall a. Geometries a
emptyGeometry{geometryCollections = [gc]}) (GeometryCollection Double -> Geometries Double)
-> Parser Text (GeometryCollection Double)
-> Parser (Geometries Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text (GeometryCollection Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (GeometryCollection Double))