{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
module Data.GI.Gtk.ModelView.Types (
TypedTreeModel(..),
IsTypedTreeModel,
toTypedTreeModel,
unsafeTreeModelToGeneric,
TypedTreeModelSort(..),
unsafeTreeModelSortToGeneric,
TypedTreeModelFilter(..),
unsafeTreeModelFilterToGeneric,
treePathNewFromIndices',
treePathGetIndices',
withTreePath,
stringToTreePath,
treeSelectionGetSelectedRows',
ColumnAccess(..),
ColumnId(..),
comboQuark,
equalManagedPtr
) where
import Prelude ()
import Prelude.Compat
import GHC.Exts (unsafeCoerce#)
import Data.Char ( isDigit )
import Data.Word (Word32)
import Data.Int (Int32)
import Data.Text (Text)
import qualified Data.Text as T (unpack)
import Data.Coerce (coerce)
import Control.Monad ( liftM )
import Control.Monad.IO.Class (MonadIO(..))
import Control.Exception (catch)
import Foreign.Storable (Storable(..))
import Foreign.Ptr (Ptr, castPtr, plusPtr, minusPtr, nullPtr)
import Foreign.C.Types (CInt(..))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (toBool)
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Marshal.Utils (with)
import Data.GI.Base.BasicTypes
(ManagedPtr(..), ManagedPtrNewtype, UnexpectedNullPointerReturn,
GObject(..))
import Data.GI.Base.ManagedPtr (withManagedPtr)
import Data.GI.Base.Overloading (HasParentTypes, ParentTypes)
import Data.GI.Base.GValue (GValue)
import GI.GObject.Objects.Object (Object(..))
import GI.Gtk.Interfaces.TreeModel (TreeModel, IsTreeModel(..))
import GI.Gtk.Objects.TreeModelSort (TreeModelSort, IsTreeModelSort(..))
import GI.Gtk.Objects.TreeSelection (IsTreeSelection, treeSelectionCountSelectedRows, treeSelectionGetSelectedRows)
import GI.Gtk.Objects.TreeModelFilter (TreeModelFilter)
import GI.Gtk.Interfaces.TreeSortable (TreeSortable, IsTreeSortable(..))
import GI.GLib.Functions (quarkFromString)
import GI.GdkPixbuf.Objects.Pixbuf (Pixbuf(..))
import GI.Gtk.Structs.TreeIter
(TreeIter(..), treeIterCopy)
import GI.Gtk.Structs.TreePath (TreePath(..), treePathGetIndices, treePathAppendIndex, treePathNew, treePathGetDepth)
import Data.GI.Base.Constructible (Constructible(..))
import Data.GI.Base.Attributes (AttrOp(..))
import Unsafe.Coerce (unsafeCoerce)
import Data.GI.Base (set, get)
import Data.IORef (newIORef)
equalManagedPtr :: ManagedPtrNewtype a => a -> a -> Bool
equalManagedPtr :: a -> a -> Bool
equalManagedPtr a :: a
a b :: a
b =
ManagedPtr () -> ForeignPtr ()
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr (a -> ManagedPtr ()
forall a b. Coercible a b => a -> b
coerce a
a :: ManagedPtr ()) ForeignPtr () -> ForeignPtr () -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedPtr () -> ForeignPtr ()
forall a. ManagedPtr a -> ForeignPtr a
managedForeignPtr (a -> ManagedPtr ()
forall a b. Coercible a b => a -> b
coerce a
b :: ManagedPtr ())
newtype TypedTreeModel row = TypedTreeModel (ManagedPtr (TypedTreeModel row))
class IsTypedTreeModel model where
dummy :: model a -> a
dummy _ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error "not used"
toTypedTreeModel :: IsTypedTreeModel model => model row -> TypedTreeModel row
toTypedTreeModel :: model row -> TypedTreeModel row
toTypedTreeModel = model row -> TypedTreeModel row
unsafeCoerce#
unsafeTreeModelToGeneric :: TreeModel -> model row
unsafeTreeModelToGeneric :: TreeModel -> model row
unsafeTreeModelToGeneric = TreeModel -> model row
unsafeCoerce#
instance IsTypedTreeModel TypedTreeModel
newtype TypedTreeModelSort row = TypedTreeModelSort (ManagedPtr (TypedTreeModelSort row))
instance HasParentTypes (TypedTreeModelSort row)
type instance ParentTypes (TypedTreeModelSort row) = '[TreeSortable, TreeModel, TreeModelSort]
instance GObject (TypedTreeModelSort row) where
#if !MIN_VERSION_haskell_gi_base(0,20,1)
gobjectIsInitiallyUnowned _ = False
#endif
gobjectType :: IO GType
gobjectType = GObject TreeModelSort => IO GType
forall a. GObject a => IO GType
gobjectType @TreeModelSort
unsafeTreeModelSortToGeneric :: TreeModelSort -> TypedTreeModelSort row
unsafeTreeModelSortToGeneric :: TreeModelSort -> TypedTreeModelSort row
unsafeTreeModelSortToGeneric = TreeModelSort -> TypedTreeModelSort row
unsafeCoerce#
instance IsTypedTreeModel TypedTreeModelSort
newtype TypedTreeModelFilter row = TypedTreeModelFilter (ManagedPtr (TypedTreeModelFilter row))
unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row
unsafeTreeModelFilterToGeneric :: TreeModelFilter -> TypedTreeModelFilter row
unsafeTreeModelFilterToGeneric = TreeModelFilter -> TypedTreeModelFilter row
unsafeCoerce#
instance IsTypedTreeModel TypedTreeModelFilter
treePathNewFromIndices' :: MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' :: [Int32] -> m TreePath
treePathNewFromIndices' [] = m TreePath
forall (m :: * -> *). (HasCallStack, MonadIO m) => m TreePath
treePathNew
treePathNewFromIndices' x :: [Int32]
x = do
TreePath
path <- m TreePath
forall (m :: * -> *). (HasCallStack, MonadIO m) => m TreePath
treePathNew
(Int32 -> m ()) -> [Int32] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TreePath -> Int32 -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> Int32 -> m ()
treePathAppendIndex TreePath
path) [Int32]
x
TreePath -> m TreePath
forall (m :: * -> *) a. Monad m => a -> m a
return TreePath
path
treePathGetIndices' :: MonadIO m => TreePath -> m [Int32]
treePathGetIndices' :: TreePath -> m [Int32]
treePathGetIndices' path :: TreePath
path = TreePath -> m Int32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m Int32
treePathGetDepth TreePath
path m Int32 -> (Int32 -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
0 -> [Int32] -> m [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> do
Maybe [Int32]
indices <- TreePath -> m (Maybe [Int32])
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TreePath -> m (Maybe [Int32])
treePathGetIndices TreePath
path
case Maybe [Int32]
indices of
Just ixs :: [Int32]
ixs -> [Int32] -> m [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int32]
ixs
Nothing -> [Int32] -> m [Int32]
forall (m :: * -> *) a. Monad m => a -> m a
return []
withTreePath :: MonadIO m => [Int32] -> (TreePath -> m a) -> m a
withTreePath :: [Int32] -> (TreePath -> m a) -> m a
withTreePath tp :: [Int32]
tp act :: TreePath -> m a
act = [Int32] -> m TreePath
forall (m :: * -> *). MonadIO m => [Int32] -> m TreePath
treePathNewFromIndices' [Int32]
tp m TreePath -> (TreePath -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreePath -> m a
act
treeSelectionGetSelectedRows' :: (MonadIO m, IsTreeSelection sel) => sel -> m [TreePath]
treeSelectionGetSelectedRows' :: sel -> m [TreePath]
treeSelectionGetSelectedRows' sel :: sel
sel = sel -> m Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m Int32
treeSelectionCountSelectedRows sel
sel m Int32 -> (Int32 -> m [TreePath]) -> m [TreePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
0 -> [TreePath] -> m [TreePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> IO [TreePath] -> m [TreePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TreePath] -> m [TreePath]) -> IO [TreePath] -> m [TreePath]
forall a b. (a -> b) -> a -> b
$ (([TreePath], TreeModel) -> [TreePath]
forall a b. (a, b) -> a
fst (([TreePath], TreeModel) -> [TreePath])
-> IO ([TreePath], TreeModel) -> IO [TreePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> sel -> IO ([TreePath], TreeModel)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTreeSelection a) =>
a -> m ([TreePath], TreeModel)
treeSelectionGetSelectedRows sel
sel) IO [TreePath]
-> (UnexpectedNullPointerReturn -> IO [TreePath]) -> IO [TreePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(UnexpectedNullPointerReturn
_::UnexpectedNullPointerReturn) -> [TreePath] -> IO [TreePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
stringToTreePath :: Text -> [Int32]
stringToTreePath :: Text -> [Int32]
stringToTreePath = [Char] -> [Int32]
forall a. Num a => [Char] -> [a]
stringToTreePath' ([Char] -> [Int32]) -> (Text -> [Char]) -> Text -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack
where
stringToTreePath' :: [Char] -> [a]
stringToTreePath' "" = []
stringToTreePath' path :: [Char]
path = a -> [Char] -> [a]
getNum 0 ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) [Char]
path)
getNum :: a -> [Char] -> [a]
getNum acc :: a
acc ('0':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acc) [Char]
xs
getNum acc :: a
acc ('1':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+1) [Char]
xs
getNum acc :: a
acc ('2':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+2) [Char]
xs
getNum acc :: a
acc ('3':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+3) [Char]
xs
getNum acc :: a
acc ('4':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+4) [Char]
xs
getNum acc :: a
acc ('5':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+5) [Char]
xs
getNum acc :: a
acc ('6':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+6) [Char]
xs
getNum acc :: a
acc ('7':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+7) [Char]
xs
getNum acc :: a
acc ('8':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+8) [Char]
xs
getNum acc :: a
acc ('9':xs :: [Char]
xs) = a -> [Char] -> [a]
getNum (10a -> a -> a
forall a. Num a => a -> a -> a
*a
acca -> a -> a
forall a. Num a => a -> a -> a
+9) [Char]
xs
getNum acc :: a
acc xs :: [Char]
xs = a
acca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[Char] -> [a]
stringToTreePath' ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit) [Char]
xs)
data ColumnAccess row where
CAInvalid :: ColumnAccess row
CAInt :: (row -> Int32) -> ColumnAccess row
CABool :: (row -> Bool) -> ColumnAccess row
CAString :: (row -> Text) -> ColumnAccess row
CAPixbuf :: (row -> Pixbuf) -> ColumnAccess row
data ColumnId row ty
= ColumnId (GValue -> IO ty) ((row -> ty) -> ColumnAccess row) Int32
{-# NOINLINE comboQuark #-}
comboQuark :: Word32
comboQuark :: Word32
comboQuark =
IO Word32 -> Word32
forall a. IO a -> a
unsafePerformIO (IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO Word32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Word32
quarkFromString (Text -> Maybe Text
forall a. a -> Maybe a
Just "comboBoxHaskellStringModelQuark")