{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}

-------------------------------------------------------------------

-- |
-- Module       : Data.Geospatial.Internal.Geometry.GeoMultiLine
-- Copyright    : (C) 2014-2021 HS-GeoJSON Project
-- License      : BSD-style (see the file LICENSE.md)
-- Maintainer   : Andrew Newman
module Data.Geospatial.Internal.Geometry.GeoMultiLine
  ( -- * Type
    GeoMultiLine (..),

    -- * Lenses
    unGeoMultiLine,

    -- * To Points
    splitGeoMultiLine,
    mergeGeoLines,
  )
where

import Control.DeepSeq
import Control.Lens (makeLenses)
import Control.Monad (mzero)
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
  )
import Data.Geospatial.Internal.BasicTypes
import Data.Geospatial.Internal.Geometry.Aeson
import Data.Geospatial.Internal.Geometry.GeoLine
import Data.LineString
import qualified Data.Sequence as Sequence
import GHC.Generics (Generic)

newtype GeoMultiLine = GeoMultiLine {GeoMultiLine -> Seq (LineString GeoPositionWithoutCRS)
_unGeoMultiLine :: Sequence.Seq (LineString GeoPositionWithoutCRS)} deriving (Int -> GeoMultiLine -> ShowS
[GeoMultiLine] -> ShowS
GeoMultiLine -> String
(Int -> GeoMultiLine -> ShowS)
-> (GeoMultiLine -> String)
-> ([GeoMultiLine] -> ShowS)
-> Show GeoMultiLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeoMultiLine] -> ShowS
$cshowList :: [GeoMultiLine] -> ShowS
show :: GeoMultiLine -> String
$cshow :: GeoMultiLine -> String
showsPrec :: Int -> GeoMultiLine -> ShowS
$cshowsPrec :: Int -> GeoMultiLine -> ShowS
Show, GeoMultiLine -> GeoMultiLine -> Bool
(GeoMultiLine -> GeoMultiLine -> Bool)
-> (GeoMultiLine -> GeoMultiLine -> Bool) -> Eq GeoMultiLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeoMultiLine -> GeoMultiLine -> Bool
$c/= :: GeoMultiLine -> GeoMultiLine -> Bool
== :: GeoMultiLine -> GeoMultiLine -> Bool
$c== :: GeoMultiLine -> GeoMultiLine -> Bool
Eq, (forall x. GeoMultiLine -> Rep GeoMultiLine x)
-> (forall x. Rep GeoMultiLine x -> GeoMultiLine)
-> Generic GeoMultiLine
forall x. Rep GeoMultiLine x -> GeoMultiLine
forall x. GeoMultiLine -> Rep GeoMultiLine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeoMultiLine x -> GeoMultiLine
$cfrom :: forall x. GeoMultiLine -> Rep GeoMultiLine x
Generic, GeoMultiLine -> ()
(GeoMultiLine -> ()) -> NFData GeoMultiLine
forall a. (a -> ()) -> NFData a
rnf :: GeoMultiLine -> ()
$crnf :: GeoMultiLine -> ()
NFData)

makeLenses ''GeoMultiLine

-- | Split GeoMultiLine coordinates into multiple GeoLines
splitGeoMultiLine :: GeoMultiLine -> Sequence.Seq GeoLine
splitGeoMultiLine :: GeoMultiLine -> Seq GeoLine
splitGeoMultiLine = (LineString GeoPositionWithoutCRS -> GeoLine)
-> Seq (LineString GeoPositionWithoutCRS) -> Seq GeoLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LineString GeoPositionWithoutCRS -> GeoLine
GeoLine (Seq (LineString GeoPositionWithoutCRS) -> Seq GeoLine)
-> (GeoMultiLine -> Seq (LineString GeoPositionWithoutCRS))
-> GeoMultiLine
-> Seq GeoLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoMultiLine -> Seq (LineString GeoPositionWithoutCRS)
_unGeoMultiLine

-- | Merge multiple GeoLines into one GeoMultiLine
mergeGeoLines :: Sequence.Seq GeoLine -> GeoMultiLine
mergeGeoLines :: Seq GeoLine -> GeoMultiLine
mergeGeoLines = Seq (LineString GeoPositionWithoutCRS) -> GeoMultiLine
GeoMultiLine (Seq (LineString GeoPositionWithoutCRS) -> GeoMultiLine)
-> (Seq GeoLine -> Seq (LineString GeoPositionWithoutCRS))
-> Seq GeoLine
-> GeoMultiLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GeoLine -> LineString GeoPositionWithoutCRS)
-> Seq GeoLine -> Seq (LineString GeoPositionWithoutCRS)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GeoLine -> LineString GeoPositionWithoutCRS
_unGeoLine

-- instances

instance ToJSON GeoMultiLine where
  --  toJSON :: a -> Value
  toJSON :: GeoMultiLine -> Value
toJSON = String -> Seq (LineString GeoPositionWithoutCRS) -> Value
forall a. ToJSON a => String -> a -> Value
makeGeometryGeoAeson String
"MultiLineString" (Seq (LineString GeoPositionWithoutCRS) -> Value)
-> (GeoMultiLine -> Seq (LineString GeoPositionWithoutCRS))
-> GeoMultiLine
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoMultiLine -> Seq (LineString GeoPositionWithoutCRS)
_unGeoMultiLine

instance FromJSON GeoMultiLine where
  --  parseJSON :: Value -> Parser a
  parseJSON :: Value -> Parser GeoMultiLine
parseJSON (Object Object
o) = String
-> (Seq (LineString GeoPositionWithoutCRS) -> GeoMultiLine)
-> Object
-> Parser GeoMultiLine
forall a b.
(FromJSON a, FromJSON b) =>
String -> (a -> b) -> Object -> Parser b
readGeometryGeoAeson String
"MultiLineString" Seq (LineString GeoPositionWithoutCRS) -> GeoMultiLine
GeoMultiLine Object
o
  parseJSON Value
_ = Parser GeoMultiLine
forall (m :: * -> *) a. MonadPlus m => m a
mzero