{- |
Copyright : (c) 2024 Pierre Le Marre
Maintainer: dev@wismill.eu
Stability   : experimental

Parser for [UnicodeData.txt](https://www.unicode.org/reports/tr44/#UnicodeData.txt).

@since 0.1.0
-}
module UCD.Parser.UnicodeData (
  GeneralCategory (..),
  DecompositionType (..),
  Decomposition (..),
  Entry (..),
  NumericValue (..),
  CharDetails (..),
  parse,
) where

import Data.ByteString qualified as B
import Data.ByteString.Char8 qualified as B8
import Data.ByteString.Short qualified as BS
import Data.List qualified as L
import Data.Ratio ((%))
import Data.Word (Word8)
import UCD.Parser.Common (
  UnicodeRange (..),
  readCodePoint,
  readCodePointM,
  pattern Comma,
  pattern NewLine,
  pattern SemiColon,
  pattern Slash,
 )

-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------

{- | See: https://www.unicode.org/reports/tr44/#General_Category

@since 0.1.0
-}
data GeneralCategory
  = -- | Letter, Uppercase
    Lu
  | -- | Letter, Lowercase
    Ll
  | -- | Letter, Titlecase
    Lt
  | -- | Letter, Modifier
    Lm
  | -- | Letter, Other
    Lo
  | -- | Mark, Non-Spacing
    Mn
  | -- | Mark, Spacing Combining
    Mc
  | -- | Mark, Enclosing
    Me
  | -- | Number, Decimal
    Nd
  | -- | Number, Letter
    Nl
  | -- | Number, Other
    No
  | -- | Punctuation, Connector
    Pc
  | -- | Punctuation, Dash
    Pd
  | -- | Punctuation, Open
    Ps
  | -- | Punctuation, Close
    Pe
  | -- | Punctuation, Initial quote
    Pi
  | -- | Punctuation, Final quote
    Pf
  | -- | Punctuation, Other
    Po
  | -- | Symbol, Math
    Sm
  | -- | Symbol, Currency
    Sc
  | -- | Symbol, Modifier
    Sk
  | -- | Symbol, Other
    So
  | -- | Separator, Space
    Zs
  | -- | Separator, Line
    Zl
  | -- | Separator, Paragraph
    Zp
  | -- | Other, Control
    Cc
  | -- | Other, Format
    Cf
  | -- | Other, Surrogate
    Cs
  | -- | Other, Private Use
    Co
  | -- | Other, Not Assigned
    Cn
  deriving (GeneralCategory
GeneralCategory -> GeneralCategory -> Bounded GeneralCategory
forall a. a -> a -> Bounded a
$cminBound :: GeneralCategory
minBound :: GeneralCategory
$cmaxBound :: GeneralCategory
maxBound :: GeneralCategory
Bounded, Int -> GeneralCategory
GeneralCategory -> Int
GeneralCategory -> [GeneralCategory]
GeneralCategory -> GeneralCategory
GeneralCategory -> GeneralCategory -> [GeneralCategory]
GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
(GeneralCategory -> GeneralCategory)
-> (GeneralCategory -> GeneralCategory)
-> (Int -> GeneralCategory)
-> (GeneralCategory -> Int)
-> (GeneralCategory -> [GeneralCategory])
-> (GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> (GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> (GeneralCategory
    -> GeneralCategory -> GeneralCategory -> [GeneralCategory])
-> Enum GeneralCategory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GeneralCategory -> GeneralCategory
succ :: GeneralCategory -> GeneralCategory
$cpred :: GeneralCategory -> GeneralCategory
pred :: GeneralCategory -> GeneralCategory
$ctoEnum :: Int -> GeneralCategory
toEnum :: Int -> GeneralCategory
$cfromEnum :: GeneralCategory -> Int
fromEnum :: GeneralCategory -> Int
$cenumFrom :: GeneralCategory -> [GeneralCategory]
enumFrom :: GeneralCategory -> [GeneralCategory]
$cenumFromThen :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFromThen :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
$cenumFromTo :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFromTo :: GeneralCategory -> GeneralCategory -> [GeneralCategory]
$cenumFromThenTo :: GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
enumFromThenTo :: GeneralCategory
-> GeneralCategory -> GeneralCategory -> [GeneralCategory]
Enum, GeneralCategory -> GeneralCategory -> Bool
(GeneralCategory -> GeneralCategory -> Bool)
-> (GeneralCategory -> GeneralCategory -> Bool)
-> Eq GeneralCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneralCategory -> GeneralCategory -> Bool
== :: GeneralCategory -> GeneralCategory -> Bool
$c/= :: GeneralCategory -> GeneralCategory -> Bool
/= :: GeneralCategory -> GeneralCategory -> Bool
Eq, Int -> GeneralCategory -> ShowS
[GeneralCategory] -> ShowS
GeneralCategory -> [Char]
(Int -> GeneralCategory -> ShowS)
-> (GeneralCategory -> [Char])
-> ([GeneralCategory] -> ShowS)
-> Show GeneralCategory
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneralCategory -> ShowS
showsPrec :: Int -> GeneralCategory -> ShowS
$cshow :: GeneralCategory -> [Char]
show :: GeneralCategory -> [Char]
$cshowList :: [GeneralCategory] -> ShowS
showList :: [GeneralCategory] -> ShowS
Show, ReadPrec [GeneralCategory]
ReadPrec GeneralCategory
Int -> ReadS GeneralCategory
ReadS [GeneralCategory]
(Int -> ReadS GeneralCategory)
-> ReadS [GeneralCategory]
-> ReadPrec GeneralCategory
-> ReadPrec [GeneralCategory]
-> Read GeneralCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GeneralCategory
readsPrec :: Int -> ReadS GeneralCategory
$creadList :: ReadS [GeneralCategory]
readList :: ReadS [GeneralCategory]
$creadPrec :: ReadPrec GeneralCategory
readPrec :: ReadPrec GeneralCategory
$creadListPrec :: ReadPrec [GeneralCategory]
readListPrec :: ReadPrec [GeneralCategory]
Read)

{- | See: https://www.unicode.org/reports/tr44/#Character_Decomposition_Mappings

@since 0.1.0
-}
data DecompositionType
  = DTCanonical
  | DTCompat
  | DTFont
  | DTNoBreak
  | DTInitial
  | DTMedial
  | DTFinal
  | DTIsolated
  | DTCircle
  | DTSuper
  | DTSub
  | DTVertical
  | DTWide
  | DTNarrow
  | DTSmall
  | DTSquare
  | DTFraction
  deriving (Int -> DecompositionType -> ShowS
[DecompositionType] -> ShowS
DecompositionType -> [Char]
(Int -> DecompositionType -> ShowS)
-> (DecompositionType -> [Char])
-> ([DecompositionType] -> ShowS)
-> Show DecompositionType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecompositionType -> ShowS
showsPrec :: Int -> DecompositionType -> ShowS
$cshow :: DecompositionType -> [Char]
show :: DecompositionType -> [Char]
$cshowList :: [DecompositionType] -> ShowS
showList :: [DecompositionType] -> ShowS
Show, DecompositionType -> DecompositionType -> Bool
(DecompositionType -> DecompositionType -> Bool)
-> (DecompositionType -> DecompositionType -> Bool)
-> Eq DecompositionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecompositionType -> DecompositionType -> Bool
== :: DecompositionType -> DecompositionType -> Bool
$c/= :: DecompositionType -> DecompositionType -> Bool
/= :: DecompositionType -> DecompositionType -> Bool
Eq)

{- | Unicode decomposition of a code point

@since 0.1.0
-}
data Decomposition
  = Self
  | Decomposition !DecompositionType ![Char]
  deriving (Int -> Decomposition -> ShowS
[Decomposition] -> ShowS
Decomposition -> [Char]
(Int -> Decomposition -> ShowS)
-> (Decomposition -> [Char])
-> ([Decomposition] -> ShowS)
-> Show Decomposition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Decomposition -> ShowS
showsPrec :: Int -> Decomposition -> ShowS
$cshow :: Decomposition -> [Char]
show :: Decomposition -> [Char]
$cshowList :: [Decomposition] -> ShowS
showList :: [Decomposition] -> ShowS
Show, Decomposition -> Decomposition -> Bool
(Decomposition -> Decomposition -> Bool)
-> (Decomposition -> Decomposition -> Bool) -> Eq Decomposition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Decomposition -> Decomposition -> Bool
== :: Decomposition -> Decomposition -> Bool
$c/= :: Decomposition -> Decomposition -> Bool
/= :: Decomposition -> Decomposition -> Bool
Eq)

{- | Numeric value of a code point, if relevant

@since 0.1.0
-}
data NumericValue
  = NotNumeric
  | Digit !Word8
  | Integer !Integer
  | Rational !Rational
  deriving (NumericValue -> NumericValue -> Bool
(NumericValue -> NumericValue -> Bool)
-> (NumericValue -> NumericValue -> Bool) -> Eq NumericValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumericValue -> NumericValue -> Bool
== :: NumericValue -> NumericValue -> Bool
$c/= :: NumericValue -> NumericValue -> Bool
/= :: NumericValue -> NumericValue -> Bool
Eq, Int -> NumericValue -> ShowS
[NumericValue] -> ShowS
NumericValue -> [Char]
(Int -> NumericValue -> ShowS)
-> (NumericValue -> [Char])
-> ([NumericValue] -> ShowS)
-> Show NumericValue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumericValue -> ShowS
showsPrec :: Int -> NumericValue -> ShowS
$cshow :: NumericValue -> [Char]
show :: NumericValue -> [Char]
$cshowList :: [NumericValue] -> ShowS
showList :: [NumericValue] -> ShowS
Show)

{- | Core characteristics of a Unicode code point

@since 0.1.0
-}
data CharDetails
  = CharDetails
  { CharDetails -> GeneralCategory
_generalCategory ∷ !GeneralCategory
  , CharDetails -> Int
_combiningClass ∷ !Int
  , CharDetails -> Decomposition
_decomposition ∷ !Decomposition
  , CharDetails -> NumericValue
_numericValue ∷ !NumericValue
  , CharDetails -> Maybe Char
_simpleUpperCaseMapping ∷ !(Maybe Char)
  , CharDetails -> Maybe Char
_simpleLowerCaseMapping ∷ !(Maybe Char)
  , CharDetails -> Maybe Char
_simpleTitleCaseMapping ∷ !(Maybe Char)
  }
  deriving (CharDetails -> CharDetails -> Bool
(CharDetails -> CharDetails -> Bool)
-> (CharDetails -> CharDetails -> Bool) -> Eq CharDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CharDetails -> CharDetails -> Bool
== :: CharDetails -> CharDetails -> Bool
$c/= :: CharDetails -> CharDetails -> Bool
/= :: CharDetails -> CharDetails -> Bool
Eq, Int -> CharDetails -> ShowS
[CharDetails] -> ShowS
CharDetails -> [Char]
(Int -> CharDetails -> ShowS)
-> (CharDetails -> [Char])
-> ([CharDetails] -> ShowS)
-> Show CharDetails
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CharDetails -> ShowS
showsPrec :: Int -> CharDetails -> ShowS
$cshow :: CharDetails -> [Char]
show :: CharDetails -> [Char]
$cshowList :: [CharDetails] -> ShowS
showList :: [CharDetails] -> ShowS
Show)

{- | An entry in @UnicodeData.txt@.

@since 0.1.0
-}
data Entry = Entry
  { Entry -> UnicodeRange ShortByteString
_range ∷ !(UnicodeRange BS.ShortByteString)
  , Entry -> CharDetails
_details ∷ !CharDetails
  }
  deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> [Char]
(Int -> Entry -> ShowS)
-> (Entry -> [Char]) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> [Char]
show :: Entry -> [Char]
$cshowList :: [Entry] -> ShowS
showList :: [Entry] -> ShowS
Show)

--------------------------------------------------------------------------------
-- Parser
--------------------------------------------------------------------------------

newtype Name = Name BS.ShortByteString

data PendingUnicodeDataRange
  = NoRange
  | -- | A partial range for entry with a name as: @\<RANGE_IDENTIFIER, First\>@
    FirstCode !BS.ShortByteString !Char !CharDetails

data UnicodeDataAcc = UnicodeDataAcc !B.ByteString !PendingUnicodeDataRange

data RawEntry = Complete !Entry | Incomplete !PendingUnicodeDataRange

{- | Parser for [UnicodeData.txt file](https://www.unicode.org/reports/tr44/#UnicodeData.txt)

@since 0.1.0
-}
parse ∷ B.ByteString → [Entry]
parse :: ByteString -> [Entry]
parse = (UnicodeDataAcc -> Maybe (Entry, UnicodeDataAcc))
-> UnicodeDataAcc -> [Entry]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr UnicodeDataAcc -> Maybe (Entry, UnicodeDataAcc)
go (UnicodeDataAcc -> [Entry])
-> (ByteString -> UnicodeDataAcc) -> ByteString -> [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> PendingUnicodeDataRange -> UnicodeDataAcc
`UnicodeDataAcc` PendingUnicodeDataRange
NoRange)
 where
  go ∷ UnicodeDataAcc → Maybe (Entry, UnicodeDataAcc)
  go :: UnicodeDataAcc -> Maybe (Entry, UnicodeDataAcc)
go (UnicodeDataAcc ByteString
raw PendingUnicodeDataRange
pending)
    | ByteString -> Bool
B.null ByteString
raw = Maybe (Entry, UnicodeDataAcc)
forall a. Maybe a
Nothing
    | Bool
otherwise = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
NewLine) ByteString
raw of
        (ByteString -> ByteString
B8.strip → ByteString
line, Int -> ByteString -> ByteString
B.drop Int
1 → ByteString
raw')
          | ByteString -> Bool
B.null ByteString
line → UnicodeDataAcc -> Maybe (Entry, UnicodeDataAcc)
go (ByteString -> PendingUnicodeDataRange -> UnicodeDataAcc
UnicodeDataAcc ByteString
raw' PendingUnicodeDataRange
pending)
          | Bool
otherwise → case PendingUnicodeDataRange -> (Char, Name, CharDetails) -> RawEntry
combine PendingUnicodeDataRange
pending (ByteString -> (Char, Name, CharDetails)
parseDetailedChar ByteString
line) of
              Complete Entry
dc → (Entry, UnicodeDataAcc) -> Maybe (Entry, UnicodeDataAcc)
forall a. a -> Maybe a
Just (Entry
dc, ByteString -> PendingUnicodeDataRange -> UnicodeDataAcc
UnicodeDataAcc ByteString
raw' PendingUnicodeDataRange
NoRange)
              Incomplete PendingUnicodeDataRange
pending' → UnicodeDataAcc -> Maybe (Entry, UnicodeDataAcc)
go (ByteString -> PendingUnicodeDataRange -> UnicodeDataAcc
UnicodeDataAcc ByteString
raw' PendingUnicodeDataRange
pending')

{- | Combine with previous line

A range requires 2 continuous entries with respective names:

* @\<RANGE_IDENTIFIER, First\>@
* @\<RANGE_IDENTIFIER, Last\>@

See: https://www.unicode.org/reports/tr44/#Name
-}
combine ∷ PendingUnicodeDataRange → (Char, Name, CharDetails) → RawEntry
combine :: PendingUnicodeDataRange -> (Char, Name, CharDetails) -> RawEntry
combine = \case
  PendingUnicodeDataRange
NoRange → \(Char
ch, Name ShortByteString
name, CharDetails
dc) → case (Word8 -> Bool)
-> ShortByteString -> (ShortByteString, ShortByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
Comma) ShortByteString
name of
    (ShortByteString
charRange, ShortByteString
suffix) | ShortByteString
suffix ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
", First>" → PendingUnicodeDataRange -> RawEntry
Incomplete (ShortByteString -> Char -> CharDetails -> PendingUnicodeDataRange
FirstCode ShortByteString
charRange Char
ch CharDetails
dc)
    (ShortByteString, ShortByteString)
_ → Entry -> RawEntry
Complete (UnicodeRange ShortByteString -> CharDetails -> Entry
Entry (Char -> UnicodeRange ShortByteString
forall a. Char -> UnicodeRange a
SingleChar Char
ch) CharDetails
dc)
  FirstCode ShortByteString
range1 Char
ch1 CharDetails
dc1 → \(Char
ch2, Name ShortByteString
name, CharDetails
dc2) → case (Word8 -> Bool)
-> ShortByteString -> (ShortByteString, ShortByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
Comma) ShortByteString
name of
    (ShortByteString
range2, ShortByteString
suffix)
      | ShortByteString
suffix ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
", Last>" →
          if ShortByteString
range1 ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ShortByteString
range2 Bool -> Bool -> Bool
&& Char
ch1 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
ch2
            then Entry -> RawEntry
Complete (UnicodeRange ShortByteString -> CharDetails -> Entry
Entry (Char -> Char -> ShortByteString -> UnicodeRange ShortByteString
forall a. Char -> Char -> a -> UnicodeRange a
CharRange Char
ch1 Char
ch2 (Int -> ShortByteString -> ShortByteString
BS.drop Int
1 ShortByteString
range1)) CharDetails
dc1)
            else [Char] -> RawEntry
forall a. HasCallStack => [Char] -> a
error ([Char] -> RawEntry) -> [Char] -> RawEntry
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot create range: incompatible ranges" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> (CharDetails, CharDetails) -> [Char]
forall a. Show a => a -> [Char]
show (CharDetails
dc1, CharDetails
dc2)
    (ShortByteString, ShortByteString)
_ → [Char] -> RawEntry
forall a. HasCallStack => [Char] -> a
error ([Char] -> RawEntry) -> [Char] -> RawEntry
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot create range: missing <range, Last> entry corresponding to: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> [Char]
forall a. Show a => a -> [Char]
show ShortByteString
range1

-- | Parse a single entry of @UnicodeData.txt@
parseDetailedChar ∷ B.ByteString → (Char, Name, CharDetails)
parseDetailedChar :: ByteString -> (Char, Name, CharDetails)
parseDetailedChar ByteString
line =
  ( ByteString -> Char
readCodePoint ByteString
codePoint
  , ShortByteString -> Name
Name (ByteString -> ShortByteString
BS.toShort ByteString
name)
  , CharDetails
      { _generalCategory :: GeneralCategory
_generalCategory = [Char] -> GeneralCategory
forall a. Read a => [Char] -> a
read (ByteString -> [Char]
B8.unpack ByteString
gc)
      , _combiningClass :: Int
_combiningClass = [Char] -> Int
forall a. Read a => [Char] -> a
read (ByteString -> [Char]
B8.unpack ByteString
combining)
      , _decomposition :: Decomposition
_decomposition = Decomposition
decomposition
      , _numericValue :: NumericValue
_numericValue = NumericValue
numericValue
      , _simpleUpperCaseMapping :: Maybe Char
_simpleUpperCaseMapping = ByteString -> Maybe Char
readCodePointM ByteString
sUpper
      , _simpleLowerCaseMapping :: Maybe Char
_simpleLowerCaseMapping = ByteString -> Maybe Char
readCodePointM ByteString
sLower
      , _simpleTitleCaseMapping :: Maybe Char
_simpleTitleCaseMapping = ByteString -> Maybe Char
readCodePointM ByteString
sTitle
      }
  )
 where
  (ByteString
codePoint, ByteString
line1) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) ByteString
line
  (ByteString
name, ByteString
line2) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line1)
  (ByteString
gc, ByteString
line3) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line2)
  (ByteString
combining, ByteString
line4) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line3)
  (ByteString
__bidiClass, ByteString
line5) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line4) -- TODO
  (ByteString
rawDecomposition, ByteString
line6) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line5)
  decomposition :: Decomposition
