{-# LANGUAGE DeriveFunctor #-}

module Data.WKT.Primitives (module Data.WKT.Primitives) where

import Data.WKT.Classes
import Data.WKT.Point
import Data.WKT.LineString
import Data.WKT.Polygon
import Data.WKT.Triangle
import Data.Attoparsec.Text (parseOnly, skipSpace, Parser)
import Control.Applicative ((<|>))


data Primitives a = PrimPoint (Point a)| PrimLine (LineString a)| PrimPolygon (Polygon a)| PrimTriangle (Triangle a)
    deriving ((forall a b. (a -> b) -> Primitives a -> Primitives b)
-> (forall a b. a -> Primitives b -> Primitives a)
-> Functor Primitives
forall a b. a -> Primitives b -> Primitives a
forall a b. (a -> b) -> Primitives a -> Primitives 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) -> Primitives a -> Primitives b
fmap :: forall a b. (a -> b) -> Primitives a -> Primitives b
$c<$ :: forall a b. a -> Primitives b -> Primitives a
<$ :: forall a b. a -> Primitives b -> Primitives a
Functor, Primitives a -> Primitives a -> Bool
(Primitives a -> Primitives a -> Bool)
-> (Primitives a -> Primitives a -> Bool) -> Eq (Primitives a)
forall a. Eq a => Primitives a -> Primitives a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Primitives a -> Primitives a -> Bool
== :: Primitives a -> Primitives a -> Bool
$c/= :: forall a. Eq a => Primitives a -> Primitives a -> Bool
/= :: Primitives a -> Primitives a -> Bool
Eq)

instance Show a => Show (Primitives a) where
    show :: Primitives a -> String
show (PrimPoint Point a
a)    = Point a -> String
forall a. Show a => a -> String
show Point a
a
    show (PrimLine LineString a
a)     = LineString a -> String
forall a. Show a => a -> String
show LineString a
a
    show (PrimPolygon Polygon a
a)  = Polygon a -> String
forall a. Show a => a -> String
show Polygon a
a
    show (PrimTriangle Triangle a
a) = Triangle a -> String
forall a. Show a => a -> String
show Triangle a
a

instance Show a => ToWKT (Primitives a) where
    toWKT :: Primitives a -> Text
toWKT (PrimPoint Point a
a)    = Point a -> Text
forall a. ToWKT a => a -> Text
toWKT Point a
a
    toWKT (PrimLine LineString a
a)     = LineString a -> Text
forall a. ToWKT a => a -> Text
toWKT LineString a
a
    toWKT (PrimPolygon Polygon a
a)  = Polygon a -> Text
forall a. ToWKT a => a -> Text
toWKT Polygon a
a
    toWKT (PrimTriangle Triangle a
a) = Triangle a -> Text
forall a. ToWKT a => a -> Text
toWKT Triangle a
a

instance Eq a => Valid (Primitives a) where
    isValid :: Primitives a -> Bool
isValid (PrimPoint Point a
a)    = Point a -> Bool
forall a. Valid a => a -> Bool
isValid Point a
a
    isValid (PrimLine LineString a
a)     = LineString a -> Bool
forall a. Valid a => a -> Bool
isValid LineString a
a
    isValid (PrimPolygon Polygon a
a)  = Polygon a -> Bool
forall a. Valid a => a -> Bool
isValid Polygon a
a
    isValid (PrimTriangle Triangle a
a) = Triangle a -> Bool
forall a. Valid a => a -> Bool
isValid Triangle a
a

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

instance ParseableFromWKT Primitives where
    wktParser :: Parser (Primitives Double)
wktParser = do
        Parser ()
skipSpace
        Point Double -> Primitives Double
forall a. Point a -> Primitives a
PrimPoint (Point Double -> Primitives Double)
-> Parser Text (Point Double) -> Parser (Primitives Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Point Double)
pointWktParser Parser (Primitives Double)
-> Parser (Primitives Double) -> Parser (Primitives Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LineString Double -> Primitives Double
forall a. LineString a -> Primitives a
PrimLine (LineString Double -> Primitives Double)
-> Parser Text (LineString Double) -> Parser (Primitives Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (LineString Double)
lineStringParser Parser (Primitives Double)
-> Parser (Primitives Double) -> Parser (Primitives Double)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Polygon Double -> Primitives Double
forall a. Polygon a -> Primitives a
PrimPolygon (Polygon Double -> Primitives Double)
-> Parser Text (Polygon Double) -> Parser (Primitives Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Polygon Double)
polygonParser -- <|> PrimTriangle <$> triangleParser
            where
                pointWktParser :: Parser Text (Point Double)
pointWktParser = Parser Text (Point Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (Point Double)
                lineStringParser :: Parser Text (LineString Double)
lineStringParser = Parser Text (LineString Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (LineString Double)
                polygonParser :: Parser Text (Polygon Double)
polygonParser = Parser Text (Polygon Double)
forall (a :: * -> *). ParseableFromWKT a => Parser (a Double)
wktParser :: Parser (Polygon Double)
                -- triangleParser = wktParser :: Parser (Triangle Double)