{-|
Module      : H3.Hierarchy

These functions permit moving between resolutions in the H3 grid system. 
The functions produce parent cells (coarser), or child cells (finer).
-}
module H3.Hierarchy
  ( cellToParent 
  , cellToCenterChild 
  , cellToChildPos
  , childPosToCell
  , cellToChildren
  , compactCells
  , uncompactCells
  ) where

import Data.Int (Int64)
import H3.Internal.H3Api 
  ( H3ErrorCodes
  , H3Index
  , c2hs_cellToParent
  , c2hs_cellToCenterChild
  , c2hs_cellToChildPos
  , c2hs_childPosToCell 
  )
import H3.Internal.FFI 
  ( hsCellToChildren
  , hsCompactCells 
  , hsUncompactCells
  )
import H3.Internal.Utils (toEither)


-- | Provides the parent index containing @cell@
cellToParent :: H3Index -- ^ cell
             -> Int     -- ^ parentRes 
             -> Either H3ErrorCodes H3Index
cellToParent :: H3Index -> Int -> Either H3ErrorCodes H3Index
cellToParent H3Index
cell = (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
. H3Index -> Int -> (H3Error, H3Index)
c2hs_cellToParent H3Index
cell

-- | Provides the center child index contained by @cell@ at resolution @childRes@.
cellToCenterChild :: H3Index -- ^ cell
                  -> Int     -- ^ childRes
                  -> Either H3ErrorCodes H3Index
cellToCenterChild :: H3Index -> Int -> Either H3ErrorCodes H3Index
cellToCenterChild H3Index
cell = (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
. H3Index -> Int -> (H3Error, H3Index)
c2hs_cellToCenterChild H3Index
cell

-- | Returns the position of the child cell within an ordered list of all children of the 
--   cell's parent at the specified resolution @parentRes@. 
--   The order of the ordered list is the same as that returned by 'cellToChildren'. 
--   This is the complement of 'childPosToCell'.
cellToChildPos :: H3Index -- ^ child
               -> Int     -- ^ parentRes
               -> Either H3ErrorCodes Int64
cellToChildPos :: H3Index -> Int -> Either H3ErrorCodes Int64
cellToChildPos H3Index
child = (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
. H3Index -> Int -> (H3Error, Int64)
c2hs_cellToChildPos H3Index
child

-- | Returns the child cell at a given position within an ordered list of all children of @parent@
--   at the specified resolution @childRes@. 
--   The order of the ordered list is the same as that returned by 'cellToChildren'. 
--   This is the complement of 'cellToChildPos'.
childPosToCell :: Int64   -- ^ childPos
               -> H3Index -- ^ parent
               -> Int     -- ^ childRes
               -> Either H3ErrorCodes H3Index
childPosToCell :: Int64 -> H3Index -> Int -> Either H3ErrorCodes H3Index
childPosToCell Int64
childPos H3Index
parent = (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
. Int64 -> H3Index -> Int -> (H3Error, H3Index)
c2hs_childPosToCell Int64
childPos H3Index
parent 

-- | Returns children with the indexes contained by @cell@ at resolution @childRes@.
cellToChildren :: H3Index -- ^ cell
               -> Int     -- ^ childRes
               -> Either H3ErrorCodes [H3Index]
cellToChildren :: H3Index -> Int -> Either H3ErrorCodes [H3Index]
cellToChildren H3Index
cell = (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
. H3Index -> Int -> (H3Error, [H3Index])
hsCellToChildren H3Index
cell

-- | Compacts the set @cellSet@ of indexes as best as possible.  
--   Cells in @cellSet@ must all share the same resolution.
compactCells :: [H3Index] -- ^ cellSet
             -> Either H3ErrorCodes [H3Index]
compactCells :: [H3Index] -> Either H3ErrorCodes [H3Index]
compactCells  = (H3Error, [H3Index]) -> Either H3ErrorCodes [H3Index]
forall a. (H3Error, a) -> Either H3ErrorCodes a
toEither ((H3Error, [H3Index]) -> Either H3ErrorCodes [H3Index])
-> ([H3Index] -> (H3Error, [H3Index]))
-> [H3Index]
-> Either H3ErrorCodes [H3Index]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [H3Index] -> (H3Error, [H3Index])
hsCompactCells 

-- | Uncompacts the set @compactedSet@ of indexes to the resolution @res@
uncompactCells :: [H3Index] -- ^ compactedSet
               -> Int       -- ^ res
               -> Either H3ErrorCodes [H3Index]
uncompactCells :: [H3Index] -> Int -> Either H3ErrorCodes [H3Index]
uncompactCells [H3Index]
compactedSet = (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
. [H3Index] -> Int -> (H3Error, [H3Index])
hsUncompactCells [H3Index]
compactedSet