{-# LANGUAGE FlexibleInstances #-}

module Data.Geometry.Geos.Raw.CoordSeq
  ( CoordinateSequence(..)
  , CoordSeqConst(CoordSeqConst)
  , CoordSeq(CoordSeq)
  , getCoordinateSequenceX
  , getCoordinateSequenceY
  , getCoordinateSequenceZ
  , getCoordinateSequenceSize
  , getCoordinateSequenceDimensions
  , setCoordinateSequenceX
  , setCoordinateSequenceY
  , setCoordinateSequenceZ
  , setCoordinateSequenceOrd
  )
where

import qualified Data.Geometry.Geos.Raw.Internal
                                               as I
import           Data.Geometry.Geos.Raw.Base
import           Foreign                 hiding ( throwIfNull
                                                , void
                                                )
import           Foreign.C.Types
import           Control.Monad

class CoordinateSequence a where
  withCoordinateSequence :: a -> (Ptr I.GEOSCoordSequence -> IO b) -> IO b
  createEmptyCoordinateSequence :: Int -> Int -> Geos a
  createCoordinateSequence :: Ptr I.GEOSCoordSequence -> Geos a



newtype CoordSeq = CoordSeq {
  _unCoordSeq :: ForeignPtr I.GEOSCoordSequence
}
newtype CoordSeqConst = CoordSeqConst {
  _unCoordSeqConst :: Ptr I.GEOSCoordSequence
}

instance Eq CoordSeq where
  (==) = coordSeqEq

instance Eq CoordSeqConst where
  (==) = coordSeqEq

coordSeqEq :: CoordinateSequence a => a -> a -> Bool
coordSeqEq a b = runGeos $ do
  sa <- getCoordinateSequenceSize a
  sb <- getCoordinateSequenceSize b
  da <- getCoordinateSequenceDimensions a
  db <- getCoordinateSequenceDimensions b
  if (sa == sb) && (da == db)
    then foldM (comp (da == 3)) True [0 .. (sa - 1)]
    else return False
 where
  comp zdim acc i = do
    xa <- getCoordinateSequenceX a i
    ya <- getCoordinateSequenceY a i
    xb <- getCoordinateSequenceX b i
    yb <- getCoordinateSequenceY b i
    zd <- if zdim
      then do
        za <- getCoordinateSequenceZ a i
        zb <- getCoordinateSequenceZ b i
        return $ za == zb
      else return True
    return $ (xa == xb) && (ya == yb) && acc && zd

instance Show CoordSeq where
  show = coordSeqShow

instance Show CoordSeqConst where
  show = coordSeqShow

coordSeqShow :: CoordinateSequence a => a -> String
coordSeqShow a = runGeos $ do
  sa <- getCoordinateSequenceSize a
  unlines `fmap` mapM show' [0 .. (sa - 1)]
 where
  show' i = do
    xa <- getCoordinateSequenceX a i
    ya <- getCoordinateSequenceY a i
    return . show $ (xa, ya)


instance CoordinateSequence CoordSeq where
  withCoordinateSequence (CoordSeq fp) = withForeignPtr fp
  createEmptyCoordinateSequence size dim = do
    ptr <- throwIfNull "createEmptyCoordinateSequence" $ withGeos $ \h ->
      I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)
    createCoordinateSequence ptr

  createCoordinateSequence ptr = withGeos $ \h -> do
    fptr <- newForeignPtrEnv I.geos_CoordSeqDestroy h ptr
    return $ CoordSeq fptr

instance CoordinateSequence CoordSeqConst where
  withCoordinateSequence (CoordSeqConst p) f = f p
  createEmptyCoordinateSequence size dim = do
    ptr <- throwIfNull "createEmptyCoordinateSequence" $ withGeos $ \h ->
      I.geos_CoordSeqCreate h (fromIntegral size) (fromIntegral dim)

    createCoordinateSequence ptr
  createCoordinateSequence ptr = return $ CoordSeqConst ptr




getCoordinateSequenceD_
  :: CoordinateSequence a
  => (  I.GEOSContextHandle_t
     -> Ptr I.GEOSCoordSequence
     -> CUInt
     -> Ptr CDouble
     -> IO CInt
     )
  -> a
  -> Int
  -> Geos Double
getCoordinateSequenceD_ f cs idx = withGeos' $ \h -> alloca $ \dptr -> do
  eitherRet <-
    throwIfZero' (mkErrorMessage "getCoordiniateSequenceN")
    $ withCoordinateSequence cs
    $ \pcs -> f h pcs (fromIntegral idx) dptr
  traverse (\_ -> marshallDouble dptr) eitherRet

getCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceX = getCoordinateSequenceD_ I.geos_CoordSeqGetX

getCoordinateSequenceY :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceY = getCoordinateSequenceD_ I.geos_CoordSeqGetY

getCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Geos Double
getCoordinateSequenceZ = getCoordinateSequenceD_ I.geos_CoordSeqGetZ

getCoordinateSequenceSize :: CoordinateSequence a => a -> Geos Int
getCoordinateSequenceSize c = withGeos' $ \h -> alloca $ \ptr -> do
  eitherRet <-
    throwIfZero' (mkErrorMessage "getCoordinateSequenceSize")
    $ withCoordinateSequence c
    $ \pc -> I.geos_CoordSeqGetSize h pc ptr
  traverse (\_ -> marshallInt ptr) eitherRet

getCoordinateSequenceDimensions :: CoordinateSequence a => a -> Geos Int
getCoordinateSequenceDimensions c = withGeos' $ \h -> alloca $ \ptr -> do
  eitherRet <-
    throwIfZero' (mkErrorMessage "getCoordinateSeqenceDimensions")
    $ withCoordinateSequence c
    $ \pc -> I.geos_CoordSeqGetDimensions h pc ptr
  traverse (\_ -> marshallInt ptr) eitherRet

---
setCoordinateSequence_
  :: CoordinateSequence a
  => (  I.GEOSContextHandle_t
     -> Ptr I.GEOSCoordSequence
     -> CUInt
     -> CDouble
     -> IO CInt
     )
  -> a
  -> Int
  -> Double
  -> Geos ()
setCoordinateSequence_ f cs idx val =
  void
    $ throwIfZero (mkErrorMessage "setCoordinateSEquenceN")
    $ withGeos
    $ \h -> withCoordinateSequence cs
        $ \pcs -> f h pcs (fromIntegral idx) (realToFrac val)


setCoordinateSequenceX :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceX = setCoordinateSequence_ I.geos_CoordSeqSetX

setCoordinateSequenceY :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceY = setCoordinateSequence_ I.geos_CoordSeqSetY

setCoordinateSequenceZ :: CoordinateSequence a => a -> Int -> Double -> Geos ()
setCoordinateSequenceZ = setCoordinateSequence_ I.geos_CoordSeqSetZ

setCoordinateSequenceOrd
  :: CoordinateSequence a => a -> Int -> Int -> Double -> Geos ()
setCoordinateSequenceOrd cs idx dim v =
  void
    $ throwIfZero (mkErrorMessage "setCoordinateSequenceN")
    $ withGeos
    $ \h -> withCoordinateSequence cs $ \pcs -> I.geos_CoordSeqSetOrdinate
        h
        pcs
        (fromIntegral idx)
        (fromIntegral dim)
        (realToFrac v)