-- | Information on explicit allocation/deallocation for foreign pointers.
module Data.GI.GIR.Allocation
    ( AllocationInfo(..)
    , AllocationOp(..)
    , unknownAllocationInfo
    ) where

import Data.Text (Text)

-- | Allocation/deallocation information for a given foreign pointer.
data AllocationInfo = AllocationInfo {
      AllocationInfo -> AllocationOp
allocCalloc :: AllocationOp
    , AllocationInfo -> AllocationOp
allocCopy   :: AllocationOp
    , AllocationInfo -> AllocationOp
allocFree   :: AllocationOp
    } deriving (Int -> AllocationInfo -> ShowS
[AllocationInfo] -> ShowS
AllocationInfo -> String
(Int -> AllocationInfo -> ShowS)
-> (AllocationInfo -> String)
-> ([AllocationInfo] -> ShowS)
-> Show AllocationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllocationInfo -> ShowS
showsPrec :: Int -> AllocationInfo -> ShowS
$cshow :: AllocationInfo -> String
show :: AllocationInfo -> String
$cshowList :: [AllocationInfo] -> ShowS
showList :: [AllocationInfo] -> ShowS
Show)

-- | Information about a given allocation operation. It is either disallowed,
-- allowed via the given function, or it is unknown at the current
-- stage how to perform the operation.
data AllocationOp = AllocationOpUnknown
                  | AllocationOp Text
                    deriving (Int -> AllocationOp -> ShowS
[AllocationOp] -> ShowS
AllocationOp -> String
(Int -> AllocationOp -> ShowS)
-> (AllocationOp -> String)
-> ([AllocationOp] -> ShowS)
-> Show AllocationOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllocationOp -> ShowS
showsPrec :: Int -> AllocationOp -> ShowS
$cshow :: AllocationOp -> String
show :: AllocationOp -> String
$cshowList :: [AllocationOp] -> ShowS
showList :: [AllocationOp] -> ShowS
Show, AllocationOp -> AllocationOp -> Bool
(AllocationOp -> AllocationOp -> Bool)
-> (AllocationOp -> AllocationOp -> Bool) -> Eq AllocationOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllocationOp -> AllocationOp -> Bool
== :: AllocationOp -> AllocationOp -> Bool
$c/= :: AllocationOp -> AllocationOp -> Bool
/= :: AllocationOp -> AllocationOp -> Bool
Eq)

-- | A convenience function, filling in all the allocation info to unknown.
unknownAllocationInfo :: AllocationInfo
unknownAllocationInfo :: AllocationInfo
unknownAllocationInfo = AllocationInfo {
                          allocCalloc :: AllocationOp
allocCalloc = AllocationOp
AllocationOpUnknown
                        , allocCopy :: AllocationOp
allocCopy = AllocationOp
AllocationOpUnknown
                        , allocFree :: AllocationOp
allocFree = AllocationOp
AllocationOpUnknown
                        }