{-# 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')