{-# LANGUAGE DeriveAnyClass  #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE TemplateHaskell #-}
-------------------------------------------------------------------
-- |
-- Module       : Data.Geospatial.Internal.Geometry.GeoMultiLine
-- Copyright    : (C) 2014-2019 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           Data.Geospatial.Internal.BasicTypes
import           Data.Geospatial.Internal.Geometry.Aeson
import           Data.Geospatial.Internal.Geometry.GeoLine
import           Data.LineString

import           Control.DeepSeq
import           Control.Lens                              (makeLenses)
import           Control.Monad                             (mzero)
import           Data.Aeson                                (FromJSON (..),
                                                            ToJSON (..),
                                                            Value (..))
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