module Data.Internal.Wkt.Box
  ( box ) where

import qualified Data.Geospatial         as Geospatial
import qualified Text.Trifecta           as Trifecta

import qualified Data.Internal.Wkt.Line  as Line
import qualified Data.Internal.Wkt.Point as Point

box :: Trifecta.Parser Geospatial.BoundingBoxWithoutCRS
box :: Parser BoundingBoxWithoutCRS
box = do
  String
_ <- String -> Parser String
forall (m :: * -> *). CharParsing m => String -> m String
Trifecta.string String
"box"
  ()
_ <- Parser ()
forall (m :: * -> *). CharParsing m => m ()
Trifecta.spaces
  ()
_ <- Parser ()
forall (m :: * -> *). CharParsing m => m ()
Trifecta.spaces Parser () -> Parser Char -> Parser Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Trifecta.char Char
'(' Parser Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall (m :: * -> *). CharParsing m => m ()
Trifecta.spaces
  (Geospatial.GeoPointXY PointXY
first) <- Parser GeoPositionWithoutCRS
Point.justPointsXY
  (Geospatial.GeoPointXY PointXY
second) <- Parser GeoPositionWithoutCRS -> Parser GeoPositionWithoutCRS
Line.commandPoint Parser GeoPositionWithoutCRS
Point.justPointsXY
  ()
_ <- Char -> Parser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Trifecta.char Char
')' Parser Char -> Parser () -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
forall (m :: * -> *). CharParsing m => m ()
Trifecta.spaces
  BoundingBoxWithoutCRS -> Parser BoundingBoxWithoutCRS
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoundingBoxWithoutCRS -> Parser BoundingBoxWithoutCRS)
-> BoundingBoxWithoutCRS -> Parser BoundingBoxWithoutCRS
forall a b. (a -> b) -> a -> b
$ PointXY -> PointXY -> BoundingBoxWithoutCRS
Geospatial.BoundingBoxWithoutCRSXY PointXY
first PointXY
second