decomposition = ByteString -> Decomposition
parseDecomposition ByteString
rawDecomposition
  (ByteString
__decimal, ByteString
line7) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line6)
  (ByteString
__digit, ByteString
line8) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line7)
  (ByteString
numeric, ByteString
line9) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line8)
  numericValue :: NumericValue
numericValue = ByteString -> NumericValue
parseNumber ByteString
numeric
  (ByteString
__bidiMirrored, ByteString
line10) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line9) -- TODO
  (ByteString
__uni1Name, ByteString
line11) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line10)
  (ByteString
__iso, ByteString
line12) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line11)
  (ByteString
sUpper, ByteString
line13) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line12)
  (ByteString
sLower, ByteString
line14) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
SemiColon) (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line13)
  sTitle :: ByteString
sTitle = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
line14

-- | See: https://www.unicode.org/reports/tr44/#Decomposition_Type
parseDecomposition ∷ B.ByteString → Decomposition
parseDecomposition :: ByteString -> Decomposition
parseDecomposition (ByteString -> [ByteString]
B8.words → [ByteString]
wrds)
  | [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
wrds = Decomposition
Self
  | Bool
otherwise = [ByteString] -> Decomposition
go [ByteString]
wrds
 where
  go :: [ByteString] -> Decomposition
go = \case
    [] → [Char] -> Decomposition
forall a. HasCallStack => [Char] -> a
error ([Char]
"parseDecomposition: invalid entry: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> [Char]
forall a. Show a => a -> [Char]
show [ByteString]
wrds)
    ys :: [ByteString]
ys@(ByteString
x : [ByteString]
xs) → case ByteString -> DecompositionType
parseDecompositionType ByteString
x of
      DecompositionType
DTCanonical → DecompositionType -> [Char] -> Decomposition
Decomposition DecompositionType
DTCanonical ([ByteString] -> [Char]
readCodePoints [ByteString]
ys)
      DecompositionType
other → DecompositionType -> [Char] -> Decomposition
Decomposition DecompositionType
other ([ByteString] -> [Char]
readCodePoints [ByteString]
xs)

  readCodePoints :: [ByteString] -> [Char]
readCodePoints = (ByteString -> Char) -> [ByteString] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Char
readCodePoint

  parseDecompositionType :: ByteString -> DecompositionType
parseDecompositionType = \case
    ByteString
"<compat>" → DecompositionType
DTCompat
    ByteString
"<circle>" → DecompositionType
DTCircle
    ByteString
"<final>" → DecompositionType
DTFinal
    ByteString
"<font>" → DecompositionType
DTFont
    ByteString
"<fraction>" → DecompositionType
DTFraction
    ByteString
"<initial>" → DecompositionType
DTInitial
    ByteString
"<isolated>" → DecompositionType
DTIsolated
    ByteString
"<medial>" → DecompositionType
DTMedial
    ByteString
"<narrow>" → DecompositionType
DTNarrow
    ByteString
"<noBreak>" → DecompositionType
DTNoBreak
    ByteString
"<small>" → DecompositionType
DTSmall
    ByteString
"<square>" → DecompositionType
DTSquare
    ByteString
"<sub>" → DecompositionType
DTSub
    ByteString
"<super>" → DecompositionType
DTSuper
    ByteString
"<vertical>" → DecompositionType
DTVertical
    ByteString
"<wide>" → DecompositionType
DTWide
    ByteString
_ → DecompositionType
DTCanonical

-- | See: https://www.unicode.org/reports/tr44/#Numeric_Value
parseNumber ∷ B.ByteString → NumericValue
parseNumber :: ByteString -> NumericValue
parseNumber ByteString
raw
  | ByteString -> Bool
B.null ByteString
raw = NumericValue
NotNumeric
  | Word8 -> ByteString -> Bool
B.elem Word8
Slash ByteString
raw = case (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
Slash) ByteString
raw of
      (ByteString
num, ByteString
denum) → Rational -> NumericValue
Rational (ByteString -> Integer
readB ByteString
num Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (ByteString -> Integer
readB (ByteString -> Integer)
-> (ByteString -> ByteString) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
1) ByteString
denum)
       where
        readB :: ByteString -> Integer
readB = [Char] -> Integer
forall a. Read a => [Char] -> a
read ([Char] -> Integer)
-> (ByteString -> [Char]) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B8.unpack
  | Bool
otherwise = Integer -> NumericValue
Integer ([Char] -> Integer
forall a. Read a => [Char] -> a
read (ByteString -> [Char]
B8.unpack ByteString
raw))

--------------------------------------------------------------------------------
-- Doctest
--------------------------------------------------------------------------------

-- TODO: add more examples and move to proper test suite

{- $
>>> parse "0000;<control>;Cc;0;BN;;;;;N;NULL;;;;"
[Entry {_range = SingleChar {_first = '\NUL'}, _details = CharDetails {_generalCategory = Cc, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}]

>>> parse "0041;LATIN CAPITAL LETTER A;Lu;0;L;;;;;N;;;;0061;"
[Entry {_range = SingleChar {_first = 'A'}, _details = CharDetails {_generalCategory = Lu, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Just 'a', _simpleTitleCaseMapping = Nothing}}]

>>> parse "00A8;DIAERESIS;Sk;0;ON;<compat> 0020 0308;;;;N;SPACING DIAERESIS;;;;"
[Entry {_range = SingleChar {_first = '\168'}, _details = CharDetails {_generalCategory = Sk, _combiningClass = 0, _decomposition = Decomposition DTCompat " \776", _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}]

>>> parse "1E8E;LATIN CAPITAL LETTER Y WITH DOT ABOVE;Lu;0;L;0059 0307;;;;N;;;;1E8F;"
[Entry {_range = SingleChar {_first = '\7822'}, _details = CharDetails {_generalCategory = Lu, _combiningClass = 0, _decomposition = Decomposition DTCanonical "Y\775", _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Just '\7823', _simpleTitleCaseMapping = Nothing}}]

>>> parse "320E;PARENTHESIZED HANGUL KIYEOK A;So;0;L;<compat> 0028 1100 1161 0029;;;;N;PARENTHESIZED HANGUL GA;;;;"
[Entry {_range = SingleChar {_first = '\12814'}, _details = CharDetails {_generalCategory = So, _combiningClass = 0, _decomposition = Decomposition DTCompat "(\4352\4449)", _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}]

>>> parse "FDFA;ARABIC LIGATURE SALLALLAHOU ALAYHE WASALLAM;Lo;0;AL;<isolated> 0635 0644 0649 0020 0627 0644 0644 0647 0020 0639 0644 064A 0647 0020 0648 0633 0644 0645;;;;N;ARABIC LETTER SALLALLAHOU ALAYHE WASALLAM;;;;"
[Entry {_range = SingleChar {_first = '\65018'}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Decomposition DTIsolated "\1589\1604\1609 \1575\1604\1604\1607 \1593\1604\1610\1607 \1608\1587\1604\1605", _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}]
-}

{- $
Consecutive single chars

>>> parse "1F34E;RED APPLE;So;0;ON;;;;;N;;;;;\n1F34F;GREEN APPLE;So;0;ON;;;;;N;;;;;"
[Entry {_range = SingleChar {_first = '\127822'}, _details = CharDetails {_generalCategory = So, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}},Entry {_range = SingleChar {_first = '\127823'}, _details = CharDetails {_generalCategory = So, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}]
-}

{- $
Consecutive ranges
>>> :{
parse "30000;<CJK Ideograph Extension G, First>;Lo;0;L;;;;;N;;;;;\n\
      \3134A;<CJK Ideograph Extension G, Last>;Lo;0;L;;;;;N;;;;;\n\
      \31350;<CJK Ideograph Extension H, First>;Lo;0;L;;;;;N;;;;;\n\
      \323AF;<CJK Ideograph Extension H, Last>;Lo;0;L;;;;;N;;;;;"
      ==
      [ Entry {_range = CharRange {_first = '\196608', _last = '\201546', _rangeName = "CJK Ideograph Extension G"}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
      , Entry {_range = CharRange {_first = '\201552', _last = '\205743', _rangeName = "CJK Ideograph Extension H"}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}} ]
:}
True
-}

{- $
Range bewtween single chars

>>> vietnamese_alternate_reading_mark_nhay = Entry {_range = SingleChar {_first = '\94193'}, _details = CharDetails {_generalCategory = Mc, _combiningClass = 6, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
>>> parse "16FF1;VIETNAMESE ALTERNATE READING MARK NHAY;Mc;6;L;;;;;N;;;;;" == [vietnamese_alternate_reading_mark_nhay]
True
>>> tangut_ideograph = Entry {_range = CharRange {_first = '\94208', _last = '\100343', _rangeName = "Tangut Ideograph"}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
>>> parse "17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;;\n187F7;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;;" == [tangut_ideograph]
True
>>> tangut_component_001 = Entry {_range = SingleChar {_first = '\100352'}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
>>> parse "18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;;" == [tangut_component_001]
True
>>> :{
parse "16FF1;VIETNAMESE ALTERNATE READING MARK NHAY;Mc;6;L;;;;;N;;;;;\n\
      \17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;;\n\
      \187F7;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;;\n\
      \18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;;"
      == [vietnamese_alternate_reading_mark_nhay, tangut_ideograph, tangut_component_001]
:}
True
-}

{- $
Multiple consecutive ranges

>>> :{
parse "2FA1D;CJK COMPATIBILITY IDEOGRAPH-2FA1D;Lo;0;L;2A600;;;;N;;;;;\n\
      \30000;<CJK Ideograph Extension G, First>;Lo;0;L;;;;;N;;;;;\n\
      \3134A;<CJK Ideograph Extension G, Last>;Lo;0;L;;;;;N;;;;;\n\
      \31350;<CJK Ideograph Extension H, First>;Lo;0;L;;;;;N;;;;;\n\
      \323AF;<CJK Ideograph Extension H, Last>;Lo;0;L;;;;;N;;;;;\n\
      \E0001;LANGUAGE TAG;Cf;0;BN;;;;;N;;;;;"
      ==
      [ Entry {_range = SingleChar {_first = '\195101'}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Decomposition DTCanonical "\173568", _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
      , Entry {_range = CharRange {_first = '\196608', _last = '\201546', _rangeName = "CJK Ideograph Extension G"}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
      , Entry {_range = CharRange {_first = '\201552', _last = '\205743', _rangeName = "CJK Ideograph Extension H"}, _details = CharDetails {_generalCategory = Lo, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}}
      , Entry {_range = SingleChar {_first = '\917505'}, _details = CharDetails {_generalCategory = Cf, _combiningClass = 0, _decomposition = Self, _numericValue = NotNumeric, _simpleUpperCaseMapping = Nothing, _simpleLowerCaseMapping = Nothing, _simpleTitleCaseMapping = Nothing}} ]
:}
True
-}