kb-text-shape-0.1.0.0: src/KB/Text/Shape/FFI/Flags.hsc

module KB.Text.Shape.FFI.Flags
  ( module KB.Text.Shape.FFI.Flags
  -- , module RE
  ) where

import Foreign

-- import KB.Text.Shape.FFI.Flags.Foo as RE

#include "kb_text_shape.h"

-- * Flags

-- ** BreakFlags

newtype BreakFlags = BreakFlags Word32
  deriving (Eq, Ord)
  deriving newtype (Storable, Bits)

instance Semigroup BreakFlags where
  {-# INLINE (<>) #-}
  (<>) = (.|.)

instance Monoid BreakFlags where
  {-# INLINE mempty #-}
  mempty = BreakFlags 0

instance Show BreakFlags where
  showsPrec = showsFlags breakBits "BreakFlags" \(BreakFlags i) -> i

breakBits :: [(BreakFlags, String)]
breakBits =
  [ (BREAK_FLAG_DIRECTION, "BREAK_FLAG_DIRECTION")
  , (BREAK_FLAG_SCRIPT, "BREAK_FLAG_SCRIPT")
  , (BREAK_FLAG_GRAPHEME, "BREAK_FLAG_GRAPHEME")
  , (BREAK_FLAG_WORD, "BREAK_FLAG_WORD")
  , (BREAK_FLAG_LINE_SOFT, "BREAK_FLAG_LINE_SOFT")
  , (BREAK_FLAG_LINE_HARD, "BREAK_FLAG_LINE_HARD")
  , (BREAK_FLAG_MANUAL, "BREAK_FLAG_MANUAL")
  , (BREAK_FLAG_PARAGRAPH_DIRECTION, "BREAK_FLAG_PARAGRAPH_DIRECTION")
  ]

pattern BREAK_FLAG_DIRECTION :: BreakFlags
pattern BREAK_FLAG_DIRECTION = BreakFlags (#const KBTS_BREAK_FLAG_DIRECTION)

pattern BREAK_FLAG_SCRIPT :: BreakFlags
pattern BREAK_FLAG_SCRIPT = BreakFlags (#const KBTS_BREAK_FLAG_SCRIPT)

pattern BREAK_FLAG_GRAPHEME :: BreakFlags
pattern BREAK_FLAG_GRAPHEME = BreakFlags (#const KBTS_BREAK_FLAG_GRAPHEME)

pattern BREAK_FLAG_WORD :: BreakFlags
pattern BREAK_FLAG_WORD = BreakFlags (#const KBTS_BREAK_FLAG_WORD)

pattern BREAK_FLAG_LINE_SOFT :: BreakFlags
pattern BREAK_FLAG_LINE_SOFT = BreakFlags (#const KBTS_BREAK_FLAG_LINE_SOFT)

pattern BREAK_FLAG_LINE_HARD :: BreakFlags
pattern BREAK_FLAG_LINE_HARD = BreakFlags (#const KBTS_BREAK_FLAG_LINE_HARD)

pattern BREAK_FLAG_MANUAL :: BreakFlags
pattern BREAK_FLAG_MANUAL = BreakFlags (#const KBTS_BREAK_FLAG_MANUAL)

pattern BREAK_FLAG_PARAGRAPH_DIRECTION :: BreakFlags
pattern BREAK_FLAG_PARAGRAPH_DIRECTION = BreakFlags (#const KBTS_BREAK_FLAG_PARAGRAPH_DIRECTION)

-- | `BREAK_FLAG_LINE_SOFT` | `BREAK_FLAG_LINE_HARD`
pattern BREAK_FLAG_LINE :: BreakFlags
pattern BREAK_FLAG_LINE = BreakFlags (#const KBTS_BREAK_FLAG_LINE)

-- | `BREAK_FLAG_DIRECTION` | `BREAK_FLAG_SCRIPT` | `BREAK_FLAG_GRAPHEME` | `BREAK_FLAG_WORD` | `BREAK_FLAG_LINE_SOFT` | `BREAK_FLAG_LINE_HARD`.
pattern BREAK_FLAG_ANY :: BreakFlags
pattern BREAK_FLAG_ANY = BreakFlags (#const KBTS_BREAK_FLAG_ANY)

-- ** BreakStateFlags

newtype BreakStateFlags = BreakStateFlags Word32
  deriving (Eq, Ord)
  deriving newtype (Storable, Bits)

instance Semigroup BreakStateFlags where
  {-# INLINE (<>) #-}
  (<>) = (.|.)

instance Monoid BreakStateFlags where
  {-# INLINE mempty #-}
  mempty = BreakStateFlags 0

instance Show BreakStateFlags where
  showsPrec = showsFlags breakStateBits "BreakStateFlags" \(BreakStateFlags i) -> i

breakStateBits :: [(BreakStateFlags, String)]
breakStateBits =
  [ (BREAK_STATE_FLAG_STARTED, "BREAK_STATE_FLAG_STARTED")
  , (BREAK_STATE_FLAG_END, "BREAK_STATE_FLAG_END")
  , (BREAK_STATE_FLAG_SAW_R_AFTER_L, "BREAK_STATE_FLAG_SAW_R_AFTER_L")
  , (BREAK_STATE_FLAG_SAW_AL_AFTER_LR, "BREAK_STATE_FLAG_SAW_AL_AFTER_LR")
  , (BREAK_STATE_FLAG_LAST_WAS_BRACKET, "BREAK_STATE_FLAG_LAST_WAS_BRACKET")
  ]

pattern BREAK_STATE_FLAG_STARTED :: BreakStateFlags
pattern BREAK_STATE_FLAG_STARTED = BreakStateFlags (#const KBTS_BREAK_STATE_FLAG_STARTED)

pattern BREAK_STATE_FLAG_END :: BreakStateFlags
pattern BREAK_STATE_FLAG_END = BreakStateFlags (#const KBTS_BREAK_STATE_FLAG_END)

-- Bidirectional flags

pattern BREAK_STATE_FLAG_SAW_R_AFTER_L :: BreakStateFlags
pattern BREAK_STATE_FLAG_SAW_R_AFTER_L = BreakStateFlags (#const KBTS_BREAK_STATE_FLAG_SAW_R_AFTER_L)

pattern BREAK_STATE_FLAG_SAW_AL_AFTER_LR :: BreakStateFlags
pattern BREAK_STATE_FLAG_SAW_AL_AFTER_LR = BreakStateFlags (#const KBTS_BREAK_STATE_FLAG_SAW_AL_AFTER_LR)

pattern BREAK_STATE_FLAG_LAST_WAS_BRACKET :: BreakStateFlags
pattern BREAK_STATE_FLAG_LAST_WAS_BRACKET = BreakStateFlags (#const KBTS_BREAK_STATE_FLAG_LAST_WAS_BRACKET)

-- ** BreakConfigFlags

newtype BreakConfigFlags = BreakConfigFlags Word32
  deriving (Eq, Ord)
  deriving newtype (Storable, Bits)

instance Semigroup BreakConfigFlags where
  {-# INLINE (<>) #-}
  (<>) = (.|.)

instance Monoid BreakConfigFlags where
  {-# INLINE mempty #-}
  mempty = BreakConfigFlags 0

instance Show BreakConfigFlags where
  showsPrec = showsFlags breakConfigBits "BreakConfigFlags" \(BreakConfigFlags i) -> i

breakConfigBits :: [(BreakConfigFlags, String)]
breakConfigBits =
  [ (BREAK_CONFIG_FLAG_END_OF_TEXT_GENERATES_HARD_LINE_BREAK, "BREAK_CONFIG_FLAG_END_OF_TEXT_GENERATES_HARD_LINE_BREAK")
  ]

pattern BREAK_CONFIG_FLAG_END_OF_TEXT_GENERATES_HARD_LINE_BREAK :: BreakConfigFlags
pattern BREAK_CONFIG_FLAG_END_OF_TEXT_GENERATES_HARD_LINE_BREAK = BreakConfigFlags (#const KBTS_BREAK_CONFIG_FLAG_END_OF_TEXT_GENERATES_HARD_LINE_BREAK)

-- ** FontStyleFlags

newtype FontStyleFlags = FontStyleFlags Word32
  deriving (Eq)
  deriving newtype (Storable, Bits)

instance Semigroup FontStyleFlags where
  {-# INLINE (<>) #-}
  (<>) = (.|.)

instance Monoid FontStyleFlags where
  {-# INLINE mempty #-}
  mempty = FontStyleFlags 0

instance Show FontStyleFlags where
  showsPrec = showsFlags fontStyleBits "FontStyleFlags" \(FontStyleFlags i) -> i

fontStyleBits :: [(FontStyleFlags, String)]
fontStyleBits =
  [ (FONT_STYLE_FLAG_REGULAR, "FONT_STYLE_FLAG_REGULAR")
  , (FONT_STYLE_FLAG_ITALIC, "FONT_STYLE_FLAG_ITALIC")
  , (FONT_STYLE_FLAG_BOLD, "FONT_STYLE_FLAG_BOLD")
  ]

pattern FONT_STYLE_FLAG_REGULAR :: FontStyleFlags
pattern FONT_STYLE_FLAG_REGULAR = FontStyleFlags (#const KBTS_FONT_STYLE_FLAG_REGULAR)

pattern FONT_STYLE_FLAG_ITALIC :: FontStyleFlags
pattern FONT_STYLE_FLAG_ITALIC = FontStyleFlags (#const KBTS_FONT_STYLE_FLAG_ITALIC)

pattern FONT_STYLE_FLAG_BOLD :: FontStyleFlags
pattern FONT_STYLE_FLAG_BOLD = FontStyleFlags (#const KBTS_FONT_STYLE_FLAG_BOLD)

-- ** GlyphFlags

newtype GlyphFlags = GlyphFlags Word32
  deriving (Eq)
  deriving newtype (Storable, Bits)

instance Semigroup GlyphFlags where
  {-# INLINE (<>) #-}
  (<>) = (.|.)

instance Monoid GlyphFlags where
  {-# INLINE mempty #-}
  mempty = GlyphFlags 0

instance Show GlyphFlags where
  showsPrec = showsFlags glyphBits "GlyphFlags" \(GlyphFlags i) -> i

glyphBits :: [(GlyphFlags, String)]
glyphBits =
  [ (GLYPH_FLAG_ISOL, "GLYPH_FLAG_ISOL")
  , (GLYPH_FLAG_FINA, "GLYPH_FLAG_FINA")
  , (GLYPH_FLAG_FIN2, "GLYPH_FLAG_FIN2")
  , (GLYPH_FLAG_FIN3, "GLYPH_FLAG_FIN3")
  , (GLYPH_FLAG_MEDI, "GLYPH_FLAG_MEDI")
  , (GLYPH_FLAG_MED2, "GLYPH_FLAG_MED2")
  , (GLYPH_FLAG_INIT, "GLYPH_FLAG_INIT")
  , (GLYPH_FLAG_LJMO, "GLYPH_FLAG_LJMO")
  , (GLYPH_FLAG_VJMO, "GLYPH_FLAG_VJMO")
  , (GLYPH_FLAG_TJMO, "GLYPH_FLAG_TJMO")
  , (GLYPH_FLAG_RPHF, "GLYPH_FLAG_RPHF")
  , (GLYPH_FLAG_BLWF, "GLYPH_FLAG_BLWF")
  , (GLYPH_FLAG_HALF, "GLYPH_FLAG_HALF")
  , (GLYPH_FLAG_PSTF, "GLYPH_FLAG_PSTF")
  , (GLYPH_FLAG_ABVF, "GLYPH_FLAG_ABVF")
  , (GLYPH_FLAG_PREF, "GLYPH_FLAG_PREF")
  , (GLYPH_FLAG_NUMR, "GLYPH_FLAG_NUMR")
  , (GLYPH_FLAG_FRAC, "GLYPH_FLAG_FRAC")
  , (GLYPH_FLAG_DNOM, "GLYPH_FLAG_DNOM")
  , (GLYPH_FLAG_CFAR, "GLYPH_FLAG_CFAR")
  , (GLYPH_FLAG_DO_NOT_DECOMPOSE, "GLYPH_FLAG_DO_NOT_DECOMPOSE")
  , (GLYPH_FLAG_FIRST_IN_MULTIPLE_SUBSTITUTION, "GLYPH_FLAG_FIRST_IN_MULTIPLE_SUBSTITUTION")
  , (GLYPH_FLAG_NO_BREAK, "GLYPH_FLAG_NO_BREAK")
  , (GLYPH_FLAG_CURSIVE, "GLYPH_FLAG_CURSIVE")
  , (GLYPH_FLAG_GENERATED_BY_GSUB, "GLYPH_FLAG_GENERATED_BY_GSUB")
  , (GLYPH_FLAG_USED_IN_GPOS, "GLYPH_FLAG_USED_IN_GPOS")
  , (GLYPH_FLAG_STCH_ENDPOINT, "GLYPH_FLAG_STCH_ENDPOINT")
  , (GLYPH_FLAG_STCH_EXTENSION, "GLYPH_FLAG_STCH_EXTENSION")
  , (GLYPH_FLAG_LIGATURE, "GLYPH_FLAG_LIGATURE")
  , (GLYPH_FLAG_MULTIPLE_SUBSTITUTION, "GLYPH_FLAG_MULTIPLE_SUBSTITUTION")
  ]

pattern GLYPH_FLAG_ISOL :: GlyphFlags
pattern GLYPH_FLAG_ISOL = GlyphFlags (#const KBTS_GLYPH_FLAG_ISOL)

pattern GLYPH_FLAG_FINA :: GlyphFlags
pattern GLYPH_FLAG_FINA = GlyphFlags (#const KBTS_GLYPH_FLAG_FINA)

pattern GLYPH_FLAG_FIN2 :: GlyphFlags
pattern GLYPH_FLAG_FIN2 = GlyphFlags (#const KBTS_GLYPH_FLAG_FIN2)

pattern GLYPH_FLAG_FIN3 :: GlyphFlags
pattern GLYPH_FLAG_FIN3 = GlyphFlags (#const KBTS_GLYPH_FLAG_FIN3)

pattern GLYPH_FLAG_MEDI :: GlyphFlags
pattern GLYPH_FLAG_MEDI = GlyphFlags (#const KBTS_GLYPH_FLAG_MEDI)

pattern GLYPH_FLAG_MED2 :: GlyphFlags
pattern GLYPH_FLAG_MED2 = GlyphFlags (#const KBTS_GLYPH_FLAG_MED2)

pattern GLYPH_FLAG_INIT :: GlyphFlags
pattern GLYPH_FLAG_INIT = GlyphFlags (#const KBTS_GLYPH_FLAG_INIT)

pattern GLYPH_FLAG_LJMO :: GlyphFlags
pattern GLYPH_FLAG_LJMO = GlyphFlags (#const KBTS_GLYPH_FLAG_LJMO)

pattern GLYPH_FLAG_VJMO :: GlyphFlags
pattern GLYPH_FLAG_VJMO = GlyphFlags (#const KBTS_GLYPH_FLAG_VJMO)

pattern GLYPH_FLAG_TJMO :: GlyphFlags
pattern GLYPH_FLAG_TJMO = GlyphFlags (#const KBTS_GLYPH_FLAG_TJMO)

pattern GLYPH_FLAG_RPHF :: GlyphFlags
pattern GLYPH_FLAG_RPHF = GlyphFlags (#const KBTS_GLYPH_FLAG_RPHF)

pattern GLYPH_FLAG_BLWF :: GlyphFlags
pattern GLYPH_FLAG_BLWF = GlyphFlags (#const KBTS_GLYPH_FLAG_BLWF)

pattern GLYPH_FLAG_HALF :: GlyphFlags
pattern GLYPH_FLAG_HALF = GlyphFlags (#const KBTS_GLYPH_FLAG_HALF)

pattern GLYPH_FLAG_PSTF :: GlyphFlags
pattern GLYPH_FLAG_PSTF = GlyphFlags (#const KBTS_GLYPH_FLAG_PSTF)

pattern GLYPH_FLAG_ABVF :: GlyphFlags
pattern GLYPH_FLAG_ABVF = GlyphFlags (#const KBTS_GLYPH_FLAG_ABVF)

pattern GLYPH_FLAG_PREF :: GlyphFlags
pattern GLYPH_FLAG_PREF = GlyphFlags (#const KBTS_GLYPH_FLAG_PREF)

pattern GLYPH_FLAG_NUMR :: GlyphFlags
pattern GLYPH_FLAG_NUMR = GlyphFlags (#const KBTS_GLYPH_FLAG_NUMR)

pattern GLYPH_FLAG_FRAC :: GlyphFlags
pattern GLYPH_FLAG_FRAC = GlyphFlags (#const KBTS_GLYPH_FLAG_FRAC)

pattern GLYPH_FLAG_DNOM :: GlyphFlags
pattern GLYPH_FLAG_DNOM = GlyphFlags (#const KBTS_GLYPH_FLAG_DNOM)

pattern GLYPH_FLAG_CFAR :: GlyphFlags
pattern GLYPH_FLAG_CFAR = GlyphFlags (#const KBTS_GLYPH_FLAG_CFAR)

pattern GLYPH_FLAG_DO_NOT_DECOMPOSE :: GlyphFlags
pattern GLYPH_FLAG_DO_NOT_DECOMPOSE = GlyphFlags (#const KBTS_GLYPH_FLAG_DO_NOT_DECOMPOSE)

pattern GLYPH_FLAG_FIRST_IN_MULTIPLE_SUBSTITUTION :: GlyphFlags
pattern GLYPH_FLAG_FIRST_IN_MULTIPLE_SUBSTITUTION = GlyphFlags (#const KBTS_GLYPH_FLAG_FIRST_IN_MULTIPLE_SUBSTITUTION)

pattern GLYPH_FLAG_NO_BREAK :: GlyphFlags
pattern GLYPH_FLAG_NO_BREAK = GlyphFlags (#const KBTS_GLYPH_FLAG_NO_BREAK)

pattern GLYPH_FLAG_CURSIVE :: GlyphFlags
pattern GLYPH_FLAG_CURSIVE = GlyphFlags (#const KBTS_GLYPH_FLAG_CURSIVE)

pattern GLYPH_FLAG_GENERATED_BY_GSUB :: GlyphFlags
pattern GLYPH_FLAG_GENERATED_BY_GSUB = GlyphFlags (#const KBTS_GLYPH_FLAG_GENERATED_BY_GSUB)

pattern GLYPH_FLAG_USED_IN_GPOS :: GlyphFlags
pattern GLYPH_FLAG_USED_IN_GPOS = GlyphFlags (#const KBTS_GLYPH_FLAG_USED_IN_GPOS)

pattern GLYPH_FLAG_STCH_ENDPOINT :: GlyphFlags
pattern GLYPH_FLAG_STCH_ENDPOINT = GlyphFlags (#const KBTS_GLYPH_FLAG_STCH_ENDPOINT)

pattern GLYPH_FLAG_STCH_EXTENSION :: GlyphFlags
pattern GLYPH_FLAG_STCH_EXTENSION = GlyphFlags (#const KBTS_GLYPH_FLAG_STCH_EXTENSION)

pattern GLYPH_FLAG_LIGATURE :: GlyphFlags
pattern GLYPH_FLAG_LIGATURE = GlyphFlags (#const KBTS_GLYPH_FLAG_LIGATURE)

pattern GLYPH_FLAG_MULTIPLE_SUBSTITUTION :: GlyphFlags
pattern GLYPH_FLAG_MULTIPLE_SUBSTITUTION = GlyphFlags (#const KBTS_GLYPH_FLAG_MULTIPLE_SUBSTITUTION)

-- * Flag utils

{-# INLINE showsFlags #-}
showsFlags :: (Bits a, Num x, Eq x, Show x) => [(a, String)] -> String -> (a -> x) -> Int -> a -> ShowS
showsFlags knownBits typeName unwrap d combined =
  case (remains, found) of
    (_, []) -> showParen (d > 10) showsRemains
    (0, [(_single, name)]) -> showString name
    (0, (_, initial) : rest) -> showParen (d > 10) $ showString initial . foldr (\(_flag, name) next -> showString " <> " . showString name . next) id rest
    (_, some) -> showParen (d > 10) $ foldr (\(_flag, name) next -> showString name . showString " <> " . next) showsRemains some
  where
    remains = unwrap remains'
    (remains', found) = splitFlags knownBits combined
    showsRemains = showString typeName . showString (' ' : show remains)

splitFlags
  :: Bits a
  => [(a, b)] -- static part
  -> a -> (a, [(a, b)]) -- unpacker function
splitFlags flagBits combined = foldr testFst (combined, []) flagBits
  where
    testFst pair@(flagBit, _) acc@(remaining, found)
      | remaining .&. flagBit == flagBit = (remaining .^. flagBit, pair : found)
      | otherwise = acc