{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Vega.VegaLite.Geometry
( geometry
, geoFeatureCollection
, geometryCollection
, Geometry(..)
, sphere
, graticule
, GraticuleProperty(..)
, projection
, ProjectionProperty(..)
, Projection(..)
, ClipRect(..)
, projectionProperty
) where
import qualified Data.Aeson as A
import qualified Data.Text as T
import Control.Arrow (second)
import Data.Aeson ((.=), object, toJSON)
import Data.Aeson.Types (Pair)
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Graphics.Vega.VegaLite.Data
( DataValue
, dataValueSpec
)
import Graphics.Vega.VegaLite.Foundation
( fromT
, toObject
)
import Graphics.Vega.VegaLite.Specification
( VLProperty(VLData, VLProjection)
, VLSpec
, PropertySpec
)
import Graphics.Vega.VegaLite.Input
( Data
)
type_ :: T.Text -> Pair
type_ :: Text -> Pair
type_ Text
t = Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t
geoFeatureCollection :: [VLSpec] -> VLSpec
geoFeatureCollection :: [Value] -> Value
geoFeatureCollection [Value]
geoms =
[Pair] -> Value
object [ Text -> Pair
type_ Text
"FeatureCollection"
, Key
"features" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Value]
geoms
]
geometryCollection :: [VLSpec] -> VLSpec
geometryCollection :: [Value] -> Value
geometryCollection [Value]
geoms =
[Pair] -> Value
object [ Text -> Pair
type_ Text
"GeometryCollection"
, Key
"geometries" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Value]
geoms
]
data Projection
= Albers
| AlbersUsa
| AzimuthalEqualArea
| AzimuthalEquidistant
| ConicConformal
| ConicEqualArea
| ConicEquidistant
| Custom T.Text
| EqualEarth
| Equirectangular
| Gnomonic
| Identity
| Mercator
| NaturalEarth1
| Orthographic
| Stereographic
| TransverseMercator
projectionLabel :: Projection -> T.Text
projectionLabel :: Projection -> Text
projectionLabel Projection
Albers = Text
"albers"
projectionLabel Projection
AlbersUsa = Text
"albersUsa"
projectionLabel Projection
AzimuthalEqualArea = Text
"azimuthalEqualArea"
projectionLabel Projection
AzimuthalEquidistant = Text
"azimuthalEquidistant"
projectionLabel Projection
ConicConformal = Text
"conicConformal"
projectionLabel Projection
ConicEqualArea = Text
"conicEqualarea"
projectionLabel Projection
ConicEquidistant = Text
"conicEquidistant"
projectionLabel (Custom Text
pName) = Text
pName
projectionLabel Projection
EqualEarth = Text
"equalEarth"
projectionLabel Projection
Equirectangular = Text
"equirectangular"
projectionLabel Projection
Gnomonic = Text
"gnomonic"
projectionLabel Projection
Identity = Text
"identity"
projectionLabel Projection
Mercator = Text
"mercator"
projectionLabel Projection
NaturalEarth1 = Text
"naturalEarth1"
projectionLabel Projection
Orthographic = Text
"orthographic"
projectionLabel Projection
Stereographic = Text
"stereographic"
projectionLabel Projection
TransverseMercator = Text
"transverseMercator"
data ClipRect
= NoClip
| LTRB Double Double Double Double
data ProjectionProperty
= PrType Projection
| PrClipAngle (Maybe Double)
| PrClipExtent ClipRect
| PrCenter Double Double
| PrScale Double
| PrTranslate Double Double
| PrRotate Double Double Double
| PrPrecision Double
| PrReflectX Bool
| PrReflectY Bool
| PrCoefficient Double
| PrDistance Double
| PrFraction Double
| PrLobes Int
| PrParallel Double
| PrRadius Double
| PrRatio Double
| PrSpacing Double
| PrTilt Double
projectionProperty :: ProjectionProperty -> Pair
projectionProperty :: ProjectionProperty -> Pair
projectionProperty (PrType Projection
proj) = Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Projection -> Text
projectionLabel Projection
proj
projectionProperty (PrClipAngle Maybe Double
numOrNull) = Key
"clipAngle" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
A.Null forall a. ToJSON a => a -> Value
toJSON Maybe Double
numOrNull
projectionProperty (PrClipExtent ClipRect
rClip) =
(Key
"clipExtent", case ClipRect
rClip of
ClipRect
NoClip -> Value
A.Null
LTRB Double
l Double
t Double
r Double
b -> forall a. ToJSON a => a -> Value
toJSON (forall a b. (a -> b) -> [a] -> [b]
map forall a. ToJSON a => a -> Value
toJSON [Double
l, Double
t, Double
r, Double
b])
)
projectionProperty (PrCenter Double
lon Double
lat) = Key
"center" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
lon, Double
lat]
projectionProperty (PrScale Double
sc) = Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
sc
projectionProperty (PrTranslate Double
tx Double
ty) = Key
"translate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
tx, Double
ty]
projectionProperty (PrRotate Double
lambda Double
phi Double
gamma) = Key
"rotate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
lambda, Double
phi, Double
gamma]
projectionProperty (PrPrecision Double
pr) = Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
pr
projectionProperty (PrReflectX Bool
b) = Key
"reflectX" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
projectionProperty (PrReflectY Bool
b) = Key
"reflectY" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
projectionProperty (PrCoefficient Double
x) = Key
"coefficient" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrDistance Double
x) = Key
"distance" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrFraction Double
x) = Key
"fraction" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrLobes Int
n) = Key
"lobes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
projectionProperty (PrParallel Double
x) = Key
"parallel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrRadius Double
x) = Key
"radius" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrRatio Double
x) = Key
"ratio" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrSpacing Double
x) = Key
"spacing" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projectionProperty (PrTilt Double
x) = Key
"tilt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
projection :: [ProjectionProperty] -> PropertySpec
projection :: [ProjectionProperty] -> PropertySpec
projection [ProjectionProperty]
pProps = (VLProperty
VLProjection, [Pair] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map ProjectionProperty -> Pair
projectionProperty [ProjectionProperty]
pProps))
data Geometry
= GeoPoint Double Double
| GeoPoints [(Double, Double)]
| GeoLine [(Double, Double)]
| GeoLines [[(Double, Double)]]
| GeoPolygon [[(Double, Double)]]
| GeoPolygons [[[(Double, Double)]]]
geometry :: Geometry -> [(T.Text, DataValue)] -> VLSpec
geometry :: Geometry -> [(Text, DataValue)] -> Value
geometry Geometry
gType [(Text, DataValue)]
properties =
[Pair] -> Value
object ([ (Key
"type", Text -> Value
fromT Text
"Feature")
, (Key
"geometry", Geometry -> Value
geometryTypeSpec Geometry
gType) ]
forall a. Semigroup a => a -> a -> a
<> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, DataValue)]
properties
then []
else [(Key
"properties",
[LabelledSpec] -> Value
toObject (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second DataValue -> Value
dataValueSpec) [(Text, DataValue)]
properties))]
)
geometryTypeSpec :: Geometry -> VLSpec
geometryTypeSpec :: Geometry -> Value
geometryTypeSpec Geometry
gType =
let toCoords :: [(Double, Double)] -> VLSpec
toCoords :: [(Double, Double)] -> Value
toCoords = forall a. ToJSON a => a -> Value
toJSON
toCoordList :: [[(Double, Double)]] -> VLSpec
toCoordList :: [[(Double, Double)]] -> Value
toCoordList = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [(Double, Double)] -> Value
toCoords
(Value
ptype, Value
cs) = case Geometry
gType of
GeoPoint Double
x Double
y -> (Value
"Point", forall a. ToJSON a => a -> Value
toJSON [Double
x, Double
y])
GeoPoints [(Double, Double)]
coords -> (Value
"MultiPoint", [(Double, Double)] -> Value
toCoords [(Double, Double)]
coords)
GeoLine [(Double, Double)]
coords -> (Value
"LineString", [(Double, Double)] -> Value
toCoords [(Double, Double)]
coords)
GeoLines [[(Double, Double)]]
coords -> (Value
"MultiLineString", [[(Double, Double)]] -> Value
toCoordList [[(Double, Double)]]
coords)
GeoPolygon [[(Double, Double)]]
coords -> (Value
"Polygon", [[(Double, Double)]] -> Value
toCoordList [[(Double, Double)]]
coords)
GeoPolygons [[[(Double, Double)]]]
ccoords -> (Value
"MultiPolygon", forall a. ToJSON a => a -> Value
toJSON (forall a b. (a -> b) -> [a] -> [b]
map [[(Double, Double)]] -> Value
toCoordList [[[(Double, Double)]]]
ccoords))
in [Pair] -> Value
object [(Key
"type", Value
ptype), (Key
"coordinates", Value
cs)]
sphere :: Data
sphere :: PropertySpec
sphere = (VLProperty
VLData, [Pair] -> Value
object [Key
"sphere" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True])
graticule ::
[GraticuleProperty]
-> Data
graticule :: [GraticuleProperty] -> PropertySpec
graticule [] = (VLProperty
VLData, [Pair] -> Value
object [Key
"graticule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True])
graticule [GraticuleProperty]
grProps =
(VLProperty
VLData, [Pair] -> Value
object [Key
"graticule" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object (forall a b. (a -> b) -> [a] -> [b]
map GraticuleProperty -> Pair
graticuleProperty [GraticuleProperty]
grProps)])
data GraticuleProperty
= GrExtent (Double, Double) (Double, Double)
| GrExtentMajor (Double, Double) (Double, Double)
| GrExtentMinor (Double, Double) (Double, Double)
| GrStep (Double, Double)
| GrStepMajor (Double, Double)
| GrStepMinor (Double, Double)
| GrPrecision Double
graticuleProperty :: GraticuleProperty -> Pair
graticuleProperty :: GraticuleProperty -> Pair
graticuleProperty (GrExtent (Double
lng1, Double
lat1) (Double
lng2, Double
lat2)) =
Key
"extent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [[Double
lng1, Double
lat1], [Double
lng2, Double
lat2]]
graticuleProperty (GrExtentMajor (Double
lng1, Double
lat1) (Double
lng2, Double
lat2)) =
Key
"extentMajor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [[Double
lng1, Double
lat1], [Double
lng2, Double
lat2]]
graticuleProperty (GrExtentMinor (Double
lng1, Double
lat1) (Double
lng2, Double
lat2)) =
Key
"extentMinor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [[Double
lng1, Double
lat1], [Double
lng2, Double
lat2]]
graticuleProperty (GrStep (Double
lng, Double
lat)) = Key
"step" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
lng, Double
lat]
graticuleProperty (GrStepMajor (Double
lng, Double
lat)) = Key
"stepMajor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
lng, Double
lat]
graticuleProperty (GrStepMinor (Double
lng, Double
lat)) = Key
"stepMinor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double
lng, Double
lat]
graticuleProperty (GrPrecision Double
x) = Key
"precision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x