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

A 'GI.Poppler.Structs.TextAttributes.TextAttributes' is used to describe text attributes of a range of text
-}

module GI.Poppler.Structs.TextAttributes
    ( 

-- * Exported types
    TextAttributes(..)                      ,
    newZeroTextAttributes                   ,
    noTextAttributes                        ,


 -- * Methods
-- ** copy #method:copy#
    TextAttributesCopyMethodInfo            ,
    textAttributesCopy                      ,


-- ** free #method:free#
    TextAttributesFreeMethodInfo            ,
    textAttributesFree                      ,


-- ** new #method:new#
    textAttributesNew                       ,




 -- * Properties
-- ** color #attr:color#
    getTextAttributesColor                  ,
    textAttributes_color                    ,


-- ** endIndex #attr:endIndex#
    getTextAttributesEndIndex               ,
    setTextAttributesEndIndex               ,
    textAttributes_endIndex                 ,


-- ** fontName #attr:fontName#
    clearTextAttributesFontName             ,
    getTextAttributesFontName               ,
    setTextAttributesFontName               ,
    textAttributes_fontName                 ,


-- ** fontSize #attr:fontSize#
    getTextAttributesFontSize               ,
    setTextAttributesFontSize               ,
    textAttributes_fontSize                 ,


-- ** isUnderlined #attr:isUnderlined#
    getTextAttributesIsUnderlined           ,
    setTextAttributesIsUnderlined           ,
    textAttributes_isUnderlined             ,


-- ** startIndex #attr:startIndex#
    getTextAttributesStartIndex             ,
    setTextAttributesStartIndex             ,
    textAttributes_startIndex               ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP

import {-# SOURCE #-} qualified GI.Poppler.Structs.Color as Poppler.Color

newtype TextAttributes = TextAttributes (ManagedPtr TextAttributes)
foreign import ccall "poppler_text_attributes_get_type" c_poppler_text_attributes_get_type :: 
    IO GType

instance BoxedObject TextAttributes where
    boxedType _ = c_poppler_text_attributes_get_type

-- | Construct a `TextAttributes` struct initialized to zero.
newZeroTextAttributes :: MonadIO m => m TextAttributes
newZeroTextAttributes = liftIO $ callocBoxedBytes 40 >>= wrapBoxed TextAttributes

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


noTextAttributes :: Maybe TextAttributes
noTextAttributes = Nothing

getTextAttributesFontName :: MonadIO m => TextAttributes -> m (Maybe T.Text)
getTextAttributesFontName s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setTextAttributesFontName :: MonadIO m => TextAttributes -> CString -> m ()
setTextAttributesFontName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

clearTextAttributesFontName :: MonadIO m => TextAttributes -> m ()
clearTextAttributesFontName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

data TextAttributesFontNameFieldInfo
instance AttrInfo TextAttributesFontNameFieldInfo where
    type AttrAllowedOps TextAttributesFontNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint TextAttributesFontNameFieldInfo = (~) CString
    type AttrBaseTypeConstraint TextAttributesFontNameFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesFontNameFieldInfo = Maybe T.Text
    type AttrLabel TextAttributesFontNameFieldInfo = "font_name"
    type AttrOrigin TextAttributesFontNameFieldInfo = TextAttributes
    attrGet _ = getTextAttributesFontName
    attrSet _ = setTextAttributesFontName
    attrConstruct = undefined
    attrClear _ = clearTextAttributesFontName

textAttributes_fontName :: AttrLabelProxy "fontName"
textAttributes_fontName = AttrLabelProxy


getTextAttributesFontSize :: MonadIO m => TextAttributes -> m Double
getTextAttributesFontSize s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CDouble
    let val' = realToFrac val
    return val'

setTextAttributesFontSize :: MonadIO m => TextAttributes -> Double -> m ()
setTextAttributesFontSize s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = realToFrac val
    poke (ptr `plusPtr` 8) (val' :: CDouble)

data TextAttributesFontSizeFieldInfo
instance AttrInfo TextAttributesFontSizeFieldInfo where
    type AttrAllowedOps TextAttributesFontSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesFontSizeFieldInfo = (~) Double
    type AttrBaseTypeConstraint TextAttributesFontSizeFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesFontSizeFieldInfo = Double
    type AttrLabel TextAttributesFontSizeFieldInfo = "font_size"
    type AttrOrigin TextAttributesFontSizeFieldInfo = TextAttributes
    attrGet _ = getTextAttributesFontSize
    attrSet _ = setTextAttributesFontSize
    attrConstruct = undefined
    attrClear _ = undefined

textAttributes_fontSize :: AttrLabelProxy "fontSize"
textAttributes_fontSize = AttrLabelProxy


getTextAttributesIsUnderlined :: MonadIO m => TextAttributes -> m Bool
getTextAttributesIsUnderlined s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CInt
    let val' = (/= 0) val
    return val'

setTextAttributesIsUnderlined :: MonadIO m => TextAttributes -> Bool -> m ()
setTextAttributesIsUnderlined s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 16) (val' :: CInt)

data TextAttributesIsUnderlinedFieldInfo
instance AttrInfo TextAttributesIsUnderlinedFieldInfo where
    type AttrAllowedOps TextAttributesIsUnderlinedFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesIsUnderlinedFieldInfo = (~) Bool
    type AttrBaseTypeConstraint TextAttributesIsUnderlinedFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesIsUnderlinedFieldInfo = Bool
    type AttrLabel TextAttributesIsUnderlinedFieldInfo = "is_underlined"
    type AttrOrigin TextAttributesIsUnderlinedFieldInfo = TextAttributes
    attrGet _ = getTextAttributesIsUnderlined
    attrSet _ = setTextAttributesIsUnderlined
    attrConstruct = undefined
    attrClear _ = undefined

textAttributes_isUnderlined :: AttrLabelProxy "isUnderlined"
textAttributes_isUnderlined = AttrLabelProxy


getTextAttributesColor :: MonadIO m => TextAttributes -> m Poppler.Color.Color
getTextAttributesColor s = liftIO $ withManagedPtr s $ \ptr -> do
    let val = ptr `plusPtr` 20 :: (Ptr Poppler.Color.Color)
    val' <- (newBoxed Poppler.Color.Color) val
    return val'

data TextAttributesColorFieldInfo
instance AttrInfo TextAttributesColorFieldInfo where
    type AttrAllowedOps TextAttributesColorFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint TextAttributesColorFieldInfo = (~) (Ptr Poppler.Color.Color)
    type AttrBaseTypeConstraint TextAttributesColorFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesColorFieldInfo = Poppler.Color.Color
    type AttrLabel TextAttributesColorFieldInfo = "color"
    type AttrOrigin TextAttributesColorFieldInfo = TextAttributes
    attrGet _ = getTextAttributesColor
    attrSet _ = undefined
    attrConstruct = undefined
    attrClear _ = undefined

textAttributes_color :: AttrLabelProxy "color"
textAttributes_color = AttrLabelProxy


getTextAttributesStartIndex :: MonadIO m => TextAttributes -> m Int32
getTextAttributesStartIndex s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 28) :: IO Int32
    return val

setTextAttributesStartIndex :: MonadIO m => TextAttributes -> Int32 -> m ()
setTextAttributesStartIndex s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 28) (val :: Int32)

data TextAttributesStartIndexFieldInfo
instance AttrInfo TextAttributesStartIndexFieldInfo where
    type AttrAllowedOps TextAttributesStartIndexFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesStartIndexFieldInfo = (~) Int32
    type AttrBaseTypeConstraint TextAttributesStartIndexFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesStartIndexFieldInfo = Int32
    type AttrLabel TextAttributesStartIndexFieldInfo = "start_index"
    type AttrOrigin TextAttributesStartIndexFieldInfo = TextAttributes
    attrGet _ = getTextAttributesStartIndex
    attrSet _ = setTextAttributesStartIndex
    attrConstruct = undefined
    attrClear _ = undefined

textAttributes_startIndex :: AttrLabelProxy "startIndex"
textAttributes_startIndex = AttrLabelProxy


getTextAttributesEndIndex :: MonadIO m => TextAttributes -> m Int32
getTextAttributesEndIndex s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 32) :: IO Int32
    return val

