{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Poppler.Structs.ActionUri
    ( 

-- * Exported types
    ActionUri(..)                           ,
    newZeroActionUri                        ,
    noActionUri                             ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveActionUriMethod                  ,
#endif




 -- * Properties
-- ** title #attr:title#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionUri_title                         ,
#endif
    clearActionUriTitle                     ,
    getActionUriTitle                       ,
    setActionUriTitle                       ,


-- ** type #attr:type#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionUri_type                          ,
#endif
    getActionUriType                        ,
    setActionUriType                        ,


-- ** uri #attr:uri#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    actionUri_uri                           ,
#endif
    clearActionUriUri                       ,
    getActionUriUri                         ,
    setActionUriUri                         ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
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 qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Poppler.Enums as Poppler.Enums

-- | Memory-managed wrapper type.
newtype ActionUri = ActionUri (ManagedPtr ActionUri)
    deriving (ActionUri -> ActionUri -> Bool
(ActionUri -> ActionUri -> Bool)
-> (ActionUri -> ActionUri -> Bool) -> Eq ActionUri
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionUri -> ActionUri -> Bool
$c/= :: ActionUri -> ActionUri -> Bool
== :: ActionUri -> ActionUri -> Bool
$c== :: ActionUri -> ActionUri -> Bool
Eq)
instance WrappedPtr ActionUri where
    wrappedPtrCalloc :: IO (Ptr ActionUri)
wrappedPtrCalloc = Int -> IO (Ptr ActionUri)
forall a. Int -> IO (Ptr a)
callocBytes 24
    wrappedPtrCopy :: ActionUri -> IO ActionUri
wrappedPtrCopy = \p :: ActionUri
p -> ActionUri -> (Ptr ActionUri -> IO ActionUri) -> IO ActionUri
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
p (Int -> Ptr ActionUri -> IO (Ptr ActionUri)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 24 (Ptr ActionUri -> IO (Ptr ActionUri))
-> (Ptr ActionUri -> IO ActionUri) -> Ptr ActionUri -> IO ActionUri
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ActionUri -> ActionUri)
-> Ptr ActionUri -> IO ActionUri
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionUri -> ActionUri
ActionUri)
    wrappedPtrFree :: Maybe (GDestroyNotify ActionUri)
wrappedPtrFree = GDestroyNotify ActionUri -> Maybe (GDestroyNotify ActionUri)
forall a. a -> Maybe a
Just GDestroyNotify ActionUri
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `ActionUri` struct initialized to zero.
newZeroActionUri :: MonadIO m => m ActionUri
newZeroActionUri :: m ActionUri
newZeroActionUri = IO ActionUri -> m ActionUri
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionUri -> m ActionUri) -> IO ActionUri -> m ActionUri
forall a b. (a -> b) -> a -> b
$ IO (Ptr ActionUri)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr ActionUri)
-> (Ptr ActionUri -> IO ActionUri) -> IO ActionUri
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ActionUri -> ActionUri)
-> Ptr ActionUri -> IO ActionUri
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ActionUri -> ActionUri
ActionUri

instance tag ~ 'AttrSet => Constructible ActionUri tag where
    new :: (ManagedPtr ActionUri -> ActionUri)
-> [AttrOp ActionUri tag] -> m ActionUri
new _ attrs :: [AttrOp ActionUri tag]
attrs = do
        ActionUri
o <- m ActionUri
forall (m :: * -> *). MonadIO m => m ActionUri
newZeroActionUri
        ActionUri -> [AttrOp ActionUri 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ActionUri
o [AttrOp ActionUri tag]
[AttrOp ActionUri 'AttrSet]
attrs
        ActionUri -> m ActionUri
forall (m :: * -> *) a. Monad m => a -> m a
return ActionUri
o


-- | A convenience alias for `Nothing` :: `Maybe` `ActionUri`.
noActionUri :: Maybe ActionUri
noActionUri :: Maybe ActionUri
noActionUri = Maybe ActionUri
forall a. Maybe a
Nothing

-- | Get the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionUri #type
-- @
getActionUriType :: MonadIO m => ActionUri -> m Poppler.Enums.ActionType
getActionUriType :: ActionUri -> m ActionType
getActionUriType s :: ActionUri
s = IO ActionType -> m ActionType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActionType -> m ActionType) -> IO ActionType -> m ActionType
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ActionType) -> IO ActionType
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ActionType) -> IO ActionType)
-> (Ptr ActionUri -> IO ActionType) -> IO ActionType
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CUInt
    let val' :: ActionType
val' = (Int -> ActionType
forall a. Enum a => Int -> a
toEnum (Int -> ActionType) -> (CUInt -> Int) -> CUInt -> ActionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    ActionType -> IO ActionType
forall (m :: * -> *) a. Monad m => a -> m a
return ActionType
val'

