expose io funcs

expose io funcs

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}

module GDAL.Internal.OSR (
    SpatialReference
  , CoordinateTransformation
  , Projectable (..)

  , srsFromWkt
  , srsFromProj4
  , srsFromEPSG
  , srsFromEPSGIO
  , srsFromXML

  , srsToWkt
  , srsToProj4
  , srsToXML

  , isGeographic
  , isLocal
  , isProjected
  , isSameGeogCS
  , isSame

  , getAngularUnits
  , getLinearUnits

  , coordinateTransformation
  , coordinateTransformationIO

  , cleanup
  , initialize
  , srsFromWktIO
  , withSpatialReference
  , withMaybeSRAsCString
  , withMaybeSpatialReference
  , maybeSpatialReferenceFromCString
  , withCoordinateTransformation
  , newSpatialRefHandle
  , newSpatialRefBorrowedHandle
  , maybeNewSpatialRefHandle
  , maybeNewSpatialRefBorrowedHandle
) where

#include "ogr_srs_api.h"

{# context lib = "gdal" prefix = "OSR" #}

import Control.Monad.Catch (throwM, mask_, try)
import Control.Monad (liftM, (>=>), when, void)

import Data.ByteString (ByteString)
import Data.ByteString.Char8 (useAsCString)
import Data.ByteString.Unsafe (unsafeUseAsCString)

import qualified Data.Vector.Storable.Mutable as Stm
import qualified Data.Vector.Storable as St

import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CInt(..), CDouble(..), CChar(..))
import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr)
import Foreign.Storable (Storable(..))
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, newForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (toBool)

import System.IO.Unsafe (unsafePerformIO)

import GDAL.Internal.Types
import GDAL.Internal.OGRError
import GDAL.Internal.CPLError hiding (None)
import GDAL.Internal.CPLString (peekCPLString)

{#pointer OGRSpatialReferenceH as SpatialReference foreign newtype#}

instance Show SpatialReference where
   show = show . srsToWkt

srsToWkt :: SpatialReference -> ByteString
srsToWkt s = exportWith fun s
  where
    fun s' p = {#call unsafe ExportToPrettyWkt as ^#} s' p 1

srsToProj4 :: SpatialReference -> ByteString
srsToProj4 = exportWith {#call unsafe ExportToProj4 as ^#}

srsToXML :: SpatialReference -> ByteString
srsToXML = exportWith fun
  where
    fun s' p = {#call unsafe ExportToXML as ^#} s' p (castPtr nullPtr)

exportWith
  :: (Ptr SpatialReference -> Ptr CString -> IO CInt)
  -> SpatialReference
  -> ByteString
exportWith fun srs =
  unsafePerformIO $
  withSpatialReference srs $ \pSrs ->
  peekCPLString $
  checkOGRError "srsTo" . fun pSrs
{-# NOINLINE exportWith #-}

foreign import ccall "ogr_srs_api.h &OSRRelease"
  c_release :: FunPtr (Ptr SpatialReference -> IO ())

newSpatialRefHandle
  :: IO (Ptr SpatialReference) -> IO SpatialReference
newSpatialRefHandle = maybeNewSpatialRefHandle >=> maybe exc return
  where exc = throwBindingException NullSpatialReference

maybeNewSpatialRefHandle
  :: IO (Ptr SpatialReference) -> IO (Maybe SpatialReference)
maybeNewSpatialRefHandle io =
  mask_ $ do
    p <- io
    if p==nullPtr
      then return Nothing
      else liftM (Just . SpatialReference) (newForeignPtr c_release p)

newSpatialRefBorrowedHandle
  :: IO (Ptr SpatialReference) -> IO SpatialReference
newSpatialRefBorrowedHandle =
  maybeNewSpatialRefBorrowedHandle >=> maybe exc return
  where exc = throwBindingException NullSpatialReference

maybeNewSpatialRefBorrowedHandle
  :: IO (Ptr SpatialReference) -> IO (Maybe SpatialReference)
maybeNewSpatialRefBorrowedHandle alloc = maybeNewSpatialRefHandle $ do
  p <- alloc
  when (p /= nullPtr) (void ({#call unsafe OSRReference as ^#} p))
  return p

emptySpatialRef :: IO SpatialReference
emptySpatialRef =
  newSpatialRefHandle ({#call unsafe NewSpatialReference as ^#} nullPtr)

srsFromWkt, srsFromProj4, srsFromXML
  :: ByteString -> Either OGRException SpatialReference
srsFromWkt =
  unsafePerformIO . flip useAsCString srsFromWktIO
{-# NOINLINE srsFromWkt #-}

srsFromWktIO :: CString -> IO (Either OGRException SpatialReference)
srsFromWktIO a =
  try $
  newSpatialRefHandle $
  checkGDALCall checkIt ({#call unsafe NewSpatialReference as ^#} a)
  where
    checkIt e p
      | p==nullPtr = Just (maybe defExc toOgrExc e)
      | otherwise  = fmap toOgrExc e
    defExc = NullSpatialReference
    toOgrExc = gdalToOgrException Failure

srsFromProj4 = fromImporter importFromProj4
{-# NOINLINE srsFromProj4 #-}

srsFromXML = fromImporter importFromXML
{-# NOINLINE srsFromXML #-}

srsFromEPSG :: Int -> Either OGRException SpatialReference
srsFromEPSG = fromImporter importFromEPSG
{-# NOINLINE srsFromEPSG #-}

srsFromEPSGIO :: Int -> IO (Either OGRException SpatialReference)
srsFromEPSGIO = fromImporterIO importFromEPSG

fromImporter
  :: (SpatialReference -> a -> IO CInt) -> a
  -> Either OGRException SpatialReference
fromImporter f = unsafePerformIO . fromImporterIO f
{-# NOINLINE fromImporter #-}

fromImporterIO
  :: (SpatialReference -> a -> IO CInt) -> a
  -> IO (Either OGRException SpatialReference)
fromImporterIO f s = do
  r <- emptySpatialRef
  try (checkOGRError "srsFrom" (f r s) >> return r)

{#fun ImportFromProj4 as ^
   { withSpatialReference* `SpatialReference'
   , useAsCString* `ByteString'} -> `CInt' #}

{#fun ImportFromEPSG as ^
   {withSpatialReference* `SpatialReference', `Int'} -> `CInt' #}

{#fun ImportFromXML as ^
   { withSpatialReference* `SpatialReference'
   , useAsCString* `ByteString'} -> `CInt' #}

{#fun pure unsafe IsGeographic as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsLocal as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsProjected as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsSameGeogCS as ^
   { withSpatialReference* `SpatialReference'
   , withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsSame as ^
   { withSpatialReference* `SpatialReference'
   , withSpatialReference* `SpatialReference'} -> `Bool'#}

instance Eq SpatialReference where
  (==) = isSame

getLinearUnits :: SpatialReference -> (Double, String)
getLinearUnits =
  unsafePerformIO . getUnitsWith {#call unsafe OSRGetLinearUnits as ^#}

getAngularUnits :: SpatialReference -> (Double, String)
getAngularUnits =
  unsafePerformIO . getUnitsWith {#call unsafe OSRGetAngularUnits as ^#}

getUnitsWith
  :: (Ptr SpatialReference -> Ptr CString -> IO CDouble)
  -> SpatialReference
  -> IO (Double, String)
getUnitsWith fun s = alloca $ \p -> do
  value <- withSpatialReference s (\s' -> fun s' p)
  ptr <- peek p
  units <- peekCString ptr
  return (realToFrac value, units)

withMaybeSRAsCString :: Maybe SpatialReference -> (CString -> IO a) -> IO a
withMaybeSRAsCString =
  unsafeUseAsCString . maybe "\0" srsToWkt

maybeSpatialReferenceFromCString :: CString -> IO (Maybe SpatialReference)
maybeSpatialReferenceFromCString srs = do
  c <- peek srs
  if c == 0
    then return Nothing
    else srsFromWktIO srs >>= either throwM (return . Just)

withMaybeSpatialReference
  :: Maybe SpatialReference -> (Ptr SpatialReference -> IO a) -> IO a
withMaybeSpatialReference Nothing  = ($ nullPtr)
withMaybeSpatialReference (Just s) = withSpatialReference s

{#pointer OGRCoordinateTransformationH as CoordinateTransformation
  foreign newtype#}

coordinateTransformation
  :: SpatialReference -> SpatialReference
  -> Either OGRException CoordinateTransformation
coordinateTransformation source =
  unsafePerformIO . coordinateTransformationIO source
{-# NOINLINE coordinateTransformation #-}

coordinateTransformationIO
  :: SpatialReference
  -> SpatialReference
  -> IO (Either OGRException CoordinateTransformation)
coordinateTransformationIO source target =
  try $
  liftM CoordinateTransformation $
  withSpatialReference source $ \pSource ->
  withSpatialReference target $ \pTarget ->
  mask_ $
  newForeignPtr c_destroyCT =<<
    (checkGDALCall checkIt
      ({#call unsafe OCTNewCoordinateTransformation as ^#} pSource pTarget))
  where
    checkIt e p
      | p==nullPtr = Just (maybe defExc toOgrExc e)
      | otherwise  = Nothing
    defExc = NullCoordinateTransformation
    toOgrExc = gdalToOgrException Failure

foreign import ccall "ogr_srs_api.h &OCTDestroyCoordinateTransformation"
  c_destroyCT :: FunPtr (Ptr CoordinateTransformation -> IO ())

class Projectable a where
  transformWith :: a -> CoordinateTransformation -> Maybe a

instance Projectable (St.Vector (Pair Double)) where
  transformWith = flip transformPoints

transformPoints
  :: CoordinateTransformation
  -> St.Vector (Pair Double)
  -> Maybe (St.Vector (Pair Double))
transformPoints ct v = unsafePerformIO $ withQuietErrorHandler $ do
  xs <- St.unsafeThaw (St.unsafeCast (St.map pFst v))
  ys <- St.unsafeThaw (St.unsafeCast (St.map pSnd v))
  zs <- Stm.replicate len 0
  ok <- liftM toBool $
        withCoordinateTransformation ct $ \pCt ->
        Stm.unsafeWith xs $ \pXs ->
        Stm.unsafeWith ys $ \pYs ->
        Stm.unsafeWith zs $ \pZs ->
          {#call unsafe OCTTransform as ^#} pCt (fromIntegral len) pXs pYs pZs
  if not ok
    then return Nothing
    else do
      fXs <- liftM St.unsafeCast (St.unsafeFreeze xs)
      fYs <- liftM St.unsafeCast (St.unsafeFreeze ys)
      return (Just (St.zipWith (:+:) fXs fYs))
  where len = St.length v

{#fun OSRCleanup as cleanup {} -> `()'#}

-- | GDAL doesn't call ogr/ogrct.cpp:LoadProj4Library in a thread-safe way
--   (at least in 1.11.2). We indirectly make sure it is called at startup
--   in the main thread (via 'withGDAL') with this function which creates
--   a dummy 'CoordinateTransformation'
initialize :: IO ()
initialize = do
  dummy <- emptySpatialRef
  void (coordinateTransformationIO dummy dummy)

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}

module GDAL.Internal.OSR (
    SpatialReference
  , CoordinateTransformation
  , Projectable (..)

  , srsFromWkt
  , srsFromProj4
  , srsFromEPSG
  , srsFromXML

  , srsToWkt
  , srsToProj4
  , srsToXML

  , isGeographic
  , isLocal
  , isProjected
  , isSameGeogCS
  , isSame

  , getAngularUnits
  , getLinearUnits

  , coordinateTransformation

  , cleanup
  , initialize
  , srsFromWktIO
  , withSpatialReference
  , withMaybeSRAsCString
  , withMaybeSpatialReference
  , maybeSpatialReferenceFromCString
  , withCoordinateTransformation
  , newSpatialRefHandle
  , newSpatialRefBorrowedHandle
  , maybeNewSpatialRefHandle
  , maybeNewSpatialRefBorrowedHandle
) where

#include "ogr_srs_api.h"

{# context lib = "gdal" prefix = "OSR" #}

import Control.Monad.Catch (throwM, mask_, try)
import Control.Monad (liftM, (>=>), when, void)

import Data.ByteString (ByteString)
import Data.ByteString.Char8 (useAsCString)
import Data.ByteString.Unsafe (unsafeUseAsCString)

import qualified Data.Vector.Storable.Mutable as Stm
import qualified Data.Vector.Storable as St

import Foreign.C.String (CString, peekCString)
import Foreign.C.Types (CInt(..), CDouble(..), CChar(..))
import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr)
import Foreign.Storable (Storable(..))
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, newForeignPtr)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (toBool)

import System.IO.Unsafe (unsafePerformIO)

import GDAL.Internal.Types
import GDAL.Internal.OGRError
import GDAL.Internal.CPLError hiding (None)
import GDAL.Internal.CPLString (peekCPLString)

{#pointer OGRSpatialReferenceH as SpatialReference foreign newtype#}

instance Show SpatialReference where
   show = show . srsToWkt

srsToWkt :: SpatialReference -> ByteString
srsToWkt s = exportWith fun s
  where
    fun s' p = {#call unsafe ExportToPrettyWkt as ^#} s' p 1

srsToProj4 :: SpatialReference -> ByteString
srsToProj4 = exportWith {#call unsafe ExportToProj4 as ^#}

srsToXML :: SpatialReference -> ByteString
srsToXML = exportWith fun
  where
    fun s' p = {#call unsafe ExportToXML as ^#} s' p (castPtr nullPtr)

exportWith
  :: (Ptr SpatialReference -> Ptr CString -> IO CInt)
  -> SpatialReference
  -> ByteString
exportWith fun srs =
  unsafePerformIO $
  withSpatialReference srs $ \pSrs ->
  peekCPLString $
  checkOGRError "srsTo" . fun pSrs
{-# NOINLINE exportWith #-}

foreign import ccall "ogr_srs_api.h &OSRRelease"
  c_release :: FunPtr (Ptr SpatialReference -> IO ())

newSpatialRefHandle
  :: IO (Ptr SpatialReference) -> IO SpatialReference
newSpatialRefHandle = maybeNewSpatialRefHandle >=> maybe exc return
  where exc = throwBindingException NullSpatialReference

maybeNewSpatialRefHandle
  :: IO (Ptr SpatialReference) -> IO (Maybe SpatialReference)
maybeNewSpatialRefHandle io =
  mask_ $ do
    p <- io
    if p==nullPtr
      then return Nothing
      else liftM (Just . SpatialReference) (newForeignPtr c_release p)

newSpatialRefBorrowedHandle
  :: IO (Ptr SpatialReference) -> IO SpatialReference
newSpatialRefBorrowedHandle =
  maybeNewSpatialRefBorrowedHandle >=> maybe exc return
  where exc = throwBindingException NullSpatialReference

maybeNewSpatialRefBorrowedHandle
  :: IO (Ptr SpatialReference) -> IO (Maybe SpatialReference)
maybeNewSpatialRefBorrowedHandle alloc = maybeNewSpatialRefHandle $ do
  p <- alloc
  when (p /= nullPtr) (void ({#call unsafe OSRReference as ^#} p))
  return p

emptySpatialRef :: IO SpatialReference
emptySpatialRef =
  newSpatialRefHandle ({#call unsafe NewSpatialReference as ^#} nullPtr)

srsFromWkt, srsFromProj4, srsFromXML
  :: ByteString -> Either OGRException SpatialReference
srsFromWkt =
  unsafePerformIO . flip useAsCString srsFromWktIO
{-# NOINLINE srsFromWkt #-}

srsFromWktIO :: CString -> IO (Either OGRException SpatialReference)
srsFromWktIO a =
  try $
  newSpatialRefHandle $
  checkGDALCall checkIt ({#call unsafe NewSpatialReference as ^#} a)
  where
    checkIt e p
      | p==nullPtr = Just (maybe defExc toOgrExc e)
      | otherwise  = fmap toOgrExc e
    defExc = NullSpatialReference
    toOgrExc = gdalToOgrException Failure

srsFromProj4 = fromImporter importFromProj4
{-# NOINLINE srsFromProj4 #-}

srsFromXML = fromImporter importFromXML
{-# NOINLINE srsFromXML #-}

srsFromEPSG :: Int -> Either OGRException SpatialReference
srsFromEPSG = fromImporter importFromEPSG
{-# NOINLINE srsFromEPSG #-}

fromImporter
  :: (SpatialReference -> a -> IO CInt) -> a
  -> Either OGRException SpatialReference
fromImporter f s = unsafePerformIO $ do
  r <- emptySpatialRef
  try (checkOGRError "srsFrom" (f r s) >> return r)
{-# NOINLINE fromImporter #-}

{#fun ImportFromProj4 as ^
   { withSpatialReference* `SpatialReference'
   , useAsCString* `ByteString'} -> `CInt' #}

{#fun ImportFromEPSG as ^
   {withSpatialReference* `SpatialReference', `Int'} -> `CInt' #}

{#fun ImportFromXML as ^
   { withSpatialReference* `SpatialReference'
   , useAsCString* `ByteString'} -> `CInt' #}

{#fun pure unsafe IsGeographic as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsLocal as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsProjected as ^
   {withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsSameGeogCS as ^
   { withSpatialReference* `SpatialReference'
   , withSpatialReference* `SpatialReference'} -> `Bool'#}

{#fun pure unsafe IsSame as ^
   { withSpatialReference* `SpatialReference'
   , withSpatialReference* `SpatialReference'} -> `Bool'#}

instance Eq SpatialReference where
  (==) = isSame

getLinearUnits :: SpatialReference -> (Double, String)
getLinearUnits =
  unsafePerformIO . getUnitsWith {#call unsafe OSRGetLinearUnits as ^#}

getAngularUnits :: SpatialReference -> (Double, String)
getAngularUnits =
  unsafePerformIO . getUnitsWith {#call unsafe OSRGetAngularUnits as ^#}

getUnitsWith
  :: (Ptr SpatialReference -> Ptr CString -> IO CDouble)
  -> SpatialReference
  -> IO (Double, String)
getUnitsWith fun s = alloca $ \p -> do
  value <- withSpatialReference s (\s' -> fun s' p)
  ptr <- peek p
  units <- peekCString ptr
  return (realToFrac value, units)

withMaybeSRAsCString :: Maybe SpatialReference -> (CString -> IO a) -> IO a
withMaybeSRAsCString =
  unsafeUseAsCString . maybe "\0" srsToWkt

maybeSpatialReferenceFromCString :: CString -> IO (Maybe SpatialReference)
maybeSpatialReferenceFromCString srs = do
  c <- peek srs
  if c == 0
    then return Nothing
    else srsFromWktIO srs >>= either throwM (return . Just)

withMaybeSpatialReference
  :: Maybe SpatialReference -> (Ptr SpatialReference -> IO a) -> IO a
withMaybeSpatialReference Nothing  = ($ nullPtr)
withMaybeSpatialReference (Just s) = withSpatialReference s

{#pointer OGRCoordinateTransformationH as CoordinateTransformation
  foreign newtype#}

coordinateTransformation
  :: SpatialReference -> SpatialReference
  -> Either OGRException CoordinateTransformation
coordinateTransformation source =
  unsafePerformIO . coordinateTransformationIO source
{-# NOINLINE coordinateTransformation #-}

coordinateTransformationIO
  :: SpatialReference
  -> SpatialReference
  -> IO (Either OGRException CoordinateTransformation)
coordinateTransformationIO source target =
  try $
  liftM CoordinateTransformation $
  withSpatialReference source $ \pSource ->
  withSpatialReference target $ \pTarget ->
  mask_ $
  newForeignPtr c_destroyCT =<<
    (checkGDALCall checkIt
      ({#call unsafe OCTNewCoordinateTransformation as ^#} pSource pTarget))
  where
    checkIt e p
      | p==nullPtr = Just (maybe defExc toOgrExc e)
      | otherwise  = Nothing
    defExc = NullCoordinateTransformation
    toOgrExc = gdalToOgrException Failure

foreign import ccall "ogr_srs_api.h &OCTDestroyCoordinateTransformation"
  c_destroyCT :: FunPtr (Ptr CoordinateTransformation -> IO ())

class Projectable a where
  transformWith :: a -> CoordinateTransformation -> Maybe a

instance Projectable (St.Vector (Pair Double)) where
  transformWith = flip transformPoints

transformPoints
  :: CoordinateTransformation
  -> St.Vector (Pair Double)
  -> Maybe (St.Vector (Pair Double))
transformPoints ct v = unsafePerformIO $ withQuietErrorHandler $ do
  xs <- St.unsafeThaw (St.unsafeCast (St.map pFst v))
  ys <- St.unsafeThaw (St.unsafeCast (St.map pSnd v))
  zs <- Stm.replicate len 0
  ok <- liftM toBool $
        withCoordinateTransformation ct $ \pCt ->
        Stm.unsafeWith xs $ \pXs ->
        Stm.unsafeWith ys $ \pYs ->
        Stm.unsafeWith zs $ \pZs ->
          {#call unsafe OCTTransform as ^#} pCt (fromIntegral len) pXs pYs pZs
  if not ok
    then return Nothing
    else do
      fXs <- liftM St.unsafeCast (St.unsafeFreeze xs)
      fYs <- liftM St.unsafeCast (St.unsafeFreeze ys)
      return (Just (St.zipWith (:+:) fXs fYs))
  where len = St.length v

{#fun OSRCleanup as cleanup {} -> `()'#}

-- | GDAL doesn't call ogr/ogrct.cpp:LoadProj4Library in a thread-safe way
--   (at least in 1.11.2). We indirectly make sure it is called at startup
--   in the main thread (via 'withGDAL') with this function which creates
--   a dummy 'CoordinateTransformation'
initialize :: IO ()
initialize = do
  dummy <- emptySpatialRef
  void (coordinateTransformationIO dummy dummy)


Update on/afterEdited to use new TreeIter and to use connect_STRING_STRING__NONE rather than  connect_PTR_STRING__NONE. This is a different implementation than the  one in ModelView since the latter has a different type too. So this is  just an intrim implementation.

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRendererText TreeView
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.7 $ from $Date: 2005/10/19 12:57:37 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- A 'CellRenderer' which displays a single-line text.
--
module Graphics.UI.Gtk.TreeList.CellRendererText (
-- * Detail
--
-- | This widget derives from 'CellRenderer'. It provides the
-- possibility to display some text by setting the 'Attribute'
-- 'cellText' to the column of a 'TreeModel' by means of
-- 'treeViewAddAttribute' from 'TreeModelColumn'.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'CellRenderer'
-- |               +----CellRendererText
-- |                     +----'CellRendererCombo'
-- @

-- * Types
  CellRendererText,
  CellRendererTextClass,
  castToCellRendererText,
  toCellRendererText,

-- * Constructors
  cellRendererTextNew,

-- * Attributes
  cellText,
  cellMarkup,
  cellBackground,
  cellForeground,
  cellEditable,

-- * Signals
  onEdited,
  afterEdited
  ) where

import Maybe	(fromMaybe)
import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeIter#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)
import Graphics.UI.Gtk.TreeList.CellRenderer	(Attribute(..))
import System.Glib.StoreValue			(GenericValue(..), TMType(..))

{# context lib="gtk" prefix="gtk" #}

--------------------
-- Constructors

-- | Create a new CellRendererText object.
--
cellRendererTextNew :: IO CellRendererText
cellRendererTextNew =
  makeNewObject mkCellRendererText $
  liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererText) $
  {# call unsafe cell_renderer_text_new #}

-- helper function
--
strAttr :: [String] -> Attribute CellRendererText String
strAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring . Just)
		(\[GVstring str] -> return (fromMaybe "" str))

mStrAttr :: [String] -> Attribute CellRendererText (Maybe String)
mStrAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring)
		(\[GVstring str] -> return str)

--------------------
-- Properties

-- | Define the attribute that specifies the text to be
-- rendered.
--
cellText :: Attribute CellRendererText String
cellText  = strAttr ["text"]

-- | Define a markup string instead of a text.
--
cellMarkup :: Attribute CellRendererText String
cellMarkup  = strAttr ["markup"]

-- | A named color for the background paint.
--
cellBackground :: Attribute CellRendererText (Maybe String)
cellBackground  = mStrAttr ["background"]

-- | A named color for the foreground paint.
--
cellForeground :: Attribute CellRendererText (Maybe String)
cellForeground  = mStrAttr ["foreground"]

-- | Determines wether the content can be altered.
--
-- * If this flag is set, the user can alter the cell.
--
cellEditable :: Attribute CellRendererText (Maybe Bool)
cellEditable = Attribute ["editable","editable-set"] [TMboolean,TMboolean]
	         (\mb -> return $ case mb of
		   (Just bool) -> [GVboolean bool, GVboolean True]
		   Nothing     -> [GVboolean True, GVboolean False])
		 (\[GVboolean e, GVboolean s] -> return $
		   if s then Just e else Nothing)

-- | Emitted when the user finished editing a cell.
--
-- * This signal is not emitted when editing is disabled (see
--   'cellEditable') or when the user aborts editing.
--
onEdited, afterEdited :: TreeModelClass tm => CellRendererText -> tm ->
			 (TreeIter -> String -> IO ()) ->
			 IO (ConnectId CellRendererText)
onEdited cr tm user = connect_STRING_STRING__NONE "edited" False cr $
  \path string ->
  alloca $ \iterPtr ->
  withCString path $ \pathPtr -> do
  res <- {# call gtk_tree_model_get_iter_from_string #}
    (toTreeModel tm)
    iterPtr
    pathPtr
  if toBool res
    then do
      iter <- peek iterPtr
      user iter string
    else
      putStrLn "edited signal: invalid tree path"

afterEdited cr tm user = connect_STRING_STRING__NONE "edited" True cr $
  \path string ->
  alloca $ \iterPtr ->
  withCString path $ \pathPtr -> do
  res <- {# call gtk_tree_model_get_iter_from_string #}
    (toTreeModel tm)
    iterPtr
    pathPtr
  if toBool res
    then do
      iter <- peek iterPtr
      user iter string
    else
      putStrLn "edited signal: invalid tree path"

-- -*-haskell-*-
--  GIMP Toolkit (GTK) CellRendererText TreeView
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.7 $ from $Date: 2005/10/19 12:57:37 $
--
--  Copyright (C) 1999-2005 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- A 'CellRenderer' which displays a single-line text.
--
module Graphics.UI.Gtk.TreeList.CellRendererText (
-- * Detail
--
-- | This widget derives from 'CellRenderer'. It provides the
-- possibility to display some text by setting the 'Attribute'
-- 'cellText' to the column of a 'TreeModel' by means of
-- 'treeViewAddAttribute' from 'TreeModelColumn'.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'CellRenderer'
-- |               +----CellRendererText
-- |                     +----'CellRendererCombo'
-- @

-- * Types
  CellRendererText,
  CellRendererTextClass,
  castToCellRendererText,
  toCellRendererText,

-- * Constructors
  cellRendererTextNew,

-- * Attributes
  cellText,
  cellMarkup,
  cellBackground,
  cellForeground,
  cellEditable,

-- * Signals
  onEdited,
  afterEdited
  ) where

import Maybe	(fromMaybe)
import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.TreeList.TreeIter#}
import Graphics.UI.Gtk.General.Structs		(treeIterSize)
import Graphics.UI.Gtk.TreeList.CellRenderer	(Attribute(..))
import System.Glib.StoreValue			(GenericValue(..), TMType(..))

{# context lib="gtk" prefix="gtk" #}

--------------------
-- Constructors

-- | Create a new CellRendererText object.
--
cellRendererTextNew :: IO CellRendererText
cellRendererTextNew =
  makeNewObject mkCellRendererText $
  liftM (castPtr :: Ptr CellRenderer -> Ptr CellRendererText) $
  {# call unsafe cell_renderer_text_new #}

-- helper function
--
strAttr :: [String] -> Attribute CellRendererText String
strAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring . Just)
		(\[GVstring str] -> return (fromMaybe "" str))

mStrAttr :: [String] -> Attribute CellRendererText (Maybe String)
mStrAttr str = Attribute str [TMstring]
	        (return . (\x -> [x]) . GVstring)
		(\[GVstring str] -> return str)

--------------------
-- Properties

-- | Define the attribute that specifies the text to be
-- rendered.
--
cellText :: Attribute CellRendererText String
cellText  = strAttr ["text"]

-- | Define a markup string instead of a text.
--
cellMarkup :: Attribute CellRendererText String
cellMarkup  = strAttr ["markup"]

-- | A named color for the background paint.
--
cellBackground :: Attribute CellRendererText (Maybe String)
cellBackground  = mStrAttr ["background"]

-- | A named color for the foreground paint.
--
cellForeground :: Attribute CellRendererText (Maybe String)
cellForeground  = mStrAttr ["foreground"]

-- | Determines wether the content can be altered.
--
-- * If this flag is set, the user can alter the cell.
--
cellEditable :: Attribute CellRendererText (Maybe Bool)
cellEditable = Attribute ["editable","editable-set"] [TMboolean,TMboolean]
	         (\mb -> return $ case mb of
		   (Just bool) -> [GVboolean bool, GVboolean True]
		   Nothing     -> [GVboolean True, GVboolean False])
		 (\[GVboolean e, GVboolean s] -> return $
		   if s then Just e else Nothing)

-- | Emitted when the user finished editing a cell.
--
-- * This signal is not emitted when editing is disabled (see
--   'cellEditable') or when the user aborts editing.
--
onEdited, afterEdited :: TreeModelClass tm => CellRendererText -> tm ->
			 (TreeIter -> String -> IO ()) ->
			 IO (ConnectId CellRendererText)
onEdited cr tm user = connect_PTR_STRING__NONE "edited" False cr $
  \strPtr string ->
  mallocTreeIter >>= \iter ->
  {# call gtk_tree_model_get_iter_from_string #}
    (toTreeModel tm)
    iter
    strPtr
  >>= \res -> if toBool res then user iter string else
      putStrLn "edited signal: invalid tree path"

afterEdited cr tm user = connect_PTR_STRING__NONE "edited" True cr $
  \strPtr string ->
  mallocTreeIter >>= \iter ->
  {# call gtk_tree_model_get_iter_from_string #}
    (toTreeModel tm)
    iter
    strPtr
  >>= \res -> if toBool res then user iter string else
      putStrLn "edited signal: invalid tree path"


Fix for gtk 3.6

Fix for gtk 3.6

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceCompletionContext
--
--  Author : Andy Stewart
--
--  Created: 08 Aug 2010
--
--  Copyright (C) 2010 Andy Stewart
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.SourceView.SourceCompletionContext (
-- * Types
   SourceCompletionContext,
   SourceCompletionContextClass,

-- * Enums
   SourceCompletionActivation,

-- * Methods
   sourceCompletionContextAddProposals,
   sourceCompletionContextGetIter,

-- * Attributes
   sourceCompletionContextActivation,
   sourceCompletionContextCompletion,

-- * Signals
   sourceCompletionContextCancelled,
) where

import Control.Monad	(liftM)

import Graphics.UI.Gtk.SourceView.Enums
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.GList		(fromGList, withGList)
import System.Glib.Properties
import System.Glib.UTFString

{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

{# context lib="gtk" prefix="gtk" #}

-- | Providers can use this function to add proposals to the completion. They can do so asynchronously by
-- means of the finished argument. Providers must ensure that they always call this function with
-- finished set to 'True' once each population (even if no proposals need to be added).
sourceCompletionContextAddProposals :: (SourceCompletionContextClass scc, SourceCompletionProviderClass scp) => scc
                                    -> scp
                                    -> [SourceCompletionProposal] -- ^ @proposals@ The list of proposals to add
                                    -> Bool -- ^ @finished@  Whether the provider is finished adding proposals
                                    -> IO ()
sourceCompletionContextAddProposals scc provider proposals finished =
    withForeignPtrs (map unSourceCompletionProposal proposals) $ \proposalsPtr ->
#if !MIN_VERSION_gtksourceview_3_0(3,6,0)
    withForeignPtr (unSourceCompletionProvider $ toSourceCompletionProvider provider) $ \providerPtr ->
#endif
    withGList proposalsPtr $ \glist ->
    {#call gtk_source_completion_context_add_proposals #}
      (toSourceCompletionContext scc)
#if MIN_VERSION_gtksourceview_3_0(3,6,0)
      (toSourceCompletionProvider provider)
#else
      (castPtr providerPtr)
#endif
      glist
      (fromBool finished)

-- | Get the iter at which the completion was invoked. Providers can use this to determine how and if to
-- match proposals.
sourceCompletionContextGetIter :: SourceCompletionContextClass scc => scc
                               -> IO TextIter
sourceCompletionContextGetIter scc = do
  iter <- makeEmptyTextIter
  {#call gtk_source_completion_context_get_iter #}
    (toSourceCompletionContext scc)
    iter
  return iter

-- | The completion activation
sourceCompletionContextActivation :: SourceCompletionContextClass scc => Attr scc SourceCompletionActivation
sourceCompletionContextActivation = newAttrFromEnumProperty "activation"
                                    {#call pure unsafe gtk_source_completion_activation_get_type #}

-- | The 'SourceCompletion' associated with the context.
sourceCompletionContextCompletion :: SourceCompletionContextClass scc => Attr scc SourceCompletion
sourceCompletionContextCompletion = newAttrFromObjectProperty "completion"
                                    {#call pure unsafe gtk_source_completion_get_type #}

-- | Emitted when the current population of proposals has been cancelled. Providers adding proposals
-- asynchronously should connect to this signal to know when to cancel running proposal queries.
sourceCompletionContextCancelled :: SourceCompletionContextClass scc => Signal scc (IO ())
sourceCompletionContextCancelled = Signal $ connect_NONE__NONE "cancelled"

{-# LANGUAGE CPP #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget SourceCompletionContext
--
--  Author : Andy Stewart
--
--  Created: 08 Aug 2010
--
--  Copyright (C) 2010 Andy Stewart
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.SourceView.SourceCompletionContext (
-- * Types
   SourceCompletionContext,
   SourceCompletionContextClass,

-- * Enums
   SourceCompletionActivation,

-- * Methods
   sourceCompletionContextAddProposals,
   sourceCompletionContextGetIter,

-- * Attributes
   sourceCompletionContextActivation,
   sourceCompletionContextCompletion,

-- * Signals
   sourceCompletionContextCancelled,
) where

import Control.Monad	(liftM)

import Graphics.UI.Gtk.SourceView.Enums
import System.Glib.Attributes
import System.Glib.FFI
import System.Glib.GList		(fromGList, withGList)
import System.Glib.Properties
import System.Glib.UTFString

{#import Graphics.UI.Gtk.SourceView.Signals#}
{#import Graphics.UI.Gtk.SourceView.Types#}

{# context lib="gtk" prefix="gtk" #}

-- | Providers can use this function to add proposals to the completion. They can do so asynchronously by
-- means of the finished argument. Providers must ensure that they always call this function with
-- finished set to 'True' once each population (even if no proposals need to be added).
sourceCompletionContextAddProposals :: (SourceCompletionContextClass scc, SourceCompletionProviderClass scp) => scc
                                    -> scp
                                    -> [SourceCompletionProposal] -- ^ @proposals@ The list of proposals to add
                                    -> Bool -- ^ @finished@  Whether the provider is finished adding proposals
                                    -> IO ()
sourceCompletionContextAddProposals scc provider proposals finished =
    withForeignPtrs (map unSourceCompletionProposal proposals) $ \proposalsPtr ->
#if !MIN_VERSION_gtksourceview_3_0(3,6,0)
    withForeignPtr (unSourceCompletionProvider $ toSourceCompletionProvider provider) $ \providerPtr ->
#endif
    withGList proposalsPtr $ \glist ->
    {#call gtk_source_completion_context_add_proposals #}
      (toSourceCompletionContext scc)
#if MIN_VERSION_gtksourceview_3_0(3,6,0)
      (castPtr $ toSourceCompletionProvider provider)
#else
      (castPtr providerPtr)
#endif
      glist
      (fromBool finished)

-- | Get the iter at which the completion was invoked. Providers can use this to determine how and if to
-- match proposals.
sourceCompletionContextGetIter :: SourceCompletionContextClass scc => scc
                               -> IO TextIter
sourceCompletionContextGetIter scc = do
  iter <- makeEmptyTextIter
  {#call gtk_source_completion_context_get_iter #}
    (toSourceCompletionContext scc)
    iter
  return iter

-- | The completion activation
sourceCompletionContextActivation :: SourceCompletionContextClass scc => Attr scc SourceCompletionActivation
sourceCompletionContextActivation = newAttrFromEnumProperty "activation"
                                    {#call pure unsafe gtk_source_completion_activation_get_type #}

-- | The 'SourceCompletion' associated with the context.
sourceCompletionContextCompletion :: SourceCompletionContextClass scc => Attr scc SourceCompletion
sourceCompletionContextCompletion = newAttrFromObjectProperty "completion"
                                    {#call pure unsafe gtk_source_completion_get_type #}

-- | Emitted when the current population of proposals has been cancelled. Providers adding proposals
-- asynchronously should connect to this signal to know when to cancel running proposal queries.
sourceCompletionContextCancelled :: SourceCompletionContextClass scc => Signal scc (IO ())
sourceCompletionContextCancelled = Signal $ connect_NONE__NONE "cancelled"