{-|
Module      : H3.Indexing

These functions are used for finding the H3 cell index containing coordinates, 
and for finding the center and boundary of H3 indexes.
-}
module H3.Indexing
  ( latLngToCell
  , cellToLatLng
  , cellToBoundary
  ) where

import H3.Internal.H3Api 
  ( LatLng
  , H3ErrorCodes
  , H3Index
  , c2hs_latLngToCell
  , c2hs_cellToLatLng
  , c2hs_cellToBoundary )
import H3.Internal.Utils (toEither)

-- |Indexes the location at the specified resolution, returning the index of the cell containing the location. 
--  This buckets the geographic point into the H3 grid. 
--  Note that we are directly binding to the C method, which expects Latitude and Longitude in radians. 
--  This differs from the python bindings which expect the coordinates in degrees and perform the necessary conversion 
--  for the user.
latLngToCell :: LatLng -> Int -> Either H3ErrorCodes H3Index
latLngToCell :: LatLng -> Int -> Either H3ErrorCodes H3Index
latLngToCell LatLng
coords = (H3Error, H3Index) -> Either H3ErrorCodes H3Index
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, H3Index) -> Either H3ErrorCodes H3Index)
-> (Int -> (H3Error, H3Index))
-> Int
-> Either H3ErrorCodes H3Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LatLng -> Int -> (H3Error, H3Index)
c2hs_latLngToCell LatLng
coords

-- |Finds the center of the cell in grid space. 
cellToLatLng :: H3Index -> Either H3ErrorCodes LatLng
cellToLatLng :: H3Index -> Either H3ErrorCodes LatLng
cellToLatLng = (H3Error, LatLng) -> Either H3ErrorCodes LatLng
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, LatLng) -> Either H3ErrorCodes LatLng)
-> (H3Index -> (H3Error, LatLng))
-> H3Index
-> Either H3ErrorCodes LatLng
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, LatLng)
c2hs_cellToLatLng

-- |Finds the boundary of the cell, returning a list of coordinates.
cellToBoundary :: H3Index -> Either H3ErrorCodes [LatLng] 
cellToBoundary :: H3Index -> Either H3ErrorCodes [LatLng]
cellToBoundary = (H3Error, [LatLng]) -> Either H3ErrorCodes [LatLng]
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, [LatLng]) -> Either H3ErrorCodes [LatLng])
-> (H3Index -> (H3Error, [LatLng]))
-> H3Index
-> Either H3ErrorCodes [LatLng]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, [LatLng])
c2hs_cellToBoundary