setTextAttributesEndIndex :: MonadIO m => TextAttributes -> Int32 -> m ()
setTextAttributesEndIndex s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 32) (val :: Int32)

data TextAttributesEndIndexFieldInfo
instance AttrInfo TextAttributesEndIndexFieldInfo where
    type AttrAllowedOps TextAttributesEndIndexFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint TextAttributesEndIndexFieldInfo = (~) Int32
    type AttrBaseTypeConstraint TextAttributesEndIndexFieldInfo = (~) TextAttributes
    type AttrGetType TextAttributesEndIndexFieldInfo = Int32
    type AttrLabel TextAttributesEndIndexFieldInfo = "end_index"
    type AttrOrigin TextAttributesEndIndexFieldInfo = TextAttributes
    attrGet _ = getTextAttributesEndIndex
    attrSet _ = setTextAttributesEndIndex
    attrConstruct = undefined
    attrClear _ = undefined

textAttributes_endIndex :: AttrLabelProxy "endIndex"
textAttributes_endIndex = AttrLabelProxy



instance O.HasAttributeList TextAttributes
type instance O.AttributeList TextAttributes = TextAttributesAttributeList
type TextAttributesAttributeList = ('[ '("fontName", TextAttributesFontNameFieldInfo), '("fontSize", TextAttributesFontSizeFieldInfo), '("isUnderlined", TextAttributesIsUnderlinedFieldInfo), '("color", TextAttributesColorFieldInfo), '("startIndex", TextAttributesStartIndexFieldInfo), '("endIndex", TextAttributesEndIndexFieldInfo)] :: [(Symbol, *)])

-- method TextAttributes::new
-- method type : Constructor
-- Args : []
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Poppler", name = "TextAttributes"}))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_text_attributes_new" poppler_text_attributes_new :: 
    IO (Ptr TextAttributes)

{- |
Creates a new 'GI.Poppler.Structs.TextAttributes.TextAttributes'

@since 0.18
-}
textAttributesNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m TextAttributes
    {- ^ __Returns:__ a new 'GI.Poppler.Structs.TextAttributes.TextAttributes', use 'GI.Poppler.Structs.TextAttributes.textAttributesFree' to free it -}
textAttributesNew  = liftIO $ do
    result <- poppler_text_attributes_new
    checkUnexpectedReturnNULL "textAttributesNew" result
    result' <- (wrapBoxed TextAttributes) result
    return result'

-- method TextAttributes::copy
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "text_attrs", argType = TInterface (Name {namespace = "Poppler", name = "TextAttributes"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #PopplerTextAttributes to copy", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Poppler", name = "TextAttributes"}))
-- throws : False
-- Skip return : False

foreign import ccall "poppler_text_attributes_copy" poppler_text_attributes_copy :: 
    Ptr TextAttributes ->                   -- text_attrs : TInterface (Name {namespace = "Poppler", name = "TextAttributes"})
    IO (Ptr TextAttributes)

{- |
Creates a copy of /@textAttrs@/

@since 0.18
-}
textAttributesCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextAttributes
    {- ^ /@textAttrs@/: a 'GI.Poppler.Structs.TextAttributes.TextAttributes' to copy -}
    -> m TextAttributes
    {- ^ __Returns:__ a new allocated copy of /@textAttrs@/ -}
textAttributesCopy textAttrs = liftIO $ do
    textAttrs' <- unsafeManagedPtrGetPtr textAttrs
    result <- poppler_text_attributes_copy textAttrs'
    checkUnexpectedReturnNULL "textAttributesCopy" result
    result' <- (wrapBoxed TextAttributes) result
    touchManagedPtr textAttrs
    return result'

data TextAttributesCopyMethodInfo
instance (signature ~ (m TextAttributes), MonadIO m) => O.MethodInfo TextAttributesCopyMethodInfo TextAttributes signature where
    overloadedMethod _ = textAttributesCopy

-- method TextAttributes::free
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "text_attrs", argType = TInterface (Name {namespace = "Poppler", name = "TextAttributes"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #PopplerTextAttributes", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "poppler_text_attributes_free" poppler_text_attributes_free :: 
    Ptr TextAttributes ->                   -- text_attrs : TInterface (Name {namespace = "Poppler", name = "TextAttributes"})
    IO ()

{- |
Frees the given 'GI.Poppler.Structs.TextAttributes.TextAttributes'

@since 0.18
-}
textAttributesFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TextAttributes
    {- ^ /@textAttrs@/: a 'GI.Poppler.Structs.TextAttributes.TextAttributes' -}
    -> m ()
textAttributesFree textAttrs = liftIO $ do
    textAttrs' <- unsafeManagedPtrGetPtr textAttrs
    poppler_text_attributes_free textAttrs'
    touchManagedPtr textAttrs
    return ()

data TextAttributesFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo TextAttributesFreeMethodInfo TextAttributes signature where
    overloadedMethod _ = textAttributesFree

type family ResolveTextAttributesMethod (t :: Symbol) (o :: *) :: * where
    ResolveTextAttributesMethod "copy" o = TextAttributesCopyMethodInfo
    ResolveTextAttributesMethod "free" o = TextAttributesFreeMethodInfo
    ResolveTextAttributesMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveTextAttributesMethod t TextAttributes, O.MethodInfo info TextAttributes p) => O.IsLabelProxy t (TextAttributes -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

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