{-# LINE 1 "src/KB/Text/Shape/FFI/Handles.hsc" #-}
module KB.Text.Shape.FFI.Handles where

import Foreign
import Data.Coerce (Coercible, coerce)



{-# INLINE intHandle #-}
intHandle :: Coercible h (Ptr a) => h -> Int
intHandle :: forall h a. Coercible h (Ptr a) => h -> Int
intHandle h
ptrLike = Int
i
  where
   IntPtr Int
i = Ptr (ZonkAny 0) -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr (h -> Ptr (ZonkAny 0)
forall a b. Coercible a b => a -> b
coerce h
ptrLike)

-- | An opaque handle to the shaping context..
newtype ShapeContext = ShapeContext (Ptr ShapeContext)
  deriving (ShapeContext -> ShapeContext -> Bool
(ShapeContext -> ShapeContext -> Bool)
-> (ShapeContext -> ShapeContext -> Bool) -> Eq ShapeContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShapeContext -> ShapeContext -> Bool
== :: ShapeContext -> ShapeContext -> Bool
$c/= :: ShapeContext -> ShapeContext -> Bool
/= :: ShapeContext -> ShapeContext -> Bool
Eq, Eq ShapeContext
Eq ShapeContext =>
(ShapeContext -> ShapeContext -> Ordering)
-> (ShapeContext -> ShapeContext -> Bool)
-> (ShapeContext -> ShapeContext -> Bool)
-> (ShapeContext -> ShapeContext -> Bool)
-> (ShapeContext -> ShapeContext -> Bool)
-> (ShapeContext -> ShapeContext -> ShapeContext)
-> (ShapeContext -> ShapeContext -> ShapeContext)
-> Ord ShapeContext
ShapeContext -> ShapeContext -> Bool
ShapeContext -> ShapeContext -> Ordering
ShapeContext -> ShapeContext -> ShapeContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShapeContext -> ShapeContext -> Ordering
compare :: ShapeContext -> ShapeContext -> Ordering
$c< :: ShapeContext -> ShapeContext -> Bool
< :: ShapeContext -> ShapeContext -> Bool
$c<= :: ShapeContext -> ShapeContext -> Bool
<= :: ShapeContext -> ShapeContext -> Bool
$c> :: ShapeContext -> ShapeContext -> Bool
> :: ShapeContext -> ShapeContext -> Bool
$c>= :: ShapeContext -> ShapeContext -> Bool
>= :: ShapeContext -> ShapeContext -> Bool
$cmax :: ShapeContext -> ShapeContext -> ShapeContext
max :: ShapeContext -> ShapeContext -> ShapeContext
$cmin :: ShapeContext -> ShapeContext -> ShapeContext
min :: ShapeContext -> ShapeContext -> ShapeContext
Ord, Int -> ShapeContext -> ShowS
[ShapeContext] -> ShowS
ShapeContext -> String
(Int -> ShapeContext -> ShowS)
-> (ShapeContext -> String)
-> ([ShapeContext] -> ShowS)
-> Show ShapeContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShapeContext -> ShowS
showsPrec :: Int -> ShapeContext -> ShowS
$cshow :: ShapeContext -> String
show :: ShapeContext -> String
$cshowList :: [ShapeContext] -> ShowS
showList :: [ShapeContext] -> ShowS
Show)
  deriving newtype (Ptr ShapeContext -> IO ShapeContext
Ptr ShapeContext -> Int -> IO ShapeContext
Ptr ShapeContext -> Int -> ShapeContext -> IO ()
Ptr ShapeContext -> ShapeContext -> IO ()
ShapeContext -> Int
(ShapeContext -> Int)
-> (ShapeContext -> Int)
-> (Ptr ShapeContext -> Int -> IO ShapeContext)
-> (Ptr ShapeContext -> Int -> ShapeContext -> IO ())
-> (forall b. Ptr b -> Int -> IO ShapeContext)
-> (forall b. Ptr b -> Int -> ShapeContext -> IO ())
-> (Ptr ShapeContext -> IO ShapeContext)
-> (Ptr ShapeContext -> ShapeContext -> IO ())
-> Storable ShapeContext
forall b. Ptr b -> Int -> IO ShapeContext
forall b. Ptr b -> Int -> ShapeContext -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: ShapeContext -> Int
sizeOf :: ShapeContext -> Int
$calignment :: ShapeContext -> Int
alignment :: ShapeContext -> Int
$cpeekElemOff :: Ptr ShapeContext -> Int -> IO ShapeContext
peekElemOff :: Ptr ShapeContext -> Int -> IO ShapeContext
$cpokeElemOff :: Ptr ShapeContext -> Int -> ShapeContext -> IO ()
pokeElemOff :: Ptr ShapeContext -> Int -> ShapeContext -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ShapeContext
peekByteOff :: forall b. Ptr b -> Int -> IO ShapeContext
$cpokeByteOff :: forall b. Ptr b -> Int -> ShapeContext -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ShapeContext -> IO ()
$cpeek :: Ptr ShapeContext -> IO ShapeContext
peek :: Ptr ShapeContext -> IO ShapeContext
$cpoke :: Ptr ShapeContext -> ShapeContext -> IO ()
poke :: Ptr ShapeContext -> ShapeContext -> IO ()
Storable)

-- | An opaque handle to the font data.
newtype Font = Font (Ptr Font)
  deriving (Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
/= :: Font -> Font -> Bool
Eq, Eq Font
Eq Font =>
(Font -> Font -> Ordering)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Font)
-> (Font -> Font -> Font)
-> Ord Font
Font -> Font -> Bool
Font -> Font -> Ordering
Font -> Font -> Font
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Font -> Font -> Ordering
compare :: Font -> Font -> Ordering
$c< :: Font -> Font -> Bool
< :: Font -> Font -> Bool
$c<= :: Font -> Font -> Bool
<= :: Font -> Font -> Bool
$c> :: Font -> Font -> Bool
> :: Font -> Font -> Bool
$c>= :: Font -> Font -> Bool
>= :: Font -> Font -> Bool
$cmax :: Font -> Font -> Font
max :: Font -> Font -> Font
$cmin :: Font -> Font -> Font
min :: Font -> Font -> Font
Ord, Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Font -> ShowS
showsPrec :: Int -> Font -> ShowS
$cshow :: Font -> String
show :: Font -> String
$cshowList :: [Font] -> ShowS
showList :: [Font] -> ShowS
Show)
  deriving newtype (Ptr Font -> IO Font
Ptr Font -> Int -> IO Font
Ptr Font -> Int -> Font -> IO ()
Ptr Font -> Font -> IO ()
Font -> Int
(Font -> Int)
-> (Font -> Int)
-> (Ptr Font -> Int -> IO Font)
-> (Ptr Font -> Int -> Font -> IO ())
-> (forall b. Ptr b -> Int -> IO Font)
-> (forall b. Ptr b -> Int -> Font -> IO ())
-> (Ptr Font -> IO Font)
-> (Ptr Font -> Font -> IO ())
-> Storable Font
forall b. Ptr b -> Int -> IO Font
forall b. Ptr b -> Int -> Font -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: Font -> Int
sizeOf :: Font -> Int
$calignment :: Font -> Int
alignment :: Font -> Int
$cpeekElemOff :: Ptr Font -> Int -> IO Font
peekElemOff :: Ptr Font -> Int -> IO Font
$cpokeElemOff :: Ptr Font -> Int -> Font -> IO ()
pokeElemOff :: Ptr Font -> Int -> Font -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Font
peekByteOff :: forall b. Ptr b -> Int -> IO Font
$cpokeByteOff :: forall b. Ptr b -> Int -> Font -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Font -> IO ()
$cpeek :: Ptr Font -> IO Font
peek :: Ptr Font -> IO Font
$cpoke :: Ptr Font -> Font -> IO ()
poke :: Ptr Font -> Font -> IO ()
Storable)

{- | Amount of bytes needed to hold the font data structure

Usually you don't have to look inside, but may have to allocate one to get the 'Font' handle.
-}
sizeOfFontData :: Int
sizeOfFontData :: Int
sizeOfFontData = (Int
72)
{-# LINE 30 "src/KB/Text/Shape/FFI/Handles.hsc" #-}

newtype ShapeConfig = ShapeConfig (Ptr ShapeConfig)
  deriving (ShapeConfig -> ShapeConfig -> Bool
(ShapeConfig -> ShapeConfig -> Bool)
-> (ShapeConfig -> ShapeConfig -> Bool) -> Eq ShapeConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShapeConfig -> ShapeConfig -> Bool
== :: ShapeConfig -> ShapeConfig -> Bool
$c/= :: ShapeConfig -> ShapeConfig -> Bool
/= :: ShapeConfig -> ShapeConfig -> Bool
Eq, Eq ShapeConfig
Eq ShapeConfig =>
(ShapeConfig -> ShapeConfig -> Ordering)
-> (ShapeConfig -> ShapeConfig -> Bool)
-> (ShapeConfig -> ShapeConfig -> Bool)
-> (ShapeConfig -> ShapeConfig -> Bool)
-> (ShapeConfig -> ShapeConfig -> Bool)
-> (ShapeConfig -> ShapeConfig -> ShapeConfig)
-> (ShapeConfig -> ShapeConfig -> ShapeConfig)
-> Ord ShapeConfig
ShapeConfig -> ShapeConfig -> Bool
ShapeConfig -> ShapeConfig -> Ordering
ShapeConfig -> ShapeConfig -> ShapeConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ShapeConfig -> ShapeConfig -> Ordering
compare :: ShapeConfig -> ShapeConfig -> Ordering
$c< :: ShapeConfig -> ShapeConfig -> Bool
< :: ShapeConfig -> ShapeConfig -> Bool
$c<= :: ShapeConfig -> ShapeConfig -> Bool
<= :: ShapeConfig -> ShapeConfig -> Bool
$c> :: ShapeConfig -> ShapeConfig -> Bool
> :: ShapeConfig -> ShapeConfig -> Bool
$c>= :: ShapeConfig -> ShapeConfig -> Bool
>= :: ShapeConfig -> ShapeConfig -> Bool
$cmax :: ShapeConfig -> ShapeConfig -> ShapeConfig
max :: ShapeConfig -> ShapeConfig -> ShapeConfig
$cmin :: ShapeConfig -> ShapeConfig -> ShapeConfig
min :: ShapeConfig -> ShapeConfig -> ShapeConfig
Ord, Int -> ShapeConfig -> ShowS
[ShapeConfig] -> ShowS
ShapeConfig -> String
(Int -> ShapeConfig -> ShowS)
-> (ShapeConfig -> String)
-> ([ShapeConfig] -> ShowS)
-> Show ShapeConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShapeConfig -> ShowS
showsPrec :: Int -> ShapeConfig -> ShowS
$cshow :: ShapeConfig -> String
show :: ShapeConfig -> String
$cshowList :: [ShapeConfig] -> ShowS
showList :: [ShapeConfig] -> ShowS
Show)
  deriving newtype (Ptr ShapeConfig -> IO ShapeConfig
Ptr ShapeConfig -> Int -> IO ShapeConfig
Ptr ShapeConfig -> Int -> ShapeConfig -> IO ()
Ptr ShapeConfig -> ShapeConfig -> IO ()
ShapeConfig -> Int
(ShapeConfig -> Int)
-> (ShapeConfig -> Int)
-> (Ptr ShapeConfig -> Int -> IO ShapeConfig)
-> (Ptr ShapeConfig -> Int -> ShapeConfig -> IO ())
-> (forall b. Ptr b -> Int -> IO ShapeConfig)
-> (forall b. Ptr b -> Int -> ShapeConfig -> IO ())
-> (Ptr ShapeConfig -> IO ShapeConfig)
-> (Ptr ShapeConfig -> ShapeConfig -> IO ())
-> Storable ShapeConfig
forall b. Ptr b -> Int -> IO ShapeConfig
forall b. Ptr b -> Int -> ShapeConfig -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: ShapeConfig -> Int
sizeOf :: ShapeConfig -> Int
$calignment :: ShapeConfig -> Int
alignment :: ShapeConfig -> Int
$cpeekElemOff :: Ptr ShapeConfig -> Int -> IO ShapeConfig
peekElemOff :: Ptr ShapeConfig -> Int -> IO ShapeConfig
$cpokeElemOff :: Ptr ShapeConfig -> Int -> ShapeConfig -> IO ()
pokeElemOff :: Ptr ShapeConfig -> Int -> ShapeConfig -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ShapeConfig
peekByteOff :: forall b. Ptr b -> Int -> IO ShapeConfig
$cpokeByteOff :: forall b. Ptr b -> Int -> ShapeConfig -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ShapeConfig -> IO ()
$cpeek :: Ptr ShapeConfig -> IO ShapeConfig
peek :: Ptr ShapeConfig -> IO ShapeConfig
$cpoke :: Ptr ShapeConfig -> ShapeConfig -> IO ()
poke :: Ptr ShapeConfig -> ShapeConfig -> IO ()
Storable)

newtype GlyphConfig = GlyphConfig (Ptr GlyphConfig)
  deriving (GlyphConfig -> GlyphConfig -> Bool
(GlyphConfig -> GlyphConfig -> Bool)
-> (GlyphConfig -> GlyphConfig -> Bool) -> Eq GlyphConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlyphConfig -> GlyphConfig -> Bool
== :: GlyphConfig -> GlyphConfig -> Bool
$c/= :: GlyphConfig -> GlyphConfig -> Bool
/= :: GlyphConfig -> GlyphConfig -> Bool
Eq, Eq GlyphConfig
Eq GlyphConfig =>
(GlyphConfig -> GlyphConfig -> Ordering)
-> (GlyphConfig -> GlyphConfig -> Bool)
-> (GlyphConfig -> GlyphConfig -> Bool)
-> (GlyphConfig -> GlyphConfig -> Bool)
-> (GlyphConfig -> GlyphConfig -> Bool)
-> (GlyphConfig -> GlyphConfig -> GlyphConfig)
-> (GlyphConfig -> GlyphConfig -> GlyphConfig)
-> Ord GlyphConfig
GlyphConfig -> GlyphConfig -> Bool
GlyphConfig -> GlyphConfig -> Ordering
GlyphConfig -> GlyphConfig -> GlyphConfig
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GlyphConfig -> GlyphConfig -> Ordering
compare :: GlyphConfig -> GlyphConfig -> Ordering
$c< :: GlyphConfig -> GlyphConfig -> Bool
< :: GlyphConfig -> GlyphConfig -> Bool
$c<= :: GlyphConfig -> GlyphConfig -> Bool
<= :: GlyphConfig -> GlyphConfig -> Bool
$c> :: GlyphConfig -> GlyphConfig -> Bool
> :: GlyphConfig -> GlyphConfig -> Bool
$c>= :: GlyphConfig -> GlyphConfig -> Bool
>= :: GlyphConfig -> GlyphConfig -> Bool
$cmax :: GlyphConfig -> GlyphConfig -> GlyphConfig
max :: GlyphConfig -> GlyphConfig -> GlyphConfig
$cmin :: GlyphConfig -> GlyphConfig -> GlyphConfig
min :: GlyphConfig -> GlyphConfig -> GlyphConfig
Ord, Int -> GlyphConfig -> ShowS
[GlyphConfig] -> ShowS
GlyphConfig -> String
(Int -> GlyphConfig -> ShowS)
-> (GlyphConfig -> String)
-> ([GlyphConfig] -> ShowS)
-> Show GlyphConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlyphConfig -> ShowS
showsPrec :: Int -> GlyphConfig -> ShowS
$cshow :: GlyphConfig -> String
show :: GlyphConfig -> String
$cshowList :: [GlyphConfig] -> ShowS
showList :: [GlyphConfig] -> ShowS
Show)
  deriving newtype (Ptr GlyphConfig -> IO GlyphConfig
Ptr GlyphConfig -> Int -> IO GlyphConfig
Ptr GlyphConfig -> Int -> GlyphConfig -> IO ()
Ptr GlyphConfig -> GlyphConfig -> IO ()
GlyphConfig -> Int
(GlyphConfig -> Int)
-> (GlyphConfig -> Int)
-> (Ptr GlyphConfig -> Int -> IO GlyphConfig)
-> (Ptr GlyphConfig -> Int -> GlyphConfig -> IO ())
-> (forall b. Ptr b -> Int -> IO GlyphConfig)
-> (forall b. Ptr b -> Int -> GlyphConfig -> IO ())
-> (Ptr GlyphConfig -> IO GlyphConfig)
-> (Ptr GlyphConfig -> GlyphConfig -> IO ())
-> Storable GlyphConfig
forall b. Ptr b -> Int -> IO GlyphConfig
forall b. Ptr b -> Int -> GlyphConfig -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: GlyphConfig -> Int
sizeOf :: GlyphConfig -> Int
$calignment :: GlyphConfig -> Int
alignment :: GlyphConfig -> Int
$cpeekElemOff :: Ptr GlyphConfig -> Int -> IO GlyphConfig
peekElemOff :: Ptr GlyphConfig -> Int -> IO GlyphConfig
$cpokeElemOff :: Ptr GlyphConfig -> Int -> GlyphConfig -> IO ()
pokeElemOff :: Ptr GlyphConfig -> Int -> GlyphConfig -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO GlyphConfig
peekByteOff :: forall b. Ptr b -> Int -> IO GlyphConfig
$cpokeByteOff :: forall b. Ptr b -> Int -> GlyphConfig -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> GlyphConfig -> IO ()
$cpeek :: Ptr GlyphConfig -> IO GlyphConfig
peek :: Ptr GlyphConfig -> IO GlyphConfig
$cpoke :: Ptr GlyphConfig -> GlyphConfig -> IO ()
poke :: Ptr GlyphConfig -> GlyphConfig -> IO ()
Storable)

newtype BreakState = BreakState (Ptr BreakState)
  deriving (BreakState -> BreakState -> Bool
(BreakState -> BreakState -> Bool)
-> (BreakState -> BreakState -> Bool) -> Eq BreakState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BreakState -> BreakState -> Bool
== :: BreakState -> BreakState -> Bool
$c/= :: BreakState -> BreakState -> Bool
/= :: BreakState -> BreakState -> Bool
Eq, Eq BreakState
Eq BreakState =>
(BreakState -> BreakState -> Ordering)
-> (BreakState -> BreakState -> Bool)
-> (BreakState -> BreakState -> Bool)
-> (BreakState -> BreakState -> Bool)
-> (BreakState -> BreakState -> Bool)
-> (BreakState -> BreakState -> BreakState)
-> (BreakState -> BreakState -> BreakState)
-> Ord BreakState
BreakState -> BreakState -> Bool
BreakState -> BreakState -> Ordering
BreakState -> BreakState -> BreakState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BreakState -> BreakState -> Ordering
compare :: BreakState -> BreakState -> Ordering
$c< :: BreakState -> BreakState -> Bool
< :: BreakState -> BreakState -> Bool
$c<= :: BreakState -> BreakState -> Bool
<= :: BreakState -> BreakState -> Bool
$c> :: BreakState -> BreakState -> Bool
> :: BreakState -> BreakState -> Bool
$c>= :: BreakState -> BreakState -> Bool
>= :: BreakState -> BreakState -> Bool
$cmax :: BreakState -> BreakState -> BreakState
max :: BreakState -> BreakState -> BreakState
$cmin :: BreakState -> BreakState -> BreakState
min :: BreakState -> BreakState -> BreakState
Ord, Int -> BreakState -> ShowS
[BreakState] -> ShowS
BreakState -> String
(Int -> BreakState -> ShowS)
-> (BreakState -> String)
-> ([BreakState] -> ShowS)
-> Show BreakState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BreakState -> ShowS
showsPrec :: Int -> BreakState -> ShowS
$cshow :: BreakState -> String
show :: BreakState -> String
$cshowList :: [BreakState] -> ShowS
showList :: [BreakState] -> ShowS
Show)
  deriving newtype (Ptr BreakState -> IO BreakState
Ptr BreakState -> Int -> IO BreakState
Ptr BreakState -> Int -> BreakState -> IO ()
Ptr BreakState -> BreakState -> IO ()
BreakState -> Int
(BreakState -> Int)
-> (BreakState -> Int)
-> (Ptr BreakState -> Int -> IO BreakState)
-> (Ptr BreakState -> Int -> BreakState -> IO ())
-> (forall b. Ptr b -> Int -> IO BreakState)
-> (forall b. Ptr b -> Int -> BreakState -> IO ())
-> (Ptr BreakState -> IO BreakState)
-> (Ptr BreakState -> BreakState -> IO ())
-> Storable BreakState
forall b. Ptr b -> Int -> IO BreakState
forall b. Ptr b -> Int -> BreakState -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: BreakState -> Int
sizeOf :: BreakState -> Int
$calignment :: BreakState -> Int
alignment :: BreakState -> Int
$cpeekElemOff :: Ptr BreakState -> Int -> IO BreakState
peekElemOff :: Ptr BreakState -> Int -> IO BreakState
$cpokeElemOff :: Ptr BreakState -> Int -> BreakState -> IO ()
pokeElemOff :: Ptr BreakState -> Int -> BreakState -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BreakState
peekByteOff :: forall b. Ptr b -> Int -> IO BreakState
$cpokeByteOff :: forall b. Ptr b -> Int -> BreakState -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BreakState -> IO ()
$cpeek :: Ptr BreakState -> IO BreakState
peek :: Ptr BreakState -> IO BreakState
$cpoke :: Ptr BreakState -> BreakState -> IO ()
poke :: Ptr BreakState -> BreakState -> IO ()
Storable)