{-|
Module      : H3.Inspection

These functions provide metadata about an H3 index, such as its resolution or base cell, 
and provide utilities for converting into and out of the 64-bit representation of an H3 index.
-}
module H3.Inspection
  ( getResolution
  , getBaseCellNumber
  , stringToH3
  , h3ToString
  , isValidCell
  , isResClassIII
  , isPentagon
  , getIcosahedronFaces
  ) where

import H3.Internal.H3Api 
  ( H3ErrorCodes
  , H3Index
  , c2hs_h3ToString
  , c2hs_stringToH3 )
import H3.Internal.FFI 
  ( getResolution
  , getBaseCellNumber
  , isValidCell
  , isResClassIII
  , isPentagon
  , hsGetIcosahedronFaces )
import H3.Internal.Utils (toEither)

-- |Converts the string representation to the 'H3Index' (Word64) representation.
stringToH3 :: String -> Either H3ErrorCodes H3Index
stringToH3 :: String -> Either H3ErrorCodes H3Index
stringToH3 = (H3Error, H3Index) -> Either H3ErrorCodes H3Index
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, H3Index) -> Either H3ErrorCodes H3Index)
-> (String -> (H3Error, H3Index))
-> String
-> Either H3ErrorCodes H3Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (H3Error, H3Index)
c2hs_stringToH3

-- |Converts the 'H3Index' representation to the string representation.
h3ToString :: H3Index -> Either H3ErrorCodes String
h3ToString :: H3Index -> Either H3ErrorCodes String
h3ToString = (H3Error, String) -> Either H3ErrorCodes String
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, String) -> Either H3ErrorCodes String)
-> (H3Index -> (H3Error, String))
-> H3Index
-> Either H3ErrorCodes String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, String)
c2hs_h3ToString

-- | Return all icosahedron faces intersected by a given H3 index.  Faces are represented as integers from 0-19, inclusive. 
--   The array is sparse, and empty (no intersection) array values are represented by -1.
getIcosahedronFaces :: H3Index -> Either H3ErrorCodes [Int]
getIcosahedronFaces :: H3Index -> Either H3ErrorCodes [Int]
getIcosahedronFaces = (H3Error, [Int]) -> Either H3ErrorCodes [Int]
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, [Int]) -> Either H3ErrorCodes [Int])
-> (H3Index -> (H3Error, [Int]))
-> H3Index
-> Either H3ErrorCodes [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. H3Index -> (H3Error, [Int])
hsGetIcosahedronFaces