-- GENERATED by C->Haskell Compiler, version 0.26.2 Budburst, 26 October 2015 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Data/Grib/Raw/Nearest.chs" #-}
{- |
Module      : Data.Grib.Raw.Nearest
Copyright   : (c) Mattias Jakobsson 2015
License     : GPL-3

Maintainer  : mjakob422@gmail.com
Stability   : unstable
Portability : portable

Find the nearest grid points of an arbitrary point.

Most of the documentation herein was copied from the official
documentation of
<https://software.ecmwf.int/wiki/display/GRIB/Module+Index grib_api>.
-}

module Data.Grib.Raw.Nearest
       ( -- *The GRIB Nearest Iterator
         GribNearest(..)
       , gribNearestNew
       , gribNearestFind
       , gribNearestFindMultiple
       , gribNearestDelete
       , withGribNearest

         -- **Nearest flags
       , GribNearestFlag(..)
       ) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Control.Exception ( bracket )
import Foreign           ( Ptr, Storable, alloca, allocaArray, fromBool
                         , peekArray, with, withArray, withMany )
import Foreign.C         ( CSize )

-- Hack to have Applicative in base < 4.8 but avoid warning in base >= 4.8:
import Control.Applicative
import Prelude

import Data.Grib.Raw.Handle
{-# LINE 39 "src/Data/Grib/Raw/Nearest.chs" #-}

import Data.Grib.Raw.Marshal





{-# LINE 45 "src/Data/Grib/Raw/Nearest.chs" #-}


-- typedef struct grib_nearest grib_nearest;
--
-- Unlike grib_iterator and grib_keys_iterator, grib_nearest doesn't
-- seem to hold a reference to the grib_handle.  To keep the api
-- consistent, however, it is still treated analogous to those two
-- data types, i.e., no foreign pointer is used.
--
-- |Grib nearest, structure used to find the nearest points of a
-- latitude longitude point.
newtype GribNearest = GribNearest (C2HSImp.Ptr (GribNearest)) deriving (Eq, Show)

-- |Filter flags for 'GribNearest'.
data GribNearestFlag = GribNearestSameGrid
                     | GribNearestSameData
                     | GribNearestSamePoint
  deriving (Eq,Show)
instance Enum GribNearestFlag where
  succ GribNearestSameGrid = GribNearestSameData
  succ GribNearestSameData = GribNearestSamePoint
  succ GribNearestSamePoint = error "GribNearestFlag.succ: GribNearestSamePoint has no successor"

  pred GribNearestSameData = GribNearestSameGrid
  pred GribNearestSamePoint = GribNearestSameData
  pred GribNearestSameGrid = error "GribNearestFlag.pred: GribNearestSameGrid has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from GribNearestSamePoint

  fromEnum GribNearestSameGrid = 1
  fromEnum GribNearestSameData = 2
  fromEnum GribNearestSamePoint = 4

  toEnum 1 = GribNearestSameGrid
  toEnum 2 = GribNearestSameData
  toEnum 4 = GribNearestSamePoint
  toEnum unmatched = error ("GribNearestFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 63 "src/Data/Grib/Raw/Nearest.chs" #-}


-- grib_nearest* grib_nearest_new(grib_handle* h, int* error);
--
-- |Create a new nearest from a handle, using current geometry.
--
-- The returned object needs to be manually deleted with
-- 'gribNearestDelete'.  This is handled automatically by
-- 'withGribNearest'.
gribNearestNew :: (GribHandle) -> IO ((GribNearest))
gribNearestNew a1 =
  (withGribHandle) a1 $ \a1' -> 
  alloca $ \a2' -> 
  gribNearestNew'_ a1' a2' >>= \res ->
  let {res' = id res} in
  checkStatusPtr  a2'>>
  return (res')

{-# LINE 75 "src/Data/Grib/Raw/Nearest.chs" #-}


-- int grib_nearest_find(grib_nearest *nearest, grib_handle* h, double inlat,
--                       double inlon, unsigned long flags, double* outlats,
--                       double* outlons, double* values, double* distances,
--                       int* indexes, size_t *len);
--
-- |Find the 4 nearest points of a latitude longitude point.
--
-- The flags are provided to speed up the process of searching. If you
-- are sure that the point you are asking for is not changing from a
-- call to another you can use GRIB_NEAREST_SAME_POINT. The same is
-- valid for the grid. Flags can be used together doing a bitwise
-- OR. The distances are given in kilometres.
gribNearestFind :: (GribNearest) -> (GribHandle) -> (Double) -> (Double) -> ([GribNearestFlag]) -> IO (([Double]), ([Double]), ([Double]), ([Double]), ([Int]))
gribNearestFind a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  (withGribHandle) a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  let {a4' = realToFrac a4} in 
  let {a5' = fromFlagList a5} in 
  allocaArray4 $ \a6' -> 
  allocaArray4 $ \a7' -> 
  allocaArray4 $ \a8' -> 
  allocaArray4 $ \a9' -> 
  allocaArray4 $ \a10' -> 
  with4 $ \a11' -> 
  gribNearestFind'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' >>= \res ->
  checkStatus res >> 
  peekRealArray4  a6'>>= \a6'' -> 
  peekRealArray4  a7'>>= \a7'' -> 
  peekRealArray4  a8'>>= \a8'' -> 
  peekRealArray4  a9'>>= \a9'' -> 
  peekIntegralArray4  a10'>>= \a10'' -> 
  return (a6'', a7'', a8'', a9'', a10'')

{-# LINE 101 "src/Data/Grib/Raw/Nearest.chs" #-}

  where allocaArray4 :: Storable a => (Ptr a -> IO b) -> IO b
        allocaArray4       = allocaArray 4
        peekIntegralArray4 = peekIntegralArray 4
        peekRealArray4     = peekRealArray 4
        with4              = with 4

-- int grib_nearest_delete(grib_nearest *nearest);
--
-- |Frees an nearest from memory.
gribNearestDelete :: (GribNearest) -> IO ((()))
gribNearestDelete a1 =
  let {a1' = id a1} in 
  gribNearestDelete'_ a1' >>= \res ->
  checkStatus res >>= \res' ->
  return (res')

{-# LINE 111 "src/Data/Grib/Raw/Nearest.chs" #-}


-- int grib_nearest_find_multiple(grib_handle* h, int is_lsm, double* inlats,
--                                double* inlons, long npoints, double* outlats,
--                                double* outlons, double* values,
--                                double* distances, int* indexes);
--
-- This function is not macro expanded since the length of the output
-- arguments depend on the length of the input arguments.
--
-- |Find the nearest point of a set of points whose latitudes and
-- longitudes are given in the inlats, inlons arrays respectively.
--
-- If the flag is_lsm is 1 the nearest land point is returned and the
-- grib passed as handle (h) is considered a land sea mask. The land
-- nearest point is the nearest point with land sea mask
-- value>=0.5. If no nearest land points are found the nearest value
-- is returned. If the flag is_lsm is 0 the nearest point is
-- returned. values, distances, indexes (in the "values" array) for
-- the nearest points (ilons,ilats) are returned.
gribNearestFindMultiple :: GribHandle
                        -- ^handle from which geography and data
                        -- values are taken
                        -> Bool
                        -- ^lsm flag (@True@ -> nearest land, @False@
                        -- -> nearest)
                        -> [Double]
                        -- ^latitudes of the points to search for
                        -> [Double]
                        -- ^longitudes of the points to search for
                        -> IO ([Double], [Double], [Double], [Double], [Int])
                        -- ^an IO action that will return a tuple
                        -- @(latitudes, longitudes, values, distances,
                        -- indices)@
gribNearestFindMultiple h lsm ilats ilons =
  let lsm' = fromBool lsm
      n    = min (length ilats) (length ilons)
      n'   = fromIntegral n in
  withGribHandle h                     $ \h'                          ->
  withArray (map realToFrac ilats)     $ \ilats'                      ->
  withArray (map realToFrac ilons)     $ \ilons'                      ->
  withMany allocaArray (replicate 4 n) $ \[olats, olons, vals, dists] ->
  allocaArray n                        $ \is                          -> do
    cCall h' lsm' ilats' ilons' n' olats olons vals dists is >>= checkStatus
    pack5 <$> fmap (map realToFrac)   (peekArray n olats)
          <*> fmap (map realToFrac)   (peekArray n olons)
          <*> fmap (map realToFrac)   (peekArray n vals)
          <*> fmap (map realToFrac)   (peekArray n dists)
          <*> fmap (map fromIntegral) (peekArray n is)
  where cCall = grib_nearest_find_multiple
{-# LINE 160 "src/Data/Grib/Raw/Nearest.chs" #-}


-- |Safely create, use and delete a 'GribNearest'.
--
-- This function is an easy alternative over using 'gribNearestNew'
-- and 'gribNearestDelete' directly.
withGribNearest :: GribHandle -> (GribNearest -> IO a) -> IO a
withGribNearest h = bracket (gribNearestNew h) gribNearestDelete

foreign import ccall unsafe "Data/Grib/Raw/Nearest.chs.h grib_nearest_new"
  gribNearestNew'_ :: ((C2HSImp.Ptr (GribHandle)) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (GribNearest))))

foreign import ccall unsafe "Data/Grib/Raw/Nearest.chs.h grib_nearest_find"
  gribNearestFind'_ :: ((GribNearest) -> ((C2HSImp.Ptr (GribHandle)) -> (C2HSImp.CDouble -> (C2HSImp.CDouble -> (C2HSImp.CULong -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr CSize) -> (IO C2HSImp.CInt))))))))))))

foreign import ccall unsafe "Data/Grib/Raw/Nearest.chs.h grib_nearest_delete"
  gribNearestDelete'_ :: ((GribNearest) -> (IO C2HSImp.CInt))

foreign import ccall unsafe "Data/Grib/Raw/Nearest.chs.h grib_nearest_find_multiple"
  grib_nearest_find_multiple :: ((C2HSImp.Ptr (GribHandle)) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> (C2HSImp.CLong -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CDouble) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt)))))))))))