{-|
Module      : H3.Regions

These functions convert H3 indexes to and from polygonal areas.
-}
module H3.Regions
  ( polygonToCells
  , cellsToLinkedMultiPolygon
  ) where

import Data.Word (Word32)
import H3.Internal.H3Api 
  ( H3ErrorCodes
  , H3Index
  , GeoPolygon
  , hsCellsToLinkedMultiPolygon 
  )
import H3.Internal.FFI 
  ( hsPolygonToCells 
  )
import H3.Internal.Utils (toEither)

-- | @polygonToCells@ takes a given GeoJSON-like 'GeoPolygon' data structure and fills it with the hexagons that are contained in the 'GeoPolygon'.  
--   Containment is determined by the cells' centroids. 
--   An argument for @flags@ is provided, which is reserved for future functionality, and should be taken to be 0 here.
polygonToCells :: GeoPolygon -- ^ geoPolygon
               -> Int        -- ^ res
               -> Word32     -- ^ flags
               -> Either H3ErrorCodes [H3Index]
polygonToCells :: GeoPolygon -> Int -> Word32 -> Either H3ErrorCodes [H3Index]
polygonToCells GeoPolygon
poly Int
res = (Word32, [H3Index]) -> Either H3ErrorCodes [H3Index]
forall a. (Word32, a) -> Either H3ErrorCodes a
toEither ((Word32, [H3Index]) -> Either H3ErrorCodes [H3Index])
-> (Word32 -> (Word32, [H3Index]))
-> Word32
-> Either H3ErrorCodes [H3Index]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GeoPolygon -> Int -> Word32 -> (Word32, [H3Index])
hsPolygonToCells GeoPolygon
poly Int
res

-- | Creates 'GeoPolygon' describing the outline(s) of a set of hexagons. 
--   Polygon outlines will have one outer loop and a list of loops representing holes.  
--   It is expected that all hexagons in the set have the same resolution and that the set contains no duplicates. 
--   Behavior is undefined if duplicates or multiple resolutions are present, and the algorithm may produce unexpected or invalid output.
cellsToLinkedMultiPolygon :: [H3Index] -> Either H3ErrorCodes [GeoPolygon]
cellsToLinkedMultiPolygon :: [H3Index] -> Either H3ErrorCodes [GeoPolygon]
cellsToLinkedMultiPolygon = (Word32, [GeoPolygon]) -> Either H3ErrorCodes [GeoPolygon]
forall a. (Word32, a) -> Either H3ErrorCodes a
toEither ((Word32, [GeoPolygon]) -> Either H3ErrorCodes [GeoPolygon])
-> ([H3Index] -> (Word32, [GeoPolygon]))
-> [H3Index]
-> Either H3ErrorCodes [GeoPolygon]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [H3Index] -> (Word32, [GeoPolygon])
hsCellsToLinkedMultiPolygon