{-|
Module      : H3.Miscellaneous

These methods in this module include 

* general utilities to assist with activities such as unit conversions, and 
* methods for retrieving key information about the H3 indexing system, such as 
  pentagon cell ids, resolution 0 cells, etc.
-}
module H3.Miscellaneous 
  ( degsToRads
  , radsToDegs
  , getRes0Cells
  , getPentagons
  , getHexagonAreaAvgKm2 
  , getHexagonAreaAvgM2 
  , cellAreaRads2
  , cellAreaKm2
  , cellAreaM2
  , getHexagonEdgeLengthAvgKm
  , getHexagonEdgeLengthAvgM
  , edgeLengthRads
  , edgeLengthKm
  , edgeLengthM
  , getNumCells
  , greatCircleDistanceKm
  , greatCircleDistanceM
  , greatCircleDistanceRads
  ) where

import Data.Int (Int64)
import H3.Internal.FFI 
  ( degsToRads
  , radsToDegs
  , hsGetRes0Cells
  , hsGetPentagons )
import H3.Internal.H3Api 
  ( H3ErrorCodes
  , H3Index
  , c2hs_getHexagonAreaAvgKm2 
  , c2hs_getHexagonAreaAvgM2 
  , c2hs_cellAreaRads2
  , c2hs_cellAreaKm2
  , c2hs_cellAreaM2
  , c2hs_getHexagonEdgeLengthAvgKm
  , c2hs_getHexagonEdgeLengthAvgM
  , c2hs_edgeLengthRads
  , c2hs_edgeLengthKm
  , c2hs_edgeLengthM
  , c2hs_getNumCells
  , greatCircleDistanceKm
  , greatCircleDistanceM
  , greatCircleDistanceRads )
import H3.Internal.Utils (toEither)


-- | All the resolution 0 H3 cell indexes. These are the coarsest cells that can be represented 
--   in the H3 system and are the parents of all other cell indexes in the H3 grid system. 
--   The returned indexes correspond with the 122 base cells.
getRes0Cells :: Either H3ErrorCodes [H3Index]
getRes0Cells :: Either H3ErrorCodes [H3Index]
getRes0Cells = (H3Error, [H3Index]) -> Either H3ErrorCodes [H3Index]
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither (H3Error, [H3Index])
hsGetRes0Cells

-- | All the pentagon H3 indexes at the specified resolution.
getPentagons :: Int -> Either H3ErrorCodes [H3Index]
getPentagons :: Int -> Either H3ErrorCodes [H3Index]
getPentagons = (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
. Int -> (H3Error, [H3Index])
hsGetPentagons

-- | Average hexagon area in square kilometers at the given resolution. Excludes pentagons.
getHexagonAreaAvgKm2 :: Int -> Either H3ErrorCodes Double
getHexagonAreaAvgKm2 :: Int -> Either H3ErrorCodes Double
getHexagonAreaAvgKm2 = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (Int -> (H3Error, Double)) -> Int -> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (H3Error, Double)
c2hs_getHexagonAreaAvgKm2 

-- | Average hexagon area in square meters at the given resolution. Excludes pentagons.
getHexagonAreaAvgM2 :: Int -> Either H3ErrorCodes Double
getHexagonAreaAvgM2 :: Int -> Either H3ErrorCodes Double
getHexagonAreaAvgM2 = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (Int -> (H3Error, Double)) -> Int -> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (H3Error, Double)
c2hs_getHexagonAreaAvgM2 

-- | Exact area of specific cell in square radians.
cellAreaRads2 :: H3Index -> Either H3ErrorCodes Double
cellAreaRads2 :: H3Index -> Either H3ErrorCodes Double
cellAreaRads2 = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_cellAreaRads2

-- | Exact area of specific cell in square kilometers.
cellAreaKm2 :: H3Index -> Either H3ErrorCodes Double
cellAreaKm2 :: H3Index -> Either H3ErrorCodes Double
cellAreaKm2 = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_cellAreaKm2

-- | Exact area of specific cell in square meters.
cellAreaM2 :: H3Index -> Either H3ErrorCodes Double
cellAreaM2 :: H3Index -> Either H3ErrorCodes Double
cellAreaM2 = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_cellAreaM2

-- | Average hexagon edge length in kilometers at the given resolution. Excludes pentagons.
getHexagonEdgeLengthAvgKm :: Int -> Either H3ErrorCodes Double
getHexagonEdgeLengthAvgKm :: Int -> Either H3ErrorCodes Double
getHexagonEdgeLengthAvgKm = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (Int -> (H3Error, Double)) -> Int -> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (H3Error, Double)
c2hs_getHexagonEdgeLengthAvgKm

-- | Average hexagon edge length in meters at the given resolution. Excludes pentagons.
getHexagonEdgeLengthAvgM :: Int -> Either H3ErrorCodes Double
getHexagonEdgeLengthAvgM :: Int -> Either H3ErrorCodes Double
getHexagonEdgeLengthAvgM = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (Int -> (H3Error, Double)) -> Int -> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (H3Error, Double)
c2hs_getHexagonEdgeLengthAvgM

-- | Exact edge length of specific unidirectional edge in radians.
edgeLengthRads :: H3Index -> Either H3ErrorCodes Double
edgeLengthRads :: H3Index -> Either H3ErrorCodes Double
edgeLengthRads = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_edgeLengthRads

-- | Exact edge length of specific unidirectional edge in kilometers.
edgeLengthKm :: H3Index -> Either H3ErrorCodes Double
edgeLengthKm :: H3Index -> Either H3ErrorCodes Double
edgeLengthKm = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_edgeLengthKm

-- | Exact edge length of specific unidirectional edge in meters.
edgeLengthM :: H3Index -> Either H3ErrorCodes Double
edgeLengthM :: H3Index -> Either H3ErrorCodes Double
edgeLengthM = (H3Error, Double) -> Either H3ErrorCodes Double
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Double) -> Either H3ErrorCodes Double)
-> (H3Index -> (H3Error, Double))
-> H3Index
-> Either H3ErrorCodes Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, Double)
c2hs_edgeLengthM

-- | Number of unique H3 indexes at the given resolution.
getNumCells :: Int -> Either H3ErrorCodes Int64
getNumCells :: Int -> Either H3ErrorCodes Int64
getNumCells = (H3Error, Int64) -> Either H3ErrorCodes Int64
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, Int64) -> Either H3ErrorCodes Int64)
-> (Int -> (H3Error, Int64)) -> Int -> Either H3ErrorCodes Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (H3Error, Int64)
c2hs_getNumCells