{-# LINE 1 "src/KB/Text/Shape/FFI/Enums.hsc" #-}
module KB.Text.Shape.FFI.Enums
  ( module KB.Text.Shape.FFI.Enums
  , module RE
  ) where

import Foreign

import KB.Text.Shape.FFI.Enums.FeatureTag as RE
import KB.Text.Shape.FFI.Enums.Language as RE
import KB.Text.Shape.FFI.Enums.Script as RE



-- ** Version

newtype Version = Version Word32
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
Eq, Eq Version
Eq Version =>
(Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Ordering
compare :: Version -> Version -> Ordering
$c< :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
>= :: Version -> Version -> Bool
$cmax :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
min :: Version -> Version -> Version
Ord)
  deriving newtype (Ptr Version -> IO Version
Ptr Version -> Int -> IO Version
Ptr Version -> Int -> Version -> IO ()
Ptr Version -> Version -> IO ()
Version -> Int
(Version -> Int)
-> (Version -> Int)
-> (Ptr Version -> Int -> IO Version)
-> (Ptr Version -> Int -> Version -> IO ())
-> (forall b. Ptr b -> Int -> IO Version)
-> (forall b. Ptr b -> Int -> Version -> IO ())
-> (Ptr Version -> IO Version)
-> (Ptr Version -> Version -> IO ())
-> Storable Version
forall b. Ptr b -> Int -> IO Version
forall b. Ptr b -> Int -> Version -> 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 :: Version -> Int
sizeOf :: Version -> Int
$calignment :: Version -> Int
alignment :: Version -> Int
$cpeekElemOff :: Ptr Version -> Int -> IO Version
peekElemOff :: Ptr Version -> Int -> IO Version
$cpokeElemOff :: Ptr Version -> Int -> Version -> IO ()
pokeElemOff :: Ptr Version -> Int -> Version -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Version
peekByteOff :: forall b. Ptr b -> Int -> IO Version
$cpokeByteOff :: forall b. Ptr b -> Int -> Version -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Version -> IO ()
$cpeek :: Ptr Version -> IO Version
peek :: Ptr Version -> IO Version
$cpoke :: Ptr Version -> Version -> IO ()
poke :: Ptr Version -> Version -> IO ()
Storable)

instance Show Version where
  showsPrec :: Int -> Version -> ShowS
showsPrec Int
d = \case
    Version
VERSION_1_X -> String -> ShowS
showString String
"VERSION_1_X"
    Version
VERSION_2_0 -> String -> ShowS
showString String
"VERSION_2_0"
    Version Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Version " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern VERSION_1_X :: Version
pattern $mVERSION_1_X :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bVERSION_1_X :: Version
VERSION_1_X = Version (0)
{-# LINE 28 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern VERSION_2_0 :: Version
pattern $mVERSION_2_0 :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bVERSION_2_0 :: Version
VERSION_2_0 = Version (1)
{-# LINE 31 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern VERSION_CURRENT :: Version
pattern $mVERSION_CURRENT :: forall {r}. Version -> ((# #) -> r) -> ((# #) -> r) -> r
$bVERSION_CURRENT :: Version
VERSION_CURRENT = Version (1)
{-# LINE 34 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- ** BlobVersion

newtype BlobVersion = BlobVersion Word32
  deriving (BlobVersion -> BlobVersion -> Bool
(BlobVersion -> BlobVersion -> Bool)
-> (BlobVersion -> BlobVersion -> Bool) -> Eq BlobVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlobVersion -> BlobVersion -> Bool
== :: BlobVersion -> BlobVersion -> Bool
$c/= :: BlobVersion -> BlobVersion -> Bool
/= :: BlobVersion -> BlobVersion -> Bool
Eq, Eq BlobVersion
Eq BlobVersion =>
(BlobVersion -> BlobVersion -> Ordering)
-> (BlobVersion -> BlobVersion -> Bool)
-> (BlobVersion -> BlobVersion -> Bool)
-> (BlobVersion -> BlobVersion -> Bool)
-> (BlobVersion -> BlobVersion -> Bool)
-> (BlobVersion -> BlobVersion -> BlobVersion)
-> (BlobVersion -> BlobVersion -> BlobVersion)
-> Ord BlobVersion
BlobVersion -> BlobVersion -> Bool
BlobVersion -> BlobVersion -> Ordering
BlobVersion -> BlobVersion -> BlobVersion
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 :: BlobVersion -> BlobVersion -> Ordering
compare :: BlobVersion -> BlobVersion -> Ordering
$c< :: BlobVersion -> BlobVersion -> Bool
< :: BlobVersion -> BlobVersion -> Bool
$c<= :: BlobVersion -> BlobVersion -> Bool
<= :: BlobVersion -> BlobVersion -> Bool
$c> :: BlobVersion -> BlobVersion -> Bool
> :: BlobVersion -> BlobVersion -> Bool
$c>= :: BlobVersion -> BlobVersion -> Bool
>= :: BlobVersion -> BlobVersion -> Bool
$cmax :: BlobVersion -> BlobVersion -> BlobVersion
max :: BlobVersion -> BlobVersion -> BlobVersion
$cmin :: BlobVersion -> BlobVersion -> BlobVersion
min :: BlobVersion -> BlobVersion -> BlobVersion
Ord)
  deriving newtype (Ptr BlobVersion -> IO BlobVersion
Ptr BlobVersion -> Int -> IO BlobVersion
Ptr BlobVersion -> Int -> BlobVersion -> IO ()
Ptr BlobVersion -> BlobVersion -> IO ()
BlobVersion -> Int
(BlobVersion -> Int)
-> (BlobVersion -> Int)
-> (Ptr BlobVersion -> Int -> IO BlobVersion)
-> (Ptr BlobVersion -> Int -> BlobVersion -> IO ())
-> (forall b. Ptr b -> Int -> IO BlobVersion)
-> (forall b. Ptr b -> Int -> BlobVersion -> IO ())
-> (Ptr BlobVersion -> IO BlobVersion)
-> (Ptr BlobVersion -> BlobVersion -> IO ())
-> Storable BlobVersion
forall b. Ptr b -> Int -> IO BlobVersion
forall b. Ptr b -> Int -> BlobVersion -> 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 :: BlobVersion -> Int
sizeOf :: BlobVersion -> Int
$calignment :: BlobVersion -> Int
alignment :: BlobVersion -> Int
$cpeekElemOff :: Ptr BlobVersion -> Int -> IO BlobVersion
peekElemOff :: Ptr BlobVersion -> Int -> IO BlobVersion
$cpokeElemOff :: Ptr BlobVersion -> Int -> BlobVersion -> IO ()
pokeElemOff :: Ptr BlobVersion -> Int -> BlobVersion -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO BlobVersion
peekByteOff :: forall b. Ptr b -> Int -> IO BlobVersion
$cpokeByteOff :: forall b. Ptr b -> Int -> BlobVersion -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> BlobVersion -> IO ()
$cpeek :: Ptr BlobVersion -> IO BlobVersion
peek :: Ptr BlobVersion -> IO BlobVersion
$cpoke :: Ptr BlobVersion -> BlobVersion -> IO ()
poke :: Ptr BlobVersion -> BlobVersion -> IO ()
Storable)

instance Show BlobVersion where
  showsPrec :: Int -> BlobVersion -> ShowS
showsPrec Int
d = \case
    BlobVersion
BLOB_VERSION_INVALID -> String -> ShowS
showString String
"BLOB_VERSION_INVALID"
    BlobVersion
BLOB_VERSION_INITIAL -> String -> ShowS
showString String
"BLOB_VERSION_INITIAL"
    BlobVersion Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"BlobVersion " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern BLOB_VERSION_INVALID :: BlobVersion
pattern $mBLOB_VERSION_INVALID :: forall {r}. BlobVersion -> ((# #) -> r) -> ((# #) -> r) -> r
$bBLOB_VERSION_INVALID :: BlobVersion
BLOB_VERSION_INVALID = BlobVersion (0)
{-# LINE 49 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern BLOB_VERSION_INITIAL :: BlobVersion
pattern $mBLOB_VERSION_INITIAL :: forall {r}. BlobVersion -> ((# #) -> r) -> ((# #) -> r) -> r
$bBLOB_VERSION_INITIAL :: BlobVersion
BLOB_VERSION_INITIAL = BlobVersion (1)
{-# LINE 52 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern BLOB_VERSION_CURRENT :: BlobVersion
pattern $mBLOB_VERSION_CURRENT :: forall {r}. BlobVersion -> ((# #) -> r) -> ((# #) -> r) -> r
$bBLOB_VERSION_CURRENT :: BlobVersion
BLOB_VERSION_CURRENT = BlobVersion (1)
{-# LINE 55 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- ** Direction

newtype Direction = Direction Word32
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
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 :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord)
  deriving newtype (Ptr Direction -> IO Direction
Ptr Direction -> Int -> IO Direction
Ptr Direction -> Int -> Direction -> IO ()
Ptr Direction -> Direction -> IO ()
Direction -> Int
(Direction -> Int)
-> (Direction -> Int)
-> (Ptr Direction -> Int -> IO Direction)
-> (Ptr Direction -> Int -> Direction -> IO ())
-> (forall b. Ptr b -> Int -> IO Direction)
-> (forall b. Ptr b -> Int -> Direction -> IO ())
-> (Ptr Direction -> IO Direction)
-> (Ptr Direction -> Direction -> IO ())
-> Storable Direction
forall b. Ptr b -> Int -> IO Direction
forall b. Ptr b -> Int -> Direction -> 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 :: Direction -> Int
sizeOf :: Direction -> Int
$calignment :: Direction -> Int
alignment :: Direction -> Int
$cpeekElemOff :: Ptr Direction -> Int -> IO Direction
peekElemOff :: Ptr Direction -> Int -> IO Direction
$cpokeElemOff :: Ptr Direction -> Int -> Direction -> IO ()
pokeElemOff :: Ptr Direction -> Int -> Direction -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO Direction
peekByteOff :: forall b. Ptr b -> Int -> IO Direction
$cpokeByteOff :: forall b. Ptr b -> Int -> Direction -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> Direction -> IO ()
$cpeek :: Ptr Direction -> IO Direction
peek :: Ptr Direction -> IO Direction
$cpoke :: Ptr Direction -> Direction -> IO ()
poke :: Ptr Direction -> Direction -> IO ()
Storable)

instance Show Direction where
  showsPrec :: Int -> Direction -> ShowS
showsPrec Int
d = \case
    Direction
DIRECTION_DONT_KNOW -> String -> ShowS
showString String
"DIRECTION_DONT_KNOW"
    Direction
DIRECTION_LTR -> String -> ShowS
showString String
"DIRECTION_LTR"
    Direction
DIRECTION_RTL -> String -> ShowS
showString String
"DIRECTION_RTL"
    Direction Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Direction " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern DIRECTION_DONT_KNOW :: Direction
pattern $mDIRECTION_DONT_KNOW :: forall {r}. Direction -> ((# #) -> r) -> ((# #) -> r) -> r
$bDIRECTION_DONT_KNOW :: Direction
DIRECTION_DONT_KNOW = Direction (0)
{-# LINE 71 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern DIRECTION_LTR :: Direction
pattern $mDIRECTION_LTR :: forall {r}. Direction -> ((# #) -> r) -> ((# #) -> r) -> r
$bDIRECTION_LTR :: Direction
DIRECTION_LTR = Direction (1)
{-# LINE 74 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern DIRECTION_RTL :: Direction
pattern $mDIRECTION_RTL :: forall {r}. Direction -> ((# #) -> r) -> ((# #) -> r) -> r
$bDIRECTION_RTL :: Direction
DIRECTION_RTL = Direction (2)
{-# LINE 77 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype ShapeError = ShapeError Word32
  deriving (ShapeError -> ShapeError -> Bool
(ShapeError -> ShapeError -> Bool)
-> (ShapeError -> ShapeError -> Bool) -> Eq ShapeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShapeError -> ShapeError -> Bool
== :: ShapeError -> ShapeError -> Bool
$c/= :: ShapeError -> ShapeError -> Bool
/= :: ShapeError -> ShapeError -> Bool
Eq, Eq ShapeError
Eq ShapeError =>
(ShapeError -> ShapeError -> Ordering)
-> (ShapeError -> ShapeError -> Bool)
-> (ShapeError -> ShapeError -> Bool)
-> (ShapeError -> ShapeError -> Bool)
-> (ShapeError -> ShapeError -> Bool)
-> (ShapeError -> ShapeError -> ShapeError)
-> (ShapeError -> ShapeError -> ShapeError)
-> Ord ShapeError
ShapeError -> ShapeError -> Bool
ShapeError -> ShapeError -> Ordering
ShapeError -> ShapeError -> ShapeError
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 :: ShapeError -> ShapeError -> Ordering
compare :: ShapeError -> ShapeError -> Ordering
$c< :: ShapeError -> ShapeError -> Bool
< :: ShapeError -> ShapeError -> Bool
$c<= :: ShapeError -> ShapeError -> Bool
<= :: ShapeError -> ShapeError -> Bool
$c> :: ShapeError -> ShapeError -> Bool
> :: ShapeError -> ShapeError -> Bool
$c>= :: ShapeError -> ShapeError -> Bool
>= :: ShapeError -> ShapeError -> Bool
$cmax :: ShapeError -> ShapeError -> ShapeError
max :: ShapeError -> ShapeError -> ShapeError
$cmin :: ShapeError -> ShapeError -> ShapeError
min :: ShapeError -> ShapeError -> ShapeError
Ord)
  deriving newtype (Ptr ShapeError -> IO ShapeError
Ptr ShapeError -> Int -> IO ShapeError
Ptr ShapeError -> Int -> ShapeError -> IO ()
Ptr ShapeError -> ShapeError -> IO ()
ShapeError -> Int
(ShapeError -> Int)
-> (ShapeError -> Int)
-> (Ptr ShapeError -> Int -> IO ShapeError)
-> (Ptr ShapeError -> Int -> ShapeError -> IO ())
-> (forall b. Ptr b -> Int -> IO ShapeError)
-> (forall b. Ptr b -> Int -> ShapeError -> IO ())
-> (Ptr ShapeError -> IO ShapeError)
-> (Ptr ShapeError -> ShapeError -> IO ())
-> Storable ShapeError
forall b. Ptr b -> Int -> IO ShapeError
forall b. Ptr b -> Int -> ShapeError -> 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 :: ShapeError -> Int
sizeOf :: ShapeError -> Int
$calignment :: ShapeError -> Int
alignment :: ShapeError -> Int
$cpeekElemOff :: Ptr ShapeError -> Int -> IO ShapeError
peekElemOff :: Ptr ShapeError -> Int -> IO ShapeError
$cpokeElemOff :: Ptr ShapeError -> Int -> ShapeError -> IO ()
pokeElemOff :: Ptr ShapeError -> Int -> ShapeError -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ShapeError
peekByteOff :: forall b. Ptr b -> Int -> IO ShapeError
$cpokeByteOff :: forall b. Ptr b -> Int -> ShapeError -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> ShapeError -> IO ()
$cpeek :: Ptr ShapeError -> IO ShapeError
peek :: Ptr ShapeError -> IO ShapeError
$cpoke :: Ptr ShapeError -> ShapeError -> IO ()
poke :: Ptr ShapeError -> ShapeError -> IO ()
Storable)

instance Show ShapeError where
  showsPrec :: Int -> ShapeError -> ShowS
showsPrec Int
d = \case
    ShapeError
SHAPE_ERROR_NONE -> String -> ShowS
showString String
"SHAPE_ERROR_NONE"
    ShapeError
SHAPE_ERROR_INVALID_FONT -> String -> ShowS
showString String
"SHAPE_ERROR_INVALID_FONT"
    ShapeError
SHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN -> String -> ShowS
showString String
"SHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN"
    ShapeError
SHAPE_ERROR_OUT_OF_MEMORY -> String -> ShowS
showString String
"SHAPE_ERROR_OUT_OF_MEMORY"
    ShapeError Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ShapeError " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern SHAPE_ERROR_NONE :: ShapeError
pattern $mSHAPE_ERROR_NONE :: forall {r}. ShapeError -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAPE_ERROR_NONE :: ShapeError
SHAPE_ERROR_NONE = ShapeError (0)
{-# LINE 92 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern SHAPE_ERROR_INVALID_FONT :: ShapeError
pattern $mSHAPE_ERROR_INVALID_FONT :: forall {r}. ShapeError -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAPE_ERROR_INVALID_FONT :: ShapeError
SHAPE_ERROR_INVALID_FONT = ShapeError (1)
{-# LINE 95 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern SHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN :: ShapeError
pattern $mSHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN :: forall {r}. ShapeError -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN :: ShapeError
SHAPE_ERROR_GAVE_TEXT_BEFORE_CALLING_BEGIN = ShapeError (2)
{-# LINE 98 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern SHAPE_ERROR_OUT_OF_MEMORY :: ShapeError
pattern $mSHAPE_ERROR_OUT_OF_MEMORY :: forall {r}. ShapeError -> ((# #) -> r) -> ((# #) -> r) -> r
$bSHAPE_ERROR_OUT_OF_MEMORY :: ShapeError
SHAPE_ERROR_OUT_OF_MEMORY = ShapeError (3)
{-# LINE 101 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype UserIdGenerationMode = UserIdGenerationMode Word32
  deriving (UserIdGenerationMode -> UserIdGenerationMode -> Bool
(UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> (UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> Eq UserIdGenerationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
== :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
$c/= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
/= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
Eq, Eq UserIdGenerationMode
Eq UserIdGenerationMode =>
(UserIdGenerationMode -> UserIdGenerationMode -> Ordering)
-> (UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> (UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> (UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> (UserIdGenerationMode -> UserIdGenerationMode -> Bool)
-> (UserIdGenerationMode
    -> UserIdGenerationMode -> UserIdGenerationMode)
-> (UserIdGenerationMode
    -> UserIdGenerationMode -> UserIdGenerationMode)
-> Ord UserIdGenerationMode
UserIdGenerationMode -> UserIdGenerationMode -> Bool
UserIdGenerationMode -> UserIdGenerationMode -> Ordering
UserIdGenerationMode
-> UserIdGenerationMode -> UserIdGenerationMode
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 :: UserIdGenerationMode -> UserIdGenerationMode -> Ordering
compare :: UserIdGenerationMode -> UserIdGenerationMode -> Ordering
$c< :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
< :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
$c<= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
<= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
$c> :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
> :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
$c>= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
>= :: UserIdGenerationMode -> UserIdGenerationMode -> Bool
$cmax :: UserIdGenerationMode
-> UserIdGenerationMode -> UserIdGenerationMode
max :: UserIdGenerationMode
-> UserIdGenerationMode -> UserIdGenerationMode
$cmin :: UserIdGenerationMode
-> UserIdGenerationMode -> UserIdGenerationMode
min :: UserIdGenerationMode
-> UserIdGenerationMode -> UserIdGenerationMode
Ord)
  deriving newtype (Ptr UserIdGenerationMode -> IO UserIdGenerationMode
Ptr UserIdGenerationMode -> Int -> IO UserIdGenerationMode
Ptr UserIdGenerationMode -> Int -> UserIdGenerationMode -> IO ()
Ptr UserIdGenerationMode -> UserIdGenerationMode -> IO ()
UserIdGenerationMode -> Int
(UserIdGenerationMode -> Int)
-> (UserIdGenerationMode -> Int)
-> (Ptr UserIdGenerationMode -> Int -> IO UserIdGenerationMode)
-> (Ptr UserIdGenerationMode
    -> Int -> UserIdGenerationMode -> IO ())
-> (forall b. Ptr b -> Int -> IO UserIdGenerationMode)
-> (forall b. Ptr b -> Int -> UserIdGenerationMode -> IO ())
-> (Ptr UserIdGenerationMode -> IO UserIdGenerationMode)
-> (Ptr UserIdGenerationMode -> UserIdGenerationMode -> IO ())
-> Storable UserIdGenerationMode
forall b. Ptr b -> Int -> IO UserIdGenerationMode
forall b. Ptr b -> Int -> UserIdGenerationMode -> 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 :: UserIdGenerationMode -> Int
sizeOf :: UserIdGenerationMode -> Int
$calignment :: UserIdGenerationMode -> Int
alignment :: UserIdGenerationMode -> Int
$cpeekElemOff :: Ptr UserIdGenerationMode -> Int -> IO UserIdGenerationMode
peekElemOff :: Ptr UserIdGenerationMode -> Int -> IO UserIdGenerationMode
$cpokeElemOff :: Ptr UserIdGenerationMode -> Int -> UserIdGenerationMode -> IO ()
pokeElemOff :: Ptr UserIdGenerationMode -> Int -> UserIdGenerationMode -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UserIdGenerationMode
peekByteOff :: forall b. Ptr b -> Int -> IO UserIdGenerationMode
$cpokeByteOff :: forall b. Ptr b -> Int -> UserIdGenerationMode -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> UserIdGenerationMode -> IO ()
$cpeek :: Ptr UserIdGenerationMode -> IO UserIdGenerationMode
peek :: Ptr UserIdGenerationMode -> IO UserIdGenerationMode
$cpoke :: Ptr UserIdGenerationMode -> UserIdGenerationMode -> IO ()
poke :: Ptr UserIdGenerationMode -> UserIdGenerationMode -> IO ()
Storable)

instance Show UserIdGenerationMode where
  showsPrec :: Int -> UserIdGenerationMode -> ShowS
showsPrec Int
d = \case
    UserIdGenerationMode
USER_ID_GENERATION_MODE_CODEPOINT_INDEX -> String -> ShowS
showString String
"USER_ID_GENERATION_MODE_CODEPOINT_INDEX"
    UserIdGenerationMode
USER_ID_GENERATION_MODE_SOURCE_INDEX -> String -> ShowS
showString String
"USER_ID_GENERATION_MODE_SOURCE_INDEX"
    UserIdGenerationMode Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"UserIdGenerationMode " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern USER_ID_GENERATION_MODE_CODEPOINT_INDEX :: UserIdGenerationMode
pattern $mUSER_ID_GENERATION_MODE_CODEPOINT_INDEX :: forall {r}.
UserIdGenerationMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bUSER_ID_GENERATION_MODE_CODEPOINT_INDEX :: UserIdGenerationMode
USER_ID_GENERATION_MODE_CODEPOINT_INDEX = UserIdGenerationMode (0)
{-# LINE 114 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern USER_ID_GENERATION_MODE_SOURCE_INDEX :: UserIdGenerationMode
pattern $mUSER_ID_GENERATION_MODE_SOURCE_INDEX :: forall {r}.
UserIdGenerationMode -> ((# #) -> r) -> ((# #) -> r) -> r
$bUSER_ID_GENERATION_MODE_SOURCE_INDEX :: UserIdGenerationMode
USER_ID_GENERATION_MODE_SOURCE_INDEX = UserIdGenerationMode (1)
{-# LINE 117 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype LoadFontError = LoadFontError Word32
  deriving (LoadFontError -> LoadFontError -> Bool
(LoadFontError -> LoadFontError -> Bool)
-> (LoadFontError -> LoadFontError -> Bool) -> Eq LoadFontError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoadFontError -> LoadFontError -> Bool
== :: LoadFontError -> LoadFontError -> Bool
$c/= :: LoadFontError -> LoadFontError -> Bool
/= :: LoadFontError -> LoadFontError -> Bool
Eq, Eq LoadFontError
Eq LoadFontError =>
(LoadFontError -> LoadFontError -> Ordering)
-> (LoadFontError -> LoadFontError -> Bool)
-> (LoadFontError -> LoadFontError -> Bool)
-> (LoadFontError -> LoadFontError -> Bool)
-> (LoadFontError -> LoadFontError -> Bool)
-> (LoadFontError -> LoadFontError -> LoadFontError)
-> (LoadFontError -> LoadFontError -> LoadFontError)
-> Ord LoadFontError
LoadFontError -> LoadFontError -> Bool
LoadFontError -> LoadFontError -> Ordering
LoadFontError -> LoadFontError -> LoadFontError
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 :: LoadFontError -> LoadFontError -> Ordering
compare :: LoadFontError -> LoadFontError -> Ordering
$c< :: LoadFontError -> LoadFontError -> Bool
< :: LoadFontError -> LoadFontError -> Bool
$c<= :: LoadFontError -> LoadFontError -> Bool
<= :: LoadFontError -> LoadFontError -> Bool
$c> :: LoadFontError -> LoadFontError -> Bool
> :: LoadFontError -> LoadFontError -> Bool
$c>= :: LoadFontError -> LoadFontError -> Bool
>= :: LoadFontError -> LoadFontError -> Bool
$cmax :: LoadFontError -> LoadFontError -> LoadFontError
max :: LoadFontError -> LoadFontError -> LoadFontError
$cmin :: LoadFontError -> LoadFontError -> LoadFontError
min :: LoadFontError -> LoadFontError -> LoadFontError
Ord)
  deriving newtype (Ptr LoadFontError -> IO LoadFontError
Ptr LoadFontError -> Int -> IO LoadFontError
Ptr LoadFontError -> Int -> LoadFontError -> IO ()
Ptr LoadFontError -> LoadFontError -> IO ()
LoadFontError -> Int
(LoadFontError -> Int)
-> (LoadFontError -> Int)
-> (Ptr LoadFontError -> Int -> IO LoadFontError)
-> (Ptr LoadFontError -> Int -> LoadFontError -> IO ())
-> (forall b. Ptr b -> Int -> IO LoadFontError)
-> (forall b. Ptr b -> Int -> LoadFontError -> IO ())
-> (Ptr LoadFontError -> IO LoadFontError)
-> (Ptr LoadFontError -> LoadFontError -> IO ())
-> Storable LoadFontError
forall b. Ptr b -> Int -> IO LoadFontError
forall b. Ptr b -> Int -> LoadFontError -> 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 :: LoadFontError -> Int
sizeOf :: LoadFontError -> Int
$calignment :: LoadFontError -> Int
alignment :: LoadFontError -> Int
$cpeekElemOff :: Ptr LoadFontError -> Int -> IO LoadFontError
peekElemOff :: Ptr LoadFontError -> Int -> IO LoadFontError
$cpokeElemOff :: Ptr LoadFontError -> Int -> LoadFontError -> IO ()
pokeElemOff :: Ptr LoadFontError -> Int -> LoadFontError -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO LoadFontError
peekByteOff :: forall b. Ptr b -> Int -> IO LoadFontError
$cpokeByteOff :: forall b. Ptr b -> Int -> LoadFontError -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> LoadFontError -> IO ()
$cpeek :: Ptr LoadFontError -> IO LoadFontError
peek :: Ptr LoadFontError -> IO LoadFontError
$cpoke :: Ptr LoadFontError -> LoadFontError -> IO ()
poke :: Ptr LoadFontError -> LoadFontError -> IO ()
Storable)

instance Show LoadFontError where
  showsPrec :: Int -> LoadFontError -> ShowS
showsPrec Int
d = \case
    LoadFontError
LOAD_FONT_ERROR_NONE -> String -> ShowS
showString String
"LOAD_FONT_ERROR_NONE"
    LoadFontError
LOAD_FONT_ERROR_NEED_TO_CREATE_BLOB -> String -> ShowS
showString String
"LOAD_FONT_ERROR_NEED_TO_CREATE_BLOB"
    LoadFontError
LOAD_FONT_ERROR_INVALID_FONT -> String -> ShowS
showString String
"LOAD_FONT_ERROR_INVALID_FONT"
    LoadFontError
LOAD_FONT_ERROR_OUT_OF_MEMORY -> String -> ShowS
showString String
"LOAD_FONT_ERROR_OUT_OF_MEMORY"
    LoadFontError
LOAD_FONT_ERROR_COULD_NOT_OPEN_FILE -> String -> ShowS
showString String
"LOAD_FONT_ERROR_COULD_NOT_OPEN_FILE"
    LoadFontError
LOAD_FONT_ERROR_READ_ERROR -> String -> ShowS
showString String
"LOAD_FONT_ERROR_READ_ERROR"
    LoadFontError Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"LoadFontError " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern LOAD_FONT_ERROR_NONE :: LoadFontError
pattern $mLOAD_FONT_ERROR_NONE :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_NONE :: LoadFontError
LOAD_FONT_ERROR_NONE = LoadFontError 0
{-# LINE 134 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern LOAD_FONT_ERROR_NEED_TO_CREATE_BLOB :: LoadFontError
pattern $mLOAD_FONT_ERROR_NEED_TO_CREATE_BLOB :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_NEED_TO_CREATE_BLOB :: LoadFontError
LOAD_FONT_ERROR_NEED_TO_CREATE_BLOB = LoadFontError 1
{-# LINE 137 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern LOAD_FONT_ERROR_INVALID_FONT :: LoadFontError
pattern $mLOAD_FONT_ERROR_INVALID_FONT :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_INVALID_FONT :: LoadFontError
LOAD_FONT_ERROR_INVALID_FONT = LoadFontError 2
{-# LINE 140 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern LOAD_FONT_ERROR_OUT_OF_MEMORY :: LoadFontError
pattern $mLOAD_FONT_ERROR_OUT_OF_MEMORY :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_OUT_OF_MEMORY :: LoadFontError
LOAD_FONT_ERROR_OUT_OF_MEMORY = LoadFontError 3
{-# LINE 143 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern LOAD_FONT_ERROR_COULD_NOT_OPEN_FILE :: LoadFontError
pattern $mLOAD_FONT_ERROR_COULD_NOT_OPEN_FILE :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_COULD_NOT_OPEN_FILE :: LoadFontError
LOAD_FONT_ERROR_COULD_NOT_OPEN_FILE = LoadFontError 4
{-# LINE 146 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern LOAD_FONT_ERROR_READ_ERROR :: LoadFontError
pattern $mLOAD_FONT_ERROR_READ_ERROR :: forall {r}. LoadFontError -> ((# #) -> r) -> ((# #) -> r) -> r
$bLOAD_FONT_ERROR_READ_ERROR :: LoadFontError
LOAD_FONT_ERROR_READ_ERROR = LoadFontError 5
{-# LINE 149 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype FontWeight = FontWeight Word32
  deriving (FontWeight -> FontWeight -> Bool
(FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool) -> Eq FontWeight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontWeight -> FontWeight -> Bool
== :: FontWeight -> FontWeight -> Bool
$c/= :: FontWeight -> FontWeight -> Bool
/= :: FontWeight -> FontWeight -> Bool
Eq, Eq FontWeight
Eq FontWeight =>
(FontWeight -> FontWeight -> Ordering)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> Bool)
-> (FontWeight -> FontWeight -> FontWeight)
-> (FontWeight -> FontWeight -> FontWeight)
-> Ord FontWeight
FontWeight -> FontWeight -> Bool
FontWeight -> FontWeight -> Ordering
FontWeight -> FontWeight -> FontWeight
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 :: FontWeight -> FontWeight -> Ordering
compare :: FontWeight -> FontWeight -> Ordering
$c< :: FontWeight -> FontWeight -> Bool
< :: FontWeight -> FontWeight -> Bool
$c<= :: FontWeight -> FontWeight -> Bool
<= :: FontWeight -> FontWeight -> Bool
$c> :: FontWeight -> FontWeight -> Bool
> :: FontWeight -> FontWeight -> Bool
$c>= :: FontWeight -> FontWeight -> Bool
>= :: FontWeight -> FontWeight -> Bool
$cmax :: FontWeight -> FontWeight -> FontWeight
max :: FontWeight -> FontWeight -> FontWeight
$cmin :: FontWeight -> FontWeight -> FontWeight
min :: FontWeight -> FontWeight -> FontWeight
Ord)
  deriving newtype (Ptr FontWeight -> IO FontWeight
Ptr FontWeight -> Int -> IO FontWeight
Ptr FontWeight -> Int -> FontWeight -> IO ()
Ptr FontWeight -> FontWeight -> IO ()
FontWeight -> Int
(FontWeight -> Int)
-> (FontWeight -> Int)
-> (Ptr FontWeight -> Int -> IO FontWeight)
-> (Ptr FontWeight -> Int -> FontWeight -> IO ())
-> (forall b. Ptr b -> Int -> IO FontWeight)
-> (forall b. Ptr b -> Int -> FontWeight -> IO ())
-> (Ptr FontWeight -> IO FontWeight)
-> (Ptr FontWeight -> FontWeight -> IO ())
-> Storable FontWeight
forall b. Ptr b -> Int -> IO FontWeight
forall b. Ptr b -> Int -> FontWeight -> 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 :: FontWeight -> Int
sizeOf :: FontWeight -> Int
$calignment :: FontWeight -> Int
alignment :: FontWeight -> Int
$cpeekElemOff :: Ptr FontWeight -> Int -> IO FontWeight
peekElemOff :: Ptr FontWeight -> Int -> IO FontWeight
$cpokeElemOff :: Ptr FontWeight -> Int -> FontWeight -> IO ()
pokeElemOff :: Ptr FontWeight -> Int -> FontWeight -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FontWeight
peekByteOff :: forall b. Ptr b -> Int -> IO FontWeight
$cpokeByteOff :: forall b. Ptr b -> Int -> FontWeight -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> FontWeight -> IO ()
$cpeek :: Ptr FontWeight -> IO FontWeight
peek :: Ptr FontWeight -> IO FontWeight
$cpoke :: Ptr FontWeight -> FontWeight -> IO ()
poke :: Ptr FontWeight -> FontWeight -> IO ()
Storable)

instance Show FontWeight where
  showsPrec :: Int -> FontWeight -> ShowS
showsPrec Int
d = \case
    FontWeight
FONT_WEIGHT_UNKNOWN -> String -> ShowS
showString String
"FONT_WEIGHT_UNKNOWN"
    FontWeight
FONT_WEIGHT_THIN -> String -> ShowS
showString String
"FONT_WEIGHT_THIN"
    FontWeight
FONT_WEIGHT_EXTRA_LIGHT -> String -> ShowS
showString String
"FONT_WEIGHT_EXTRA_LIGHT"
    FontWeight
FONT_WEIGHT_LIGHT -> String -> ShowS
showString String
"FONT_WEIGHT_LIGHT"
    FontWeight
FONT_WEIGHT_NORMAL -> String -> ShowS
showString String
"FONT_WEIGHT_NORMAL"
    FontWeight
FONT_WEIGHT_MEDIUM -> String -> ShowS
showString String
"FONT_WEIGHT_MEDIUM"
    FontWeight
FONT_WEIGHT_SEMI_BOLD -> String -> ShowS
showString String
"FONT_WEIGHT_SEMI_BOLD"
    FontWeight
FONT_WEIGHT_BOLD -> String -> ShowS
showString String
"FONT_WEIGHT_BOLD"
    FontWeight
FONT_WEIGHT_EXTRA_BOLD -> String -> ShowS
showString String
"FONT_WEIGHT_EXTRA_BOLD"
    FontWeight
FONT_WEIGHT_BLACK -> String -> ShowS
showString String
"FONT_WEIGHT_BLACK"
    FontWeight Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"FontWeight " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern FONT_WEIGHT_UNKNOWN :: FontWeight
pattern $mFONT_WEIGHT_UNKNOWN :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_UNKNOWN :: FontWeight
FONT_WEIGHT_UNKNOWN = FontWeight (0)
{-# LINE 170 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_THIN :: FontWeight
pattern $mFONT_WEIGHT_THIN :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_THIN :: FontWeight
FONT_WEIGHT_THIN = FontWeight (1)
{-# LINE 173 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_EXTRA_LIGHT :: FontWeight
pattern $mFONT_WEIGHT_EXTRA_LIGHT :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_EXTRA_LIGHT :: FontWeight
FONT_WEIGHT_EXTRA_LIGHT = FontWeight (2)
{-# LINE 176 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_LIGHT :: FontWeight
pattern $mFONT_WEIGHT_LIGHT :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_LIGHT :: FontWeight
FONT_WEIGHT_LIGHT = FontWeight (3)
{-# LINE 179 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_NORMAL :: FontWeight
pattern $mFONT_WEIGHT_NORMAL :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_NORMAL :: FontWeight
FONT_WEIGHT_NORMAL = FontWeight (4)
{-# LINE 182 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_MEDIUM :: FontWeight
pattern $mFONT_WEIGHT_MEDIUM :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_MEDIUM :: FontWeight
FONT_WEIGHT_MEDIUM = FontWeight (5)
{-# LINE 185 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_SEMI_BOLD :: FontWeight
pattern $mFONT_WEIGHT_SEMI_BOLD :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_SEMI_BOLD :: FontWeight
FONT_WEIGHT_SEMI_BOLD = FontWeight (6)
{-# LINE 188 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_BOLD :: FontWeight
pattern $mFONT_WEIGHT_BOLD :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_BOLD :: FontWeight
FONT_WEIGHT_BOLD = FontWeight (7)
{-# LINE 191 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_EXTRA_BOLD :: FontWeight
pattern $mFONT_WEIGHT_EXTRA_BOLD :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_EXTRA_BOLD :: FontWeight
FONT_WEIGHT_EXTRA_BOLD = FontWeight (8)
{-# LINE 194 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WEIGHT_BLACK :: FontWeight
pattern $mFONT_WEIGHT_BLACK :: forall {r}. FontWeight -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WEIGHT_BLACK :: FontWeight
FONT_WEIGHT_BLACK = FontWeight (9)
{-# LINE 197 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype FontWidth = FontWidth Word32
  deriving (FontWidth -> FontWidth -> Bool
(FontWidth -> FontWidth -> Bool)
-> (FontWidth -> FontWidth -> Bool) -> Eq FontWidth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontWidth -> FontWidth -> Bool
== :: FontWidth -> FontWidth -> Bool
$c/= :: FontWidth -> FontWidth -> Bool
/= :: FontWidth -> FontWidth -> Bool
Eq)
  deriving newtype (Ptr FontWidth -> IO FontWidth
Ptr FontWidth -> Int -> IO FontWidth
Ptr FontWidth -> Int -> FontWidth -> IO ()
Ptr FontWidth -> FontWidth -> IO ()
FontWidth -> Int
(FontWidth -> Int)
-> (FontWidth -> Int)
-> (Ptr FontWidth -> Int -> IO FontWidth)
-> (Ptr FontWidth -> Int -> FontWidth -> IO ())
-> (forall b. Ptr b -> Int -> IO FontWidth)
-> (forall b. Ptr b -> Int -> FontWidth -> IO ())
-> (Ptr FontWidth -> IO FontWidth)
-> (Ptr FontWidth -> FontWidth -> IO ())
-> Storable FontWidth
forall b. Ptr b -> Int -> IO FontWidth
forall b. Ptr b -> Int -> FontWidth -> 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 :: FontWidth -> Int
sizeOf :: FontWidth -> Int
$calignment :: FontWidth -> Int
alignment :: FontWidth -> Int
$cpeekElemOff :: Ptr FontWidth -> Int -> IO FontWidth
peekElemOff :: Ptr FontWidth -> Int -> IO FontWidth
$cpokeElemOff :: Ptr FontWidth -> Int -> FontWidth -> IO ()
pokeElemOff :: Ptr FontWidth -> Int -> FontWidth -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO FontWidth
peekByteOff :: forall b. Ptr b -> Int -> IO FontWidth
$cpokeByteOff :: forall b. Ptr b -> Int -> FontWidth -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> FontWidth -> IO ()
$cpeek :: Ptr FontWidth -> IO FontWidth
peek :: Ptr FontWidth -> IO FontWidth
$cpoke :: Ptr FontWidth -> FontWidth -> IO ()
poke :: Ptr FontWidth -> FontWidth -> IO ()
Storable)

instance Show FontWidth where
  showsPrec :: Int -> FontWidth -> ShowS
showsPrec Int
d = \case
    FontWidth
FONT_WIDTH_UNKNOWN -> String -> ShowS
showString String
"FONT_WIDTH_UNKNOWN"
    FontWidth
FONT_WIDTH_ULTRA_CONDENSED -> String -> ShowS
showString String
"FONT_WIDTH_ULTRA_CONDENSED"
    FontWidth
FONT_WIDTH_EXTRA_CONDENSED -> String -> ShowS
showString String
"FONT_WIDTH_EXTRA_CONDENSED"
    FontWidth
FONT_WIDTH_CONDENSED -> String -> ShowS
showString String
"FONT_WIDTH_CONDENSED"
    FontWidth
FONT_WIDTH_SEMI_CONDENSED -> String -> ShowS
showString String
"FONT_WIDTH_SEMI_CONDENSED"
    FontWidth
FONT_WIDTH_NORMAL -> String -> ShowS
showString String
"FONT_WIDTH_NORMAL"
    FontWidth
FONT_WIDTH_SEMI_EXPANDED -> String -> ShowS
showString String
"FONT_WIDTH_SEMI_EXPANDED"
    FontWidth
FONT_WIDTH_EXPANDED -> String -> ShowS
showString String
"FONT_WIDTH_EXPANDED"
    FontWidth
FONT_WIDTH_EXTRA_EXPANDED -> String -> ShowS
showString String
"FONT_WIDTH_EXTRA_EXPANDED"
    FontWidth
FONT_WIDTH_ULTRA_EXPANDED -> String -> ShowS
showString String
"FONT_WIDTH_ULTRA_EXPANDED"
    FontWidth Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"FontWidth " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern FONT_WIDTH_UNKNOWN :: FontWidth
pattern $mFONT_WIDTH_UNKNOWN :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_UNKNOWN :: FontWidth
FONT_WIDTH_UNKNOWN = FontWidth (0)
{-# LINE 218 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_ULTRA_CONDENSED :: FontWidth
pattern $mFONT_WIDTH_ULTRA_CONDENSED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_ULTRA_CONDENSED :: FontWidth
FONT_WIDTH_ULTRA_CONDENSED = FontWidth (1)
{-# LINE 221 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_EXTRA_CONDENSED :: FontWidth
pattern $mFONT_WIDTH_EXTRA_CONDENSED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_EXTRA_CONDENSED :: FontWidth
FONT_WIDTH_EXTRA_CONDENSED = FontWidth (2)
{-# LINE 224 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_CONDENSED :: FontWidth
pattern $mFONT_WIDTH_CONDENSED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_CONDENSED :: FontWidth
FONT_WIDTH_CONDENSED = FontWidth (3)
{-# LINE 227 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_SEMI_CONDENSED :: FontWidth
pattern $mFONT_WIDTH_SEMI_CONDENSED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_SEMI_CONDENSED :: FontWidth
FONT_WIDTH_SEMI_CONDENSED = FontWidth (4)
{-# LINE 230 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_NORMAL :: FontWidth
pattern $mFONT_WIDTH_NORMAL :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_NORMAL :: FontWidth
FONT_WIDTH_NORMAL = FontWidth (5)
{-# LINE 233 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_SEMI_EXPANDED :: FontWidth
pattern $mFONT_WIDTH_SEMI_EXPANDED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_SEMI_EXPANDED :: FontWidth
FONT_WIDTH_SEMI_EXPANDED = FontWidth (6)
{-# LINE 236 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_EXPANDED :: FontWidth
pattern $mFONT_WIDTH_EXPANDED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_EXPANDED :: FontWidth
FONT_WIDTH_EXPANDED = FontWidth (7)
{-# LINE 239 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_EXTRA_EXPANDED :: FontWidth
pattern $mFONT_WIDTH_EXTRA_EXPANDED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_EXTRA_EXPANDED :: FontWidth
FONT_WIDTH_EXTRA_EXPANDED = FontWidth (8)
{-# LINE 242 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_WIDTH_ULTRA_EXPANDED :: FontWidth
pattern $mFONT_WIDTH_ULTRA_EXPANDED :: forall {r}. FontWidth -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_WIDTH_ULTRA_EXPANDED :: FontWidth
FONT_WIDTH_ULTRA_EXPANDED = FontWidth (9)
{-# LINE 245 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype FontInfoStringId = FontInfoStringId Int
  deriving (FontInfoStringId -> FontInfoStringId -> Bool
(FontInfoStringId -> FontInfoStringId -> Bool)
-> (FontInfoStringId -> FontInfoStringId -> Bool)
-> Eq FontInfoStringId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontInfoStringId -> FontInfoStringId -> Bool
== :: FontInfoStringId -> FontInfoStringId -> Bool
$c/= :: FontInfoStringId -> FontInfoStringId -> Bool
/= :: FontInfoStringId -> FontInfoStringId -> Bool
Eq, Eq FontInfoStringId
Eq FontInfoStringId =>
(FontInfoStringId -> FontInfoStringId -> Ordering)
-> (FontInfoStringId -> FontInfoStringId -> Bool)
-> (FontInfoStringId -> FontInfoStringId -> Bool)
-> (FontInfoStringId -> FontInfoStringId -> Bool)
-> (FontInfoStringId -> FontInfoStringId -> Bool)
-> (FontInfoStringId -> FontInfoStringId -> FontInfoStringId)
-> (FontInfoStringId -> FontInfoStringId -> FontInfoStringId)
-> Ord FontInfoStringId
FontInfoStringId -> FontInfoStringId -> Bool
FontInfoStringId -> FontInfoStringId -> Ordering
FontInfoStringId -> FontInfoStringId -> FontInfoStringId
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 :: FontInfoStringId -> FontInfoStringId -> Ordering
compare :: FontInfoStringId -> FontInfoStringId -> Ordering
$c< :: FontInfoStringId -> FontInfoStringId -> Bool
< :: FontInfoStringId -> FontInfoStringId -> Bool
$c<= :: FontInfoStringId -> FontInfoStringId -> Bool
<= :: FontInfoStringId -> FontInfoStringId -> Bool
$c> :: FontInfoStringId -> FontInfoStringId -> Bool
> :: FontInfoStringId -> FontInfoStringId -> Bool
$c>= :: FontInfoStringId -> FontInfoStringId -> Bool
>= :: FontInfoStringId -> FontInfoStringId -> Bool
$cmax :: FontInfoStringId -> FontInfoStringId -> FontInfoStringId
max :: FontInfoStringId -> FontInfoStringId -> FontInfoStringId
$cmin :: FontInfoStringId -> FontInfoStringId -> FontInfoStringId
min :: FontInfoStringId -> FontInfoStringId -> FontInfoStringId
Ord)

instance Show FontInfoStringId where
  showsPrec :: Int -> FontInfoStringId -> ShowS
showsPrec Int
d = \case
    FontInfoStringId
FONT_INFO_STRING_ID_NONE -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_NONE"
    FontInfoStringId
FONT_INFO_STRING_ID_COPYRIGHT -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_COPYRIGHT"
    FontInfoStringId
FONT_INFO_STRING_ID_FAMILY -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_FAMILY"
    FontInfoStringId
FONT_INFO_STRING_ID_SUBFAMILY -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_SUBFAMILY"
    FontInfoStringId
FONT_INFO_STRING_ID_UID -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_UID"
    FontInfoStringId
FONT_INFO_STRING_ID_FULL_NAME -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_FULL_NAME"
    FontInfoStringId
FONT_INFO_STRING_ID_VERSION -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_VERSION"
    FontInfoStringId
FONT_INFO_STRING_ID_POSTSCRIPT_NAME -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_POSTSCRIPT_NAME"
    FontInfoStringId
FONT_INFO_STRING_ID_TRADEMARK -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_TRADEMARK"
    FontInfoStringId
FONT_INFO_STRING_ID_MANUFACTURER -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_MANUFACTURER"
    FontInfoStringId
FONT_INFO_STRING_ID_DESIGNER -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_DESIGNER"
    FontInfoStringId
FONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY"
    FontInfoStringId
FONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY -> String -> ShowS
showString String
"FONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY"
    FontInfoStringId Int
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"FontInfoStringId " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Int
huh

pattern FONT_INFO_STRING_ID_NONE :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_NONE :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_NONE :: FontInfoStringId
FONT_INFO_STRING_ID_NONE = FontInfoStringId (0)
{-# LINE 268 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_COPYRIGHT :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_COPYRIGHT :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_COPYRIGHT :: FontInfoStringId
FONT_INFO_STRING_ID_COPYRIGHT = FontInfoStringId (1)
{-# LINE 271 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_FAMILY :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_FAMILY :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_FAMILY :: FontInfoStringId
FONT_INFO_STRING_ID_FAMILY = FontInfoStringId (2)
{-# LINE 274 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_SUBFAMILY :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_SUBFAMILY :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_SUBFAMILY :: FontInfoStringId
FONT_INFO_STRING_ID_SUBFAMILY = FontInfoStringId (3)
{-# LINE 277 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_UID :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_UID :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_UID :: FontInfoStringId
FONT_INFO_STRING_ID_UID = FontInfoStringId (4)
{-# LINE 280 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_FULL_NAME :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_FULL_NAME :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_FULL_NAME :: FontInfoStringId
FONT_INFO_STRING_ID_FULL_NAME = FontInfoStringId (5)
{-# LINE 283 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_VERSION :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_VERSION :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_VERSION :: FontInfoStringId
FONT_INFO_STRING_ID_VERSION = FontInfoStringId (6)
{-# LINE 286 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_POSTSCRIPT_NAME :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_POSTSCRIPT_NAME :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_POSTSCRIPT_NAME :: FontInfoStringId
FONT_INFO_STRING_ID_POSTSCRIPT_NAME = FontInfoStringId (7)
{-# LINE 289 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_TRADEMARK :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_TRADEMARK :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_TRADEMARK :: FontInfoStringId
FONT_INFO_STRING_ID_TRADEMARK = FontInfoStringId (8)
{-# LINE 292 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_MANUFACTURER :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_MANUFACTURER :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_MANUFACTURER :: FontInfoStringId
FONT_INFO_STRING_ID_MANUFACTURER = FontInfoStringId (9)
{-# LINE 295 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_DESIGNER :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_DESIGNER :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_DESIGNER :: FontInfoStringId
FONT_INFO_STRING_ID_DESIGNER = FontInfoStringId (10)
{-# LINE 298 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY :: FontInfoStringId
FONT_INFO_STRING_ID_TYPOGRAPHIC_FAMILY = FontInfoStringId (11)
{-# LINE 301 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY :: FontInfoStringId
pattern $mFONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY :: forall {r}. FontInfoStringId -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY :: FontInfoStringId
FONT_INFO_STRING_ID_TYPOGRAPHIC_SUBFAMILY = FontInfoStringId (12)
{-# LINE 304 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern FONT_INFO_STRING_ID_COUNT :: Int
pattern $mFONT_INFO_STRING_ID_COUNT :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bFONT_INFO_STRING_ID_COUNT :: Int
FONT_INFO_STRING_ID_COUNT = 13
{-# LINE 307 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

newtype TextFormat = TextFormat Word32
  deriving (TextFormat -> TextFormat -> Bool
(TextFormat -> TextFormat -> Bool)
-> (TextFormat -> TextFormat -> Bool) -> Eq TextFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextFormat -> TextFormat -> Bool
== :: TextFormat -> TextFormat -> Bool
$c/= :: TextFormat -> TextFormat -> Bool
/= :: TextFormat -> TextFormat -> Bool
Eq, Eq TextFormat
Eq TextFormat =>
(TextFormat -> TextFormat -> Ordering)
-> (TextFormat -> TextFormat -> Bool)
-> (TextFormat -> TextFormat -> Bool)
-> (TextFormat -> TextFormat -> Bool)
-> (TextFormat -> TextFormat -> Bool)
-> (TextFormat -> TextFormat -> TextFormat)
-> (TextFormat -> TextFormat -> TextFormat)
-> Ord TextFormat
TextFormat -> TextFormat -> Bool
TextFormat -> TextFormat -> Ordering
TextFormat -> TextFormat -> TextFormat
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 :: TextFormat -> TextFormat -> Ordering
compare :: TextFormat -> TextFormat -> Ordering
$c< :: TextFormat -> TextFormat -> Bool
< :: TextFormat -> TextFormat -> Bool
$c<= :: TextFormat -> TextFormat -> Bool
<= :: TextFormat -> TextFormat -> Bool
$c> :: TextFormat -> TextFormat -> Bool
> :: TextFormat -> TextFormat -> Bool
$c>= :: TextFormat -> TextFormat -> Bool
>= :: TextFormat -> TextFormat -> Bool
$cmax :: TextFormat -> TextFormat -> TextFormat
max :: TextFormat -> TextFormat -> TextFormat
$cmin :: TextFormat -> TextFormat -> TextFormat
min :: TextFormat -> TextFormat -> TextFormat
Ord)
  deriving newtype (Ptr TextFormat -> IO TextFormat
Ptr TextFormat -> Int -> IO TextFormat
Ptr TextFormat -> Int -> TextFormat -> IO ()
Ptr TextFormat -> TextFormat -> IO ()
TextFormat -> Int
(TextFormat -> Int)
-> (TextFormat -> Int)
-> (Ptr TextFormat -> Int -> IO TextFormat)
-> (Ptr TextFormat -> Int -> TextFormat -> IO ())
-> (forall b. Ptr b -> Int -> IO TextFormat)
-> (forall b. Ptr b -> Int -> TextFormat -> IO ())
-> (Ptr TextFormat -> IO TextFormat)
-> (Ptr TextFormat -> TextFormat -> IO ())
-> Storable TextFormat
forall b. Ptr b -> Int -> IO TextFormat
forall b. Ptr b -> Int -> TextFormat -> 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 :: TextFormat -> Int
sizeOf :: TextFormat -> Int
$calignment :: TextFormat -> Int
alignment :: TextFormat -> Int
$cpeekElemOff :: Ptr TextFormat -> Int -> IO TextFormat
peekElemOff :: Ptr TextFormat -> Int -> IO TextFormat
$cpokeElemOff :: Ptr TextFormat -> Int -> TextFormat -> IO ()
pokeElemOff :: Ptr TextFormat -> Int -> TextFormat -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO TextFormat
peekByteOff :: forall b. Ptr b -> Int -> IO TextFormat
$cpokeByteOff :: forall b. Ptr b -> Int -> TextFormat -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> TextFormat -> IO ()
$cpeek :: Ptr TextFormat -> IO TextFormat
peek :: Ptr TextFormat -> IO TextFormat
$cpoke :: Ptr TextFormat -> TextFormat -> IO ()
poke :: Ptr TextFormat -> TextFormat -> IO ()
Storable)

instance Show TextFormat where
  showsPrec :: Int -> TextFormat -> ShowS
showsPrec Int
d = \case
    TextFormat
TEXT_FORMAT_NONE -> String -> ShowS
showString String
"TEXT_FORMAT_NONE"
    TextFormat
TEXT_FORMAT_UTF32 -> String -> ShowS
showString String
"TEXT_FORMAT_UTF32"
    TextFormat
TEXT_FORMAT_UTF8 -> String -> ShowS
showString String
"TEXT_FORMAT_UTF8"
    TextFormat Word32
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"TextFormat " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word32 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word32
huh

pattern TEXT_FORMAT_NONE :: TextFormat
pattern $mTEXT_FORMAT_NONE :: forall {r}. TextFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bTEXT_FORMAT_NONE :: TextFormat
TEXT_FORMAT_NONE = TextFormat (0)
{-# LINE 321 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern TEXT_FORMAT_UTF32 :: TextFormat
pattern $mTEXT_FORMAT_UTF32 :: forall {r}. TextFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bTEXT_FORMAT_UTF32 :: TextFormat
TEXT_FORMAT_UTF32 = TextFormat (1)
{-# LINE 324 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern TEXT_FORMAT_UTF8 :: TextFormat
pattern $mTEXT_FORMAT_UTF8 :: forall {r}. TextFormat -> ((# #) -> r) -> ((# #) -> r) -> r
$bTEXT_FORMAT_UTF8 :: TextFormat
TEXT_FORMAT_UTF8 = TextFormat (2)
{-# LINE 327 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

{- |
  Japanese text contains "kinsoku" characters, around which breaking a line is forbidden.
  Exactly which characters are "kinsoku" or not depends on the context:
  - Strict style has the largest amount of kinsoku characters, which leads to longer lines.
  - Loose style has the smallest amount of kinsoku characters, which leads to smaller lines.
  - Normal style is somewhere in the middle.
  Note that, while the Unicode standard mentions all three of these styles, it does not mention
  any differences between the normal and loose styles.
  As such, normal and loose styles currently behave the same.
-}
newtype JapaneseLineBreakStyle = JapaneseLineBreakStyle Word8
  deriving (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
(JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> Eq JapaneseLineBreakStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
== :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
$c/= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
/= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
Eq, Eq JapaneseLineBreakStyle
Eq JapaneseLineBreakStyle =>
(JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Ordering)
-> (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> (JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool)
-> (JapaneseLineBreakStyle
    -> JapaneseLineBreakStyle -> JapaneseLineBreakStyle)
-> (JapaneseLineBreakStyle
    -> JapaneseLineBreakStyle -> JapaneseLineBreakStyle)
-> Ord JapaneseLineBreakStyle
JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Ordering
JapaneseLineBreakStyle
-> JapaneseLineBreakStyle -> JapaneseLineBreakStyle
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 :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Ordering
compare :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Ordering
$c< :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
< :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
$c<= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
<= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
$c> :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
> :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
$c>= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
>= :: JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> Bool
$cmax :: JapaneseLineBreakStyle
-> JapaneseLineBreakStyle -> JapaneseLineBreakStyle
max :: JapaneseLineBreakStyle
-> JapaneseLineBreakStyle -> JapaneseLineBreakStyle
$cmin :: JapaneseLineBreakStyle
-> JapaneseLineBreakStyle -> JapaneseLineBreakStyle
min :: JapaneseLineBreakStyle
-> JapaneseLineBreakStyle -> JapaneseLineBreakStyle
Ord)
  deriving (Ptr JapaneseLineBreakStyle -> IO JapaneseLineBreakStyle
Ptr JapaneseLineBreakStyle -> Int -> IO JapaneseLineBreakStyle
Ptr JapaneseLineBreakStyle
-> Int -> JapaneseLineBreakStyle -> IO ()
Ptr JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> IO ()
JapaneseLineBreakStyle -> Int
(JapaneseLineBreakStyle -> Int)
-> (JapaneseLineBreakStyle -> Int)
-> (Ptr JapaneseLineBreakStyle -> Int -> IO JapaneseLineBreakStyle)
-> (Ptr JapaneseLineBreakStyle
    -> Int -> JapaneseLineBreakStyle -> IO ())
-> (forall b. Ptr b -> Int -> IO JapaneseLineBreakStyle)
-> (forall b. Ptr b -> Int -> JapaneseLineBreakStyle -> IO ())
-> (Ptr JapaneseLineBreakStyle -> IO JapaneseLineBreakStyle)
-> (Ptr JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> IO ())
-> Storable JapaneseLineBreakStyle
forall b. Ptr b -> Int -> IO JapaneseLineBreakStyle
forall b. Ptr b -> Int -> JapaneseLineBreakStyle -> 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 :: JapaneseLineBreakStyle -> Int
sizeOf :: JapaneseLineBreakStyle -> Int
$calignment :: JapaneseLineBreakStyle -> Int
alignment :: JapaneseLineBreakStyle -> Int
$cpeekElemOff :: Ptr JapaneseLineBreakStyle -> Int -> IO JapaneseLineBreakStyle
peekElemOff :: Ptr JapaneseLineBreakStyle -> Int -> IO JapaneseLineBreakStyle
$cpokeElemOff :: Ptr JapaneseLineBreakStyle
-> Int -> JapaneseLineBreakStyle -> IO ()
pokeElemOff :: Ptr JapaneseLineBreakStyle
-> Int -> JapaneseLineBreakStyle -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO JapaneseLineBreakStyle
peekByteOff :: forall b. Ptr b -> Int -> IO JapaneseLineBreakStyle
$cpokeByteOff :: forall b. Ptr b -> Int -> JapaneseLineBreakStyle -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> JapaneseLineBreakStyle -> IO ()
$cpeek :: Ptr JapaneseLineBreakStyle -> IO JapaneseLineBreakStyle
peek :: Ptr JapaneseLineBreakStyle -> IO JapaneseLineBreakStyle
$cpoke :: Ptr JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> IO ()
poke :: Ptr JapaneseLineBreakStyle -> JapaneseLineBreakStyle -> IO ()
Storable)

instance Show JapaneseLineBreakStyle where
  showsPrec :: Int -> JapaneseLineBreakStyle -> ShowS
showsPrec Int
d = \case
    JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_STRICT -> String -> ShowS
showString String
"JAPANESE_LINE_BREAK_STYLE_STRICT"
    JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_NORMAL -> String -> ShowS
showString String
"JAPANESE_LINE_BREAK_STYLE_NORMAL"
    JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_LOOSE -> String -> ShowS
showString String
"JAPANESE_LINE_BREAK_STYLE_LOOSE"
    JapaneseLineBreakStyle Word8
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"JapaneseLineBreakStyle " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
huh

{- |
  The Unicode standard does not define what strict style is used for.
  Supposedly, it is used for anything that does not fall into the other two categories of text.
-}
pattern JAPANESE_LINE_BREAK_STYLE_STRICT :: JapaneseLineBreakStyle
pattern $mJAPANESE_LINE_BREAK_STYLE_STRICT :: forall {r}.
JapaneseLineBreakStyle -> ((# #) -> r) -> ((# #) -> r) -> r
$bJAPANESE_LINE_BREAK_STYLE_STRICT :: JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_STRICT = JapaneseLineBreakStyle (0)
{-# LINE 355 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- | Normal style is used for books and documents.
pattern JAPANESE_LINE_BREAK_STYLE_NORMAL :: JapaneseLineBreakStyle
pattern $mJAPANESE_LINE_BREAK_STYLE_NORMAL :: forall {r}.
JapaneseLineBreakStyle -> ((# #) -> r) -> ((# #) -> r) -> r
$bJAPANESE_LINE_BREAK_STYLE_NORMAL :: JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_NORMAL = JapaneseLineBreakStyle (1)
{-# LINE 359 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- | Loose style is used for newspapers, and (I assume) any other narrow column format.
pattern JAPANESE_LINE_BREAK_STYLE_LOOSE :: JapaneseLineBreakStyle
pattern $mJAPANESE_LINE_BREAK_STYLE_LOOSE :: forall {r}.
JapaneseLineBreakStyle -> ((# #) -> r) -> ((# #) -> r) -> r
$bJAPANESE_LINE_BREAK_STYLE_LOOSE :: JapaneseLineBreakStyle
JAPANESE_LINE_BREAK_STYLE_LOOSE = JapaneseLineBreakStyle (2)
{-# LINE 363 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- ** UnicodeJoiningFeature

newtype UnicodeJoiningFeature = UnicodeJoiningFeature Word8
  deriving (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
(UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> Eq UnicodeJoiningFeature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
== :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
$c/= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
/= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
Eq, Eq UnicodeJoiningFeature
Eq UnicodeJoiningFeature =>
(UnicodeJoiningFeature -> UnicodeJoiningFeature -> Ordering)
-> (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> (UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool)
-> (UnicodeJoiningFeature
    -> UnicodeJoiningFeature -> UnicodeJoiningFeature)
-> (UnicodeJoiningFeature
    -> UnicodeJoiningFeature -> UnicodeJoiningFeature)
-> Ord UnicodeJoiningFeature
UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
UnicodeJoiningFeature -> UnicodeJoiningFeature -> Ordering
UnicodeJoiningFeature
-> UnicodeJoiningFeature -> UnicodeJoiningFeature
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 :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Ordering
compare :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Ordering
$c< :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
< :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
$c<= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
<= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
$c> :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
> :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
$c>= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
>= :: UnicodeJoiningFeature -> UnicodeJoiningFeature -> Bool
$cmax :: UnicodeJoiningFeature
-> UnicodeJoiningFeature -> UnicodeJoiningFeature
max :: UnicodeJoiningFeature
-> UnicodeJoiningFeature -> UnicodeJoiningFeature
$cmin :: UnicodeJoiningFeature
-> UnicodeJoiningFeature -> UnicodeJoiningFeature
min :: UnicodeJoiningFeature
-> UnicodeJoiningFeature -> UnicodeJoiningFeature
Ord)
  deriving (Ptr UnicodeJoiningFeature -> IO UnicodeJoiningFeature
Ptr UnicodeJoiningFeature -> Int -> IO UnicodeJoiningFeature
Ptr UnicodeJoiningFeature -> Int -> UnicodeJoiningFeature -> IO ()
Ptr UnicodeJoiningFeature -> UnicodeJoiningFeature -> IO ()
UnicodeJoiningFeature -> Int
(UnicodeJoiningFeature -> Int)
-> (UnicodeJoiningFeature -> Int)
-> (Ptr UnicodeJoiningFeature -> Int -> IO UnicodeJoiningFeature)
-> (Ptr UnicodeJoiningFeature
    -> Int -> UnicodeJoiningFeature -> IO ())
-> (forall b. Ptr b -> Int -> IO UnicodeJoiningFeature)
-> (forall b. Ptr b -> Int -> UnicodeJoiningFeature -> IO ())
-> (Ptr UnicodeJoiningFeature -> IO UnicodeJoiningFeature)
-> (Ptr UnicodeJoiningFeature -> UnicodeJoiningFeature -> IO ())
-> Storable UnicodeJoiningFeature
forall b. Ptr b -> Int -> IO UnicodeJoiningFeature
forall b. Ptr b -> Int -> UnicodeJoiningFeature -> 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 :: UnicodeJoiningFeature -> Int
sizeOf :: UnicodeJoiningFeature -> Int
$calignment :: UnicodeJoiningFeature -> Int
alignment :: UnicodeJoiningFeature -> Int
$cpeekElemOff :: Ptr UnicodeJoiningFeature -> Int -> IO UnicodeJoiningFeature
peekElemOff :: Ptr UnicodeJoiningFeature -> Int -> IO UnicodeJoiningFeature
$cpokeElemOff :: Ptr UnicodeJoiningFeature -> Int -> UnicodeJoiningFeature -> IO ()
pokeElemOff :: Ptr UnicodeJoiningFeature -> Int -> UnicodeJoiningFeature -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UnicodeJoiningFeature
peekByteOff :: forall b. Ptr b -> Int -> IO UnicodeJoiningFeature
$cpokeByteOff :: forall b. Ptr b -> Int -> UnicodeJoiningFeature -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> UnicodeJoiningFeature -> IO ()
$cpeek :: Ptr UnicodeJoiningFeature -> IO UnicodeJoiningFeature
peek :: Ptr UnicodeJoiningFeature -> IO UnicodeJoiningFeature
$cpoke :: Ptr UnicodeJoiningFeature -> UnicodeJoiningFeature -> IO ()
poke :: Ptr UnicodeJoiningFeature -> UnicodeJoiningFeature -> IO ()
Storable)

instance Show UnicodeJoiningFeature where
  showsPrec :: Int -> UnicodeJoiningFeature -> ShowS
showsPrec Int
d = \case
    UnicodeJoiningFeature
JOINING_FEATURE_ISOL -> String -> ShowS
showString String
"JOINING_FEATURE_ISOL"
    UnicodeJoiningFeature
JOINING_FEATURE_FINA -> String -> ShowS
showString String
"JOINING_FEATURE_FINA"
    UnicodeJoiningFeature
JOINING_FEATURE_FIN2 -> String -> ShowS
showString String
"JOINING_FEATURE_FIN2"
    UnicodeJoiningFeature
JOINING_FEATURE_FIN3 -> String -> ShowS
showString String
"JOINING_FEATURE_FIN3"
    UnicodeJoiningFeature
JOINING_FEATURE_MEDI -> String -> ShowS
showString String
"JOINING_FEATURE_MEDI"
    UnicodeJoiningFeature
JOINING_FEATURE_MED2 -> String -> ShowS
showString String
"JOINING_FEATURE_MED2"
    UnicodeJoiningFeature
JOINING_FEATURE_INIT -> String -> ShowS
showString String
"JOINING_FEATURE_INIT"
    UnicodeJoiningFeature Word8
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"UnicodeJoiningFeature " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
huh

pattern JOINING_FEATURE_ISOL :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_ISOL :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_ISOL :: UnicodeJoiningFeature
JOINING_FEATURE_ISOL = UnicodeJoiningFeature (1)
{-# LINE 383 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_FINA :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_FINA :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_FINA :: UnicodeJoiningFeature
JOINING_FEATURE_FINA = UnicodeJoiningFeature (2)
{-# LINE 386 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_FIN2 :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_FIN2 :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_FIN2 :: UnicodeJoiningFeature
JOINING_FEATURE_FIN2 = UnicodeJoiningFeature (3)
{-# LINE 389 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_FIN3 :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_FIN3 :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_FIN3 :: UnicodeJoiningFeature
JOINING_FEATURE_FIN3 = UnicodeJoiningFeature (4)
{-# LINE 392 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_MEDI :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_MEDI :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_MEDI :: UnicodeJoiningFeature
JOINING_FEATURE_MEDI = UnicodeJoiningFeature (5)
{-# LINE 395 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_MED2 :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_MED2 :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_MED2 :: UnicodeJoiningFeature
JOINING_FEATURE_MED2 = UnicodeJoiningFeature (6)
{-# LINE 398 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern JOINING_FEATURE_INIT :: UnicodeJoiningFeature
pattern $mJOINING_FEATURE_INIT :: forall {r}.
UnicodeJoiningFeature -> ((# #) -> r) -> ((# #) -> r) -> r
$bJOINING_FEATURE_INIT :: UnicodeJoiningFeature
JOINING_FEATURE_INIT = UnicodeJoiningFeature (7)
{-# LINE 401 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

-- ** UnicodeJoiningType

newtype UnicodeJoiningType = UnicodeJoiningType Word8
  deriving (UnicodeJoiningType -> UnicodeJoiningType -> Bool
(UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> (UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> Eq UnicodeJoiningType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
== :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
$c/= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
/= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
Eq, Eq UnicodeJoiningType
Eq UnicodeJoiningType =>
(UnicodeJoiningType -> UnicodeJoiningType -> Ordering)
-> (UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> (UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> (UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> (UnicodeJoiningType -> UnicodeJoiningType -> Bool)
-> (UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType)
-> (UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType)
-> Ord UnicodeJoiningType
UnicodeJoiningType -> UnicodeJoiningType -> Bool
UnicodeJoiningType -> UnicodeJoiningType -> Ordering
UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType
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 :: UnicodeJoiningType -> UnicodeJoiningType -> Ordering
compare :: UnicodeJoiningType -> UnicodeJoiningType -> Ordering
$c< :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
< :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
$c<= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
<= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
$c> :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
> :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
$c>= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
>= :: UnicodeJoiningType -> UnicodeJoiningType -> Bool
$cmax :: UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType
max :: UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType
$cmin :: UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType
min :: UnicodeJoiningType -> UnicodeJoiningType -> UnicodeJoiningType
Ord)
  deriving (Ptr UnicodeJoiningType -> IO UnicodeJoiningType
Ptr UnicodeJoiningType -> Int -> IO UnicodeJoiningType
Ptr UnicodeJoiningType -> Int -> UnicodeJoiningType -> IO ()
Ptr UnicodeJoiningType -> UnicodeJoiningType -> IO ()
UnicodeJoiningType -> Int
(UnicodeJoiningType -> Int)
-> (UnicodeJoiningType -> Int)
-> (Ptr UnicodeJoiningType -> Int -> IO UnicodeJoiningType)
-> (Ptr UnicodeJoiningType -> Int -> UnicodeJoiningType -> IO ())
-> (forall b. Ptr b -> Int -> IO UnicodeJoiningType)
-> (forall b. Ptr b -> Int -> UnicodeJoiningType -> IO ())
-> (Ptr UnicodeJoiningType -> IO UnicodeJoiningType)
-> (Ptr UnicodeJoiningType -> UnicodeJoiningType -> IO ())
-> Storable UnicodeJoiningType
forall b. Ptr b -> Int -> IO UnicodeJoiningType
forall b. Ptr b -> Int -> UnicodeJoiningType -> 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 :: UnicodeJoiningType -> Int
sizeOf :: UnicodeJoiningType -> Int
$calignment :: UnicodeJoiningType -> Int
alignment :: UnicodeJoiningType -> Int
$cpeekElemOff :: Ptr UnicodeJoiningType -> Int -> IO UnicodeJoiningType
peekElemOff :: Ptr UnicodeJoiningType -> Int -> IO UnicodeJoiningType
$cpokeElemOff :: Ptr UnicodeJoiningType -> Int -> UnicodeJoiningType -> IO ()
pokeElemOff :: Ptr UnicodeJoiningType -> Int -> UnicodeJoiningType -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO UnicodeJoiningType
peekByteOff :: forall b. Ptr b -> Int -> IO UnicodeJoiningType
$cpokeByteOff :: forall b. Ptr b -> Int -> UnicodeJoiningType -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> UnicodeJoiningType -> IO ()
$cpeek :: Ptr UnicodeJoiningType -> IO UnicodeJoiningType
peek :: Ptr UnicodeJoiningType -> IO UnicodeJoiningType
$cpoke :: Ptr UnicodeJoiningType -> UnicodeJoiningType -> IO ()
poke :: Ptr UnicodeJoiningType -> UnicodeJoiningType -> IO ()
Storable)

instance Show UnicodeJoiningType where
  showsPrec :: Int -> UnicodeJoiningType -> ShowS
showsPrec Int
d = \case
    UnicodeJoiningType
UNICODE_JOINING_TYPE_NONE -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_NONE"
    UnicodeJoiningType
UNICODE_JOINING_TYPE_LEFT -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_LEFT"
    UnicodeJoiningType
UNICODE_JOINING_TYPE_DUAL -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_DUAL"
    UnicodeJoiningType
UNICODE_JOINING_TYPE_FORCE -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_FORCE"
    UnicodeJoiningType
UNICODE_JOINING_TYPE_RIGHT -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_RIGHT"
    UnicodeJoiningType
UNICODE_JOINING_TYPE_TRANSPARENT -> String -> ShowS
showString String
"UNICODE_JOINING_TYPE_TRANSPARENT"
    UnicodeJoiningType Word8
huh -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"UnicodeJoiningType " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Word8
huh

pattern UNICODE_JOINING_TYPE_NONE :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_NONE :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_NONE :: UnicodeJoiningType
UNICODE_JOINING_TYPE_NONE = UnicodeJoiningType (0)
{-# LINE 420 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern UNICODE_JOINING_TYPE_LEFT :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_LEFT :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_LEFT :: UnicodeJoiningType
UNICODE_JOINING_TYPE_LEFT = UnicodeJoiningType (1)
{-# LINE 423 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern UNICODE_JOINING_TYPE_DUAL :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_DUAL :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_DUAL :: UnicodeJoiningType
UNICODE_JOINING_TYPE_DUAL = UnicodeJoiningType (2)
{-# LINE 426 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern UNICODE_JOINING_TYPE_FORCE :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_FORCE :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_FORCE :: UnicodeJoiningType
UNICODE_JOINING_TYPE_FORCE = UnicodeJoiningType (3)
{-# LINE 429 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern UNICODE_JOINING_TYPE_RIGHT :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_RIGHT :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_RIGHT :: UnicodeJoiningType
UNICODE_JOINING_TYPE_RIGHT = UnicodeJoiningType (4)
{-# LINE 432 "src/KB/Text/Shape/FFI/Enums.hsc" #-}

pattern UNICODE_JOINING_TYPE_TRANSPARENT :: UnicodeJoiningType
pattern $mUNICODE_JOINING_TYPE_TRANSPARENT :: forall {r}. UnicodeJoiningType -> ((# #) -> r) -> ((# #) -> r) -> r
$bUNICODE_JOINING_TYPE_TRANSPARENT :: UnicodeJoiningType
UNICODE_JOINING_TYPE_TRANSPARENT = UnicodeJoiningType (5)
{-# LINE 435 "src/KB/Text/Shape/FFI/Enums.hsc" #-}