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