-- | Set the value of the “@type@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionUri [ #type 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionUriType :: MonadIO m => ActionUri -> Poppler.Enums.ActionType -> m ()
setActionUriType :: ActionUri -> ActionType -> m ()
setActionUriType s :: ActionUri
s val :: ActionType
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ()) -> IO ())
-> (Ptr ActionUri -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ActionType -> Int) -> ActionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionType -> Int
forall a. Enum a => a -> Int
fromEnum) ActionType
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ActionUriTypeFieldInfo
instance AttrInfo ActionUriTypeFieldInfo where
    type AttrBaseTypeConstraint ActionUriTypeFieldInfo = (~) ActionUri
    type AttrAllowedOps ActionUriTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ActionUriTypeFieldInfo = (~) Poppler.Enums.ActionType
    type AttrTransferTypeConstraint ActionUriTypeFieldInfo = (~)Poppler.Enums.ActionType
    type AttrTransferType ActionUriTypeFieldInfo = Poppler.Enums.ActionType
    type AttrGetType ActionUriTypeFieldInfo = Poppler.Enums.ActionType
    type AttrLabel ActionUriTypeFieldInfo = "type"
    type AttrOrigin ActionUriTypeFieldInfo = ActionUri
    attrGet = getActionUriType
    attrSet = setActionUriType
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

actionUri_type :: AttrLabelProxy "type"
actionUri_type = AttrLabelProxy

#endif


-- | Get the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionUri #title
-- @
getActionUriTitle :: MonadIO m => ActionUri -> m (Maybe T.Text)
getActionUriTitle :: ActionUri -> m (Maybe Text)
getActionUriTitle s :: ActionUri
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \val' :: CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionUri [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionUriTitle :: MonadIO m => ActionUri -> CString -> m ()
setActionUriTitle :: ActionUri -> CString -> m ()
setActionUriTitle s :: ActionUri
s val :: CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ()) -> IO ())
-> (Ptr ActionUri -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CString
val :: CString)

-- | Set the value of the “@title@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearActionUriTitle :: MonadIO m => ActionUri -> m ()
clearActionUriTitle :: ActionUri -> m ()
clearActionUriTitle s :: ActionUri
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ()) -> IO ())
-> (Ptr ActionUri -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionUriTitleFieldInfo
instance AttrInfo ActionUriTitleFieldInfo where
    type AttrBaseTypeConstraint ActionUriTitleFieldInfo = (~) ActionUri
    type AttrAllowedOps ActionUriTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionUriTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionUriTitleFieldInfo = (~)CString
    type AttrTransferType ActionUriTitleFieldInfo = CString
    type AttrGetType ActionUriTitleFieldInfo = Maybe T.Text
    type AttrLabel ActionUriTitleFieldInfo = "title"
    type AttrOrigin ActionUriTitleFieldInfo = ActionUri
    attrGet = getActionUriTitle
    attrSet = setActionUriTitle
    attrConstruct = undefined
    attrClear = clearActionUriTitle
    attrTransfer _ v = do
        return v

actionUri_title :: AttrLabelProxy "title"
actionUri_title = AttrLabelProxy

#endif


-- | Get the value of the “@uri@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' actionUri #uri
-- @
getActionUriUri :: MonadIO m => ActionUri -> m (Maybe T.Text)
getActionUriUri :: ActionUri -> m (Maybe Text)
getActionUriUri s :: ActionUri
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ActionUri -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \val' :: CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@uri@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' actionUri [ #uri 'Data.GI.Base.Attributes.:=' value ]
-- @
setActionUriUri :: MonadIO m => ActionUri -> CString -> m ()
setActionUriUri :: ActionUri -> CString -> m ()
setActionUriUri s :: ActionUri
s val :: CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ()) -> IO ())
-> (Ptr ActionUri -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CString
val :: CString)

-- | Set the value of the “@uri@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #uri
-- @
clearActionUriUri :: MonadIO m => ActionUri -> m ()
clearActionUriUri :: ActionUri -> m ()
clearActionUriUri s :: ActionUri
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ActionUri -> (Ptr ActionUri -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ActionUri
s ((Ptr ActionUri -> IO ()) -> IO ())
-> (Ptr ActionUri -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ActionUri
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ActionUri
ptr Ptr ActionUri -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ActionUriUriFieldInfo
instance AttrInfo ActionUriUriFieldInfo where
    type AttrBaseTypeConstraint ActionUriUriFieldInfo = (~) ActionUri
    type AttrAllowedOps ActionUriUriFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ActionUriUriFieldInfo = (~) CString
    type AttrTransferTypeConstraint ActionUriUriFieldInfo = (~)CString
    type AttrTransferType ActionUriUriFieldInfo = CString
    type AttrGetType ActionUriUriFieldInfo = Maybe T.Text
    type AttrLabel ActionUriUriFieldInfo = "uri"
    type AttrOrigin ActionUriUriFieldInfo = ActionUri
    attrGet = getActionUriUri
    attrSet = setActionUriUri
    attrConstruct = undefined
    attrClear = clearActionUriUri
    attrTransfer _ v = do
        return v

actionUri_uri :: AttrLabelProxy "uri"
actionUri_uri = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ActionUri
type instance O.AttributeList ActionUri = ActionUriAttributeList
type ActionUriAttributeList = ('[ '("type", ActionUriTypeFieldInfo), '("title", ActionUriTitleFieldInfo), '("uri", ActionUriUriFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveActionUriMethod (t :: Symbol) (o :: *) :: * where
    ResolveActionUriMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveActionUriMethod t ActionUri, O.MethodInfo info ActionUri p) => OL.IsLabel t (ActionUri -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif