{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

-- | This module offers functions related to 'Data.Char.GeneralCategory'
--    but queries Unicode 13.0.0 database.
module Data.Char.GeneralCategory.V13_0_0
  ( generalCategory
  , isLetter
  , isMark
  , isNumber
  , isPunctuation
  , isSymbol
  , isSeparator
  , genCatDb
  )
where

import Data.Binary
import qualified Data.ByteString.Lazy as BSL
import Data.Char.GeneralCategory.Database
import qualified Data.Char.GeneralCategory.Predicates as GCP
import Data.FileEmbed

genCatDb :: GenCatDatabase
genCatDb :: GenCatDatabase
genCatDb = ByteString -> GenCatDatabase
forall a. Binary a => ByteString -> a
decode (ByteString -> GenCatDatabase) -> ByteString -> GenCatDatabase
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict $(embedFile "embed/v13.0.0.raw")

GCP.Predicates {Char -> Bool
Char -> GeneralCategory
isSeparator :: forall i. Predicates i -> i -> Bool
isSymbol :: forall i. Predicates i -> i -> Bool
isPunctuation :: forall i. Predicates i -> i -> Bool
isNumber :: forall i. Predicates i -> i -> Bool
isMark :: forall i. Predicates i -> i -> Bool
isLetter :: forall i. Predicates i -> i -> Bool
generalCategory :: forall i. Predicates i -> i -> GeneralCategory
isSeparator :: Char -> Bool
isSymbol :: Char -> Bool
isPunctuation :: Char -> Bool
isNumber :: Char -> Bool
isMark :: Char -> Bool
isLetter :: Char -> Bool
generalCategory :: Char -> GeneralCategory
..} = (Char -> GeneralCategory) -> Predicates Char
GCP.mkPredicates (GenCatDatabase -> Char -> GeneralCategory
query GenCatDatabase
genCatDb)