text-icu-normalized 0.1.6 → 0.4.1
raw patch · 5 files changed
Files
- NormalizationTest.txt too large to diff
- Source/Library/Data/Text/ICU/Normalized/NFC.hs +51/−57
- Tests/Main.hs +11/−0
- Tests/TestNormalization.hs +35/−0
- text-icu-normalized.cabal +75/−17
+ NormalizationTest.txt view
file too large to diff
Source/Library/Data/Text/ICU/Normalized/NFC.hs view
@@ -2,7 +2,7 @@ {-| Module : Data.Text.ICU.Normalized.NFC-Description: : Convert all Text to Unicode NFC normalized Strict Text.+Description: : NFC Text implementing the 'IsString' typeclass. Copyright : ©2016 License : GPL-3 Maintainer : Evan Cofsky <evan@theunixman.com>@@ -19,72 +19,33 @@ module Data.Text.ICU.Normalized.NFC ( NFCText,- strict,- lazy,- lower,- upper,- utf8,- utf8ByteString+ packed,+ builder,+ text,+ normalized ) where -import qualified Data.Text.ICU as ICU+import qualified Data.Text.ICU.Normalize as ICU import Data.Text (Text)-import qualified Data.Text.Lazy as LT import GHC.Generics (Generic)-import Data.Text.Encoding (encodeUtf8, decodeUtf8)-import qualified Data.ByteString.Char8 as C8-import Data.String (IsString(..))-import Text.ParserCombinators.ReadP-import Text.Read hiding (get) import Prelude.Unicode import Data.Data-import Data.Typeable import Control.Lens hiding (strict, lazy)-import Data.ByteString (ByteString)+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import qualified Data.Text.Strict.Lens as DL+import Data.Text.Lens (IsText(..))+import Control.Applicative -- | An NFC-normalized Data.Text-newtype NFCText = NFCText Text deriving (Show, Generic, Data, Typeable)-makePrisms ''NFCText---- | Prism between 'NFCText' and strict 'Text'-strict ∷ Prism' NFCText Text-strict = prism' (NFCText . ICU.normalize ICU.NFC) (preview _NFCText)---- | Prism between 'NFCText' and lazy 'LT.Text'-lazy ∷ Prism' NFCText LT.Text-lazy = prism' (review strict ∘ LT.toStrict) (\t → LT.fromStrict <$> preview _NFCText t)---- | Prism between 'NFCText' and a utf-8 encoded 'ByteString-utf8ByteString ∷ Prism' NFCText ByteString-utf8ByteString = prism' (NFCText ∘ decodeUtf8) (Just ∘ encodeUtf8 ∘ view _NFCText)---- | Prism between 'NFCText' and a utf-8 encoded 'String'-utf8 :: Prism' NFCText String-utf8 = prism' (fromString) (Just ∘ C8.unpack ∘ view utf8ByteString)---- | Convert 'NFCText' to lower case.-lower :: Getter NFCText NFCText-lower = to (NFCText ∘ ICU.toLower nfcLocale ∘ view _NFCText)---- | Convert 'NFCText' to upper case.-upper :: Getter NFCText NFCText-upper = to (NFCText ∘ ICU.toUpper nfcLocale ∘ view _NFCText)--instance IsString NFCText where- fromString = NFCText . decodeUtf8 . C8.pack--nfcParser ∷ ReadP NFCText-nfcParser =- NFCText . fromString <$> many get--instance Read NFCText where- readPrec = lift nfcParser+newtype NFCText = NFCText {unNFC ∷ Text} deriving (Show, Generic, Data, Typeable) --- | Convert to FCD form, then compare the texts.+-- | Since we're NFC, we satisfy FCD, and we can just compare+-- directly. instance Ord NFCText where (NFCText a) `compare` (NFCText b) = let- cmp = ICU.collate ICU.uca+ cmp = ICU.compare [ICU.InputIsFCD] in a `cmp` b @@ -92,6 +53,39 @@ instance Eq NFCText where a == b = a `compare` b == EQ --- | For now this is where we are.-nfcLocale :: ICU.LocaleName-nfcLocale = ICU.Locale "en_US.UTF8"+-- | 'Iso' between an 'IsText' and an 'NFCText'.+normalized ∷ (IsText t) ⇒ Iso' NFCText t+normalized = iso (review builder ∘ view builder ∘ unNFC) nnfc++instance IsText NFCText where+ -- | 'Iso' for packing and unpacking 'NFCText' from 'String'.+ packed = iso (nnfc ∘ view DL.packed) (review DL.packed ∘ unNFC)++ -- | 'Iso' between a 'Builder' and an 'NFCText'+ builder = iso (view DL.builder ∘ unNFC) (nnfc ∘ review DL.builder)++-- | Normalizes an 'IsText' to 'NFCText'+--+-- 1. Do a 'quickCheck'. If this returns definitively, we normalize+-- based on its response.+-- 2. If not, we call 'isNormalized', and normalize based on its+-- response.+nnfc ∷ (IsText t) ⇒ t → NFCText+nnfc txt =+ let+ nt = ICU.normalize ICU.NFC++ -- Make sure we start with a strict 'Text'.+ t = toStrict $ toLazyText $ txt ^. builder++ -- | If 'qc' fails to provide an answer we use 'isNormalized'.+ isn = Just $ if ICU.isNormalized ICU.NFC t then t else nt t++ -- | If we get a definitive answer from qc, act on it.+ quick = ICU.quickCheck ICU.NFC t >>=+ \q → if q then return t+ else return $ nt t++ norm = (quick <|> isn) ^?! _Just+ in+ NFCText norm
+ Tests/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Test.Framework (defaultMain)++import qualified TestNormalization as N++main :: IO ()+main = do+ nts ← N.normalizationTests++ defaultMain nts
+ Tests/TestNormalization.hs view
@@ -0,0 +1,35 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-|+Module: TestUTF8+Description: Test normalizing various cases of non-normalized UTF8.+Copyright: © 2016 All rights reserved.+License: GPL-3+Maintainer: Evan Cofsky <evan@theunixman.com>+Stability: experimental+Portability: POSIX+-}++module TestNormalization where++import Test.Framework (Test)+import Test.HUnit hiding (Test)+import Control.Lens hiding (strict)+import ParseNormalizationTest+import Data.Text.ICU.Normalized.NFC+import Data.Text.Lens (unpacked)+import qualified Data.Text as T+import Test.Framework.Providers.HUnit++normalizationTests ∷ IO [Test]+normalizationTests = do+ (Right tcs) ← loadTestCodePoints+ return+ $ concatMapOf traversed (\p → over traversed (testNormalization p) (p ^. pTestCodePoints)) tcs+++testNormalization ∷ Part → TestCodePoint → Test+testNormalization p tcp =+ testCase ((T.unwords [(p ^. pPartComment),+ (tcp ^. tcComment)]) ^. unpacked)+ ((tcp ^. tcNFC) @?= (tcp ^. tcSource ^.re normalized ^. normalized))
text-icu-normalized.cabal view
@@ -1,11 +1,8 @@--- Initial text-icu-normalized.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: text-icu-normalized-version: 0.1.6+version: 0.4.1 synopsis: Dealing with Strict Text in NFC normalization. description: Handle Text in NFC normalization.-homepage: https://gitlab.com/theunixman/text-icu-normalized+homepage: https://www.lambdanow.us/browser/text-icu-normalized license: GPL-3 license-file: LICENSE author: Evan Cofsky@@ -13,27 +10,88 @@ copyright: ©2016 Evan Cofsky category: Data, Text build-type: Simple--- extra-source-files:-cabal-version: >=1.10+cabal-version: >=1.24+data-files: NormalizationTest.txt +source-repository head+ type: git+ location: git@gitlab.com:theunixman/text-icu-normalized.git++source-repository this+ type: git+ location: git@gitlab.com:theunixman/text-icu-normalized.git+ tag: v0.4.1+ library+ ghc-options: -Wall -Wno-redundant-constraints -Wno-type-defaults -O2 exposed-modules: Data.Text.ICU.Normalized.NFC- -- other-modules: default-extensions: DeriveDataTypeable DeriveGeneric UnicodeSyntax build-depends:- base >=4.8 && <5.0,- base-unicode-symbols,- bytestring,- lens,- text,- text-icu+ base >=4.9 && <5.0,+ base-unicode-symbols >= 0.2.2 && < 0.3,+ bytestring >= 0.10.8 && < 0.11,+ lens >= 4.14 && < 4.16,+ text >= 1.2.2 && < 1.3,+ text-icu >= 0.7.0 && < 0.8 hs-source-dirs: Source/Library default-language: Haskell2010 -source-repository head- type: git- location: git@gitlab.com:theunixman/text-icu-normalized.git+test-suite test-normalizations+ ghc-options:+ -Wall+ -Wno-redundant-constraints+ -Wno-type-defaults+ -threaded+ -feager-blackholing+ -rtsopts+ -dynamic+ -with-rtsopts=-N+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: Tests+ main-is: Main.hs+ other-modules:+ Paths_text_icu_normalized+ TestNormalization+ build-depends:+ base >=4.9 && <5.0,+ HUnit,+ QuickCheck,+ base-unicode-symbols >= 0.2.2 && < 0.3,+ bytestring >= 0.10.8 && < 0.11,+ containers >= 0.5.7.1 && < 0.6,+ exceptions >= 0.8.3 && < 0.9,+ filepath >= 1.4.0.0 && < 1.5,+ lens >= 4.14 && < 4.16,+ parsec,+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2,+ test-framework-th,+ text >= 1.2.2 && < 1.3,+ text-icu >= 0.7.0 && < 0.8,+ text-icu-normalized+ default-extensions:+ UnicodeSyntax+ LambdaCase+ ConstraintKinds+ DefaultSignatures+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ DeriveGeneric+ DeriveDataTypeable+ GeneralizedNewtypeDeriving+ KindSignatures+ MultiParamTypeClasses+ OverloadedStrings+ PartialTypeSignatures+ RankNTypes+ ScopedTypeVariables+ TypeFamilies+ TypeSynonymInstances