{-# LANGUAGE NoImplicitPrelude #-}

-- | Text grapheme utilities.
--
-- @since 0.1
module Unicode.Grapheme
  ( -- $intro
    UnicodeFunction,

    -- ** Construction
    breakGraphemeClusters,
    textWidth,
    clusterWidth,

    -- ** Operations
    dimap,
    map,

    -- ** Elimination
    runUnicodeFunction,
    runUnicodeFunctionVersion,

    -- * Unicode versions
    UnicodeVersion (..),

    -- ** Functions
    Version.getBaseUnicodeVersion,
    Version.getBaseUnicodeVersionIO,
    Version.getBaseUnicodeVersionOrLatest,

    -- ** Display
    Version.displayVersion,

    -- ** Errors
    Version.UnsupportedUnicodeE (..),
  )
where

import Control.Applicative (Applicative (pure, (<*>)))
import Control.Arrow
  ( Arrow (arr, (***)),
    ArrowApply (app),
    ArrowChoice ((+++)),
  )
import Control.Category (Category (id, (.)))
import Control.Monad (Monad ((>>=)))
import Data.Bifunctor qualified as B
import Data.Foldable qualified as F
import Data.Function (const)
import Data.Functor (Functor (fmap))
import Data.Int (Int)
import Data.Monoid (Monoid (mempty))
import Data.Semigroup (Semigroup ((<>)))
import Data.Text (Text)
import Unicode.Grapheme.Internal.V14_0 qualified as V14_0
import Unicode.Grapheme.Internal.V15_0 qualified as V15_0
import Unicode.Grapheme.Internal.V15_1 qualified as V15_1
import Unicode.Grapheme.Internal.V16_0 qualified as V16_0
import Unicode.Grapheme.Internal.Version
  ( UnicodeVersion
      ( UnicodeVersion_14_0,
        UnicodeVersion_15_0,
        UnicodeVersion_15_1,
        UnicodeVersion_16_0
      ),
  )
import Unicode.Grapheme.Internal.Version qualified as Version

-- $intro
--
-- Unicode functions are defined in terms of the abstract 'UnicodeFunction'
-- type, which allows us to conveniently wrap functionality across multiple
-- unicode versions.
--
-- These can then be combined in a variety of ways for handling the unicode
-- version.
--
-- For example, the following function will break the text into grapheme
-- clusters, using either @base@'s unicode version if it is supported, or
-- falling back to the latest supported version.
--
-- >>> :{
--   break :: Text -> [Text]
--   break = runUnicodeFunction breakGraphemeClusters
-- :}

-- | Breaks 'Text' into grapheme clusters.
--
-- ==== __Examples__
--
-- >>> runUnicodeFunction breakGraphemeClusters "abc"
-- ["a","b","c"]
--
-- >>> -- U+004F U+0308
-- >>> runUnicodeFunction breakGraphemeClusters "Ö"
-- ["O\776"]
--
-- >>> -- 🧑‍🌾
-- >>> runUnicodeFunction breakGraphemeClusters "\x1F9D1\x200D\x1F33E"
-- ["\129489\8205\127806"]
--
-- @since 0.1
breakGraphemeClusters :: UnicodeFunction Text [Text]
breakGraphemeClusters :: UnicodeFunction Text [Text]
breakGraphemeClusters =
  MkUnicodeFunction
    { v14_0 :: Text -> [Text]
v14_0 = Text -> [Text]
V14_0.breakGraphemeClusters,
      v15_0 :: Text -> [Text]
v15_0 = Text -> [Text]
V15_0.breakGraphemeClusters,
      v15_1 :: Text -> [Text]
v15_1 = Text -> [Text]
V15_1.breakGraphemeClusters,
      v16_0 :: Text -> [Text]
v16_0 = Text -> [Text]
V16_0.breakGraphemeClusters
    }

-- | Given a __single__ grapheme cluster -- of possibly multiple codepoints --
-- returns the width 1 or 2. This is based on heuristics i.e. if the text
-- contains at least one codepoint with the following properties:
--
--    - East_Asian_Width = Fullwidth or Wide
--    - Emoji_Presentation
--    - U+FE0F (emoji-style)
--
-- Then width is 2. Otherwise it is 1.
--
-- ===== __Examples__
--
--
-- >>> runUnicodeFunction clusterWidth "a"
-- 1
--
-- >>> runUnicodeFunction clusterWidth "🇯🇵"
-- 2
--
-- >>> -- Used with multiple clusters can lead to unexpected results!
-- >>> runUnicodeFunction clusterWidth "abc"
-- 1
--
-- @since 0.1
clusterWidth :: UnicodeFunction Text Int
clusterWidth :: UnicodeFunction Text Int
clusterWidth =
  MkUnicodeFunction
    { v14_0 :: Text -> Int
v14_0 = Text -> Int
V14_0.clusterWidth,
      v15_0 :: Text -> Int
v15_0 = Text -> Int
V15_0.clusterWidth,
      v15_1 :: Text -> Int
v15_1 = Text -> Int
V15_1.clusterWidth,
      v16_0 :: Text -> Int
v16_0 = Text -> Int
V16_0.clusterWidth
    }

-- | Splits the text into grapheme clusters and counts each cluster width.
--
-- ==== __Examples__
--
-- >>> runUnicodeFunction textWidth "abc"
-- 3
--
-- >>> -- U+004F U+0308
-- >>> runUnicodeFunction textWidth "Ö"
-- 1
--
-- >>> -- 🧑‍🌾
-- >>> runUnicodeFunction textWidth "\x1F9D1\x200D\x1F33E"
-- 2
--
-- @since 0.1
textWidth :: UnicodeFunction Text Int
textWidth :: UnicodeFunction Text Int
textWidth = ([Int] -> Int) -> UnicodeFunction [Int] Int
forall b c. (b -> c) -> UnicodeFunction b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum UnicodeFunction [Int] Int
-> UnicodeFunction Text [Int] -> UnicodeFunction Text Int
forall b c a.
UnicodeFunction b c -> UnicodeFunction a b -> UnicodeFunction a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Text -> Int) -> [Text] -> [Int])
-> UnicodeFunction Text Int -> UnicodeFunction [Text] [Int]
forall a b c d.
((a -> b) -> c -> d) -> UnicodeFunction a b -> UnicodeFunction c d
map (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnicodeFunction Text Int
clusterWidth UnicodeFunction [Text] [Int]
-> UnicodeFunction Text [Text] -> UnicodeFunction Text [Int]
forall b c a.
UnicodeFunction b c -> UnicodeFunction a b -> UnicodeFunction a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnicodeFunction Text [Text]
breakGraphemeClusters

-- | 'UnicodeFunction' represents some function that works across all
-- 'UnicodeVersion's. It can be extended via its 'Category' and 'Arrow'
-- instances.
--
-- >>> :{
--   textWidth :: UnicodeFunction Text Int
--   textWidth = arr F.sum . map fmap clusterWidth . breakGraphemeClusters
-- :}
--
-- @since 0.1
data UnicodeFunction a b = MkUnicodeFunction
  { -- | @since 0.1
    forall a b. UnicodeFunction a b -> a -> b
v14_0 :: a -> b,
    -- | @since 0.1
    forall a b. UnicodeFunction a b -> a -> b
v15_0 :: a -> b,
    -- | @since 0.1
    forall a b. UnicodeFunction a b -> a -> b
v15_1 :: a -> b,
    -- | @since 0.1
    forall a b. UnicodeFunction a b -> a -> b
v16_0 :: a -> b
  }
  deriving stock
    ( -- | @since 0.1
      (forall a b.
 (a -> b) -> UnicodeFunction a a -> UnicodeFunction a b)
-> (forall a b. a -> UnicodeFunction a b -> UnicodeFunction a a)
-> Functor (UnicodeFunction a)
forall a b. a -> UnicodeFunction a b -> UnicodeFunction a a
forall a b. (a -> b) -> UnicodeFunction a a -> UnicodeFunction a b
forall a a b. a -> UnicodeFunction a b -> UnicodeFunction a a
forall a a b.
(a -> b) -> UnicodeFunction a a -> UnicodeFunction a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b.
(a -> b) -> UnicodeFunction a a -> UnicodeFunction a b
fmap :: forall a b. (a -> b) -> UnicodeFunction a a -> UnicodeFunction a b
$c<$ :: forall a a b. a -> UnicodeFunction a b -> UnicodeFunction a a
<$ :: forall a b. a -> UnicodeFunction a b -> UnicodeFunction a a
Functor
    )

-- | @since 0.1
instance (Semigroup b) => Semigroup (UnicodeFunction a b) where
  UnicodeFunction a b
f <> :: UnicodeFunction a b -> UnicodeFunction a b -> UnicodeFunction a b
<> UnicodeFunction a b
g =
    MkUnicodeFunction
      { v14_0 :: a -> b
v14_0 = \a
x -> UnicodeFunction a b
f.v14_0 a
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> UnicodeFunction a b
g.v14_0 a
x,
        v15_0 :: a -> b
v15_0 = \a
x -> UnicodeFunction a b
f.v15_0 a
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> UnicodeFunction a b
g.v15_0 a
x,
        v15_1 :: a -> b
v15_1 = \a
x -> UnicodeFunction a b
f.v15_1 a
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> UnicodeFunction a b
g.v15_1 a
x,
        v16_0 :: a -> b
v16_0 = \a
x -> UnicodeFunction a b
f.v16_0 a
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> UnicodeFunction a b
g.v16_0 a
x
      }

-- | @since 0.1
instance (Monoid b) => Monoid (UnicodeFunction a b) where
  mempty :: UnicodeFunction a b
mempty =
    MkUnicodeFunction
      { v14_0 :: a -> b
v14_0 = b -> a -> b
forall a b. a -> b -> a
const b
forall a. Monoid a => a
mempty,
        v15_0 :: a -> b
v15_0 = b -> a -> b
forall a b. a -> b -> a
const b
forall a. Monoid a => a
mempty,
        v15_1 :: a -> b
v15_1 = b -> a -> b
forall a b. a -> b -> a
const b
forall a. Monoid a => a
mempty,
        v16_0 :: a -> b
v16_0 = b -> a -> b
forall a b. a -> b -> a
const b
forall a. Monoid a => a
mempty
      }

-- | @since 0.1
instance Applicative (UnicodeFunction a) where
  pure :: forall a. a -> UnicodeFunction a a
pure a
x =
    MkUnicodeFunction
      { v14_0 :: a -> a
v14_0 = a -> a -> a
forall a b. a -> b -> a
const a
x,
        v15_0 :: a -> a
v15_0 = a -> a -> a
forall a b. a -> b -> a
const a
x,
        v15_1 :: a -> a
v15_1 = a -> a -> a
forall a b. a -> b -> a
const a
x,
        v16_0 :: a -> a
v16_0 = a -> a -> a
forall a b. a -> b -> a
const a
x
      }

  UnicodeFunction a (a -> b)
f <*> :: forall a b.
UnicodeFunction a (a -> b)
-> UnicodeFunction a a -> UnicodeFunction a b
<*> UnicodeFunction a a
g =
    MkUnicodeFunction
      { v14_0 :: a -> b
v14_0 = \a
x -> UnicodeFunction a (a -> b)
f.v14_0 a
x (UnicodeFunction a a
g.v14_0 a
x),
        v15_0 :: a -> b
v15_0 = \a
x -> UnicodeFunction a (a -> b)
f.v15_0 a
x (UnicodeFunction a a
g.v15_0 a
x),
        v15_1 :: a -> b
v15_1 = \a
x -> UnicodeFunction a (a -> b)
f.v15_1 a
x (UnicodeFunction a a
g.v15_1 a
x),
        v16_0 :: a -> b
v16_0 = \a
x -> UnicodeFunction a (a -> b)
f.v16_0 a
x (UnicodeFunction a a
g.v16_0 a
x)
      }

-- | @since 0.1
instance Monad (UnicodeFunction a) where
  UnicodeFunction a a
f >>= :: forall a b.
UnicodeFunction a a
-> (a -> UnicodeFunction a b) -> UnicodeFunction a b
>>= a -> UnicodeFunction a b
k =
    MkUnicodeFunction
      { v14_0 :: a -> b
v14_0 = \a
x -> (a -> UnicodeFunction a b
k (UnicodeFunction a a
f.v14_0 a
x)).v14_0 a
x,
        v15_0 :: a -> b
v15_0 = \a
x -> (a -> UnicodeFunction a b
k (UnicodeFunction a a
f.v15_0 a
x)).v15_0 a
x,
        v15_1 :: a -> b
v15_1 = \a
x -> (a -> UnicodeFunction a b
k (UnicodeFunction a a
f.v15_1 a
x)).v15_1 a
x,
        v16_0 :: a -> b
v16_0 = \a
x -> (a -> UnicodeFunction a b
k (UnicodeFunction a a
f.v16_0 a
x)).v16_0 a
x
      }

-- | @since 0.1
instance Category UnicodeFunction where
  id :: forall a. UnicodeFunction a a
id =
    MkUnicodeFunction
      { v14_0 :: a -> a
v14_0 = a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id,
        v15_0 :: a -> a
v15_0 = a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id,
        v15_1 :: a -> a
v15_1 = a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id,
        v16_0 :: a -> a
v16_0 = a -> a
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
      }

  UnicodeFunction b c
f . :: forall b c a.
UnicodeFunction b c -> UnicodeFunction a b -> UnicodeFunction a c
. UnicodeFunction a b
g =
    MkUnicodeFunction
      { v14_0 :: a -> c
v14_0 = UnicodeFunction b c
f.v14_0 (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnicodeFunction a b
g.v14_0,
        v15_0 :: a -> c
v15_0 = UnicodeFunction b c
f.v15_0 (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnicodeFunction a b
g.v15_0,
        v15_1 :: a -> c
v15_1 = UnicodeFunction b c
f.v15_1 (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnicodeFunction a b
g.v15_1,
        v16_0 :: a -> c
v16_0 = UnicodeFunction b c
f.v16_0 (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnicodeFunction a b
g.v16_0
      }

-- | @since 0.1
instance Arrow UnicodeFunction where
  arr :: forall b c. (b -> c) -> UnicodeFunction b c
arr b -> c
f =
    MkUnicodeFunction
      { v14_0 :: b -> c
v14_0 = b -> c
f,
        v15_0 :: b -> c
v15_0 = b -> c
f,
        v15_1 :: b -> c
v15_1 = b -> c
f,
        v16_0 :: b -> c
v16_0 = b -> c
f
      }

  UnicodeFunction b c
f *** :: forall b c b' c'.
UnicodeFunction b c
-> UnicodeFunction b' c' -> UnicodeFunction (b, b') (c, c')
*** UnicodeFunction b' c'
g =
    MkUnicodeFunction
      { v14_0 :: (b, b') -> (c, c')
v14_0 = (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v14_0 UnicodeFunction b' c'
g.v14_0,
        v15_0 :: (b, b') -> (c, c')
v15_0 = (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v15_0 UnicodeFunction b' c'
g.v15_0,
        v15_1 :: (b, b') -> (c, c')
v15_1 = (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v15_1 UnicodeFunction b' c'
g.v15_1,
        v16_0 :: (b, b') -> (c, c')
v16_0 = (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v16_0 UnicodeFunction b' c'
g.v16_0
      }

-- | @since 0.1
instance ArrowApply UnicodeFunction where
  app :: forall b c. UnicodeFunction (UnicodeFunction b c, b) c
app =
    MkUnicodeFunction
      { v14_0 :: (UnicodeFunction b c, b) -> c
v14_0 = \(UnicodeFunction b c
f, b
x) -> UnicodeFunction b c
f.v14_0 b
x,
        v15_0 :: (UnicodeFunction b c, b) -> c
v15_0 = \(UnicodeFunction b c
f, b
x) -> UnicodeFunction b c
f.v15_0 b
x,
        v15_1 :: (UnicodeFunction b c, b) -> c
v15_1 = \(UnicodeFunction b c
f, b
x) -> UnicodeFunction b c
f.v15_1 b
x,
        v16_0 :: (UnicodeFunction b c, b) -> c
v16_0 = \(UnicodeFunction b c
f, b
x) -> UnicodeFunction b c
f.v16_0 b
x
      }

-- | @since 0.1
instance ArrowChoice UnicodeFunction where
  UnicodeFunction b c
f +++ :: forall b c b' c'.
UnicodeFunction b c
-> UnicodeFunction b' c'
-> UnicodeFunction (Either b b') (Either c c')
+++ UnicodeFunction b' c'
g =
    MkUnicodeFunction
      { v14_0 :: Either b b' -> Either c c'
v14_0 = (b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v14_0 UnicodeFunction b' c'
g.v14_0,
        v15_0 :: Either b b' -> Either c c'
v15_0 = (b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v15_0 UnicodeFunction b' c'
g.v15_0,
        v15_1 :: Either b b' -> Either c c'
v15_1 = (b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v15_1 UnicodeFunction b' c'
g.v15_1,
        v16_0 :: Either b b' -> Either c c'
v16_0 = (b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
B.bimap UnicodeFunction b c
f.v16_0 UnicodeFunction b' c'
g.v16_0
      }

-- | Dimaps a 'UnicodeFunction'.
--
-- @since 0.1
dimap ::
  -- | Contravariantly map input.
  (c -> a) ->
  -- | Covariantly map output.
  (b -> d) ->
  UnicodeFunction a b ->
  UnicodeFunction c d
dimap :: forall c a b d.
(c -> a) -> (b -> d) -> UnicodeFunction a b -> UnicodeFunction c d
dimap c -> a
f b -> d
g = ((a -> b) -> c -> d) -> UnicodeFunction a b -> UnicodeFunction c d
forall a b c d.
((a -> b) -> c -> d) -> UnicodeFunction a b -> UnicodeFunction c d
map (\a -> b
k -> b -> d
g (b -> d) -> (c -> b) -> c -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
k (a -> b) -> (c -> a) -> c -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. c -> a
f)

-- | Maps a 'UnicodeFunction'.
--
-- @since 0.1
map ::
  -- | Function mapper.
  ((a -> b) -> c -> d) ->
  -- | Unicode function.
  UnicodeFunction a b ->
  UnicodeFunction c d
map :: forall a b c d.
((a -> b) -> c -> d) -> UnicodeFunction a b -> UnicodeFunction c d
map (a -> b) -> c -> d
k UnicodeFunction a b
f =
  MkUnicodeFunction
    { v14_0 :: c -> d
v14_0 = (a -> b) -> c -> d
k UnicodeFunction a b
f.v14_0,
      v15_0 :: c -> d
v15_0 = (a -> b) -> c -> d
k UnicodeFunction a b
f.v15_0,
      v15_1 :: c -> d
v15_1 = (a -> b) -> c -> d
k UnicodeFunction a b
f.v15_1,
      v16_0 :: c -> d
v16_0 = (a -> b) -> c -> d
k UnicodeFunction a b
f.v16_0
    }

-- | Runs the 'UnicodeFunction' with @base@'s unicode version, if it is
-- supported. Otherwise uses the latest supported version.
--
-- @since 0.1
runUnicodeFunction :: UnicodeFunction a b -> a -> b
runUnicodeFunction :: forall a b. UnicodeFunction a b -> a -> b
runUnicodeFunction = UnicodeVersion -> UnicodeFunction a b -> a -> b
forall a b. UnicodeVersion -> UnicodeFunction a b -> a -> b
runUnicodeFunctionVersion UnicodeVersion
Version.getBaseUnicodeVersionOrLatest

-- | Runs the 'UnicodeFunction' with the given unicode version.
--
-- @since 0.1
runUnicodeFunctionVersion :: UnicodeVersion -> UnicodeFunction a b -> a -> b
runUnicodeFunctionVersion :: forall a b. UnicodeVersion -> UnicodeFunction a b -> a -> b
runUnicodeFunctionVersion UnicodeVersion
vers UnicodeFunction a b
f = case UnicodeVersion
vers of
  UnicodeVersion
UnicodeVersion_14_0 -> UnicodeFunction a b
f.v14_0
  UnicodeVersion
UnicodeVersion_15_0 -> UnicodeFunction a b
f.v15_0
  UnicodeVersion
UnicodeVersion_15_1 -> UnicodeFunction a b
f.v15_1
  UnicodeVersion
UnicodeVersion_16_0 -> UnicodeFunction a b
f.v16_0