PageRange.hs


{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

See also gtk_print_settings_set_page_ranges().
-}

module GI.Gtk.Structs.PageRange
    ( 

-- * Exported types
    PageRange(..)                           ,
    newZeroPageRange                        ,
    noPageRange                             ,


 -- * Properties
-- ** End
    pageRangeEnd                            ,
    pageRangeReadEnd                        ,
    pageRangeWriteEnd                       ,


-- ** Start
    pageRangeReadStart                      ,
    pageRangeStart                          ,
    pageRangeWriteStart                     ,




    ) where

import Data.GI.Base.ShortPrelude

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gtk.Types
import GI.Gtk.Callbacks

newtype PageRange = PageRange (ForeignPtr PageRange)
-- | Construct a `PageRange` struct initialized to zero.
newZeroPageRange :: MonadIO m => m PageRange
newZeroPageRange = liftIO $ callocBytes 8 >>= wrapPtr PageRange

instance tag ~ 'AttrSet => Constructible PageRange tag where
    new _ attrs = do
        o <- newZeroPageRange
        GI.Attributes.set o attrs
        return o


noPageRange :: Maybe PageRange
noPageRange = Nothing

pageRangeReadStart :: MonadIO m => PageRange -> m Int32
pageRangeReadStart s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int32
    return val

pageRangeWriteStart :: MonadIO m => PageRange -> Int32 -> m ()
pageRangeWriteStart s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int32)

data PageRangeStartFieldInfo
instance AttrInfo PageRangeStartFieldInfo where
    type AttrAllowedOps PageRangeStartFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PageRangeStartFieldInfo = (~) Int32
    type AttrBaseTypeConstraint PageRangeStartFieldInfo = (~) PageRange
    type AttrGetType PageRangeStartFieldInfo = Int32
    type AttrLabel PageRangeStartFieldInfo = "start"
    attrGet _ = pageRangeReadStart
    attrSet _ = pageRangeWriteStart
    attrConstruct = undefined
    attrClear _ = undefined

pageRangeStart :: AttrLabelProxy "start"
pageRangeStart = AttrLabelProxy


pageRangeReadEnd :: MonadIO m => PageRange -> m Int32
pageRangeReadEnd s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO Int32
    return val

pageRangeWriteEnd :: MonadIO m => PageRange -> Int32 -> m ()
pageRangeWriteEnd s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: Int32)

data PageRangeEndFieldInfo
instance AttrInfo PageRangeEndFieldInfo where
    type AttrAllowedOps PageRangeEndFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PageRangeEndFieldInfo = (~) Int32
    type AttrBaseTypeConstraint PageRangeEndFieldInfo = (~) PageRange
    type AttrGetType PageRangeEndFieldInfo = Int32
    type AttrLabel PageRangeEndFieldInfo = "end"
    attrGet _ = pageRangeReadEnd
    attrSet _ = pageRangeWriteEnd
    attrConstruct = undefined
    attrClear _ = undefined

pageRangeEnd :: AttrLabelProxy "end"
pageRangeEnd = AttrLabelProxy



type instance AttributeList PageRange = PageRangeAttributeList
type PageRangeAttributeList = ('[ '("start", PageRangeStartFieldInfo), '("end", PageRangeEndFieldInfo)] :: [(Symbol, *)])

type family ResolvePageRangeMethod (t :: Symbol) (o :: *) :: * where
    ResolvePageRangeMethod l o = MethodResolutionFailed l o

instance (info ~ ResolvePageRangeMethod t PageRange, MethodInfo info PageRange p) => IsLabelProxy t (PageRange -> p) where
    fromLabelProxy _ = overloadedMethod (MethodProxy :: MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolvePageRangeMethod t PageRange, MethodInfo info PageRange p) => IsLabel t (PageRange -> p) where
    fromLabel _ = overloadedMethod (MethodProxy :: MethodProxy info)
#endif