unicode-collation 0.1 → 0.1.1
raw patch · 9 files changed
+96/−31 lines, 9 files
Files
- CHANGELOG.md +12/−0
- app/Main.hs +9/−3
- benchmark/Main.hs +13/−4
- src/Text/Collate.hs +2/−1
- src/Text/Collate/Collator.hs +17/−3
- src/Text/Collate/Lang.hs +24/−18
- stack.yaml +3/−0
- test/unit.hs +14/−0
- unicode-collation.cabal +2/−2
CHANGELOG.md view
@@ -2,6 +2,18 @@ `unicode-collation` uses [PVP Versioning](https://pvp.haskell.org). +## 0.1.1++* Fix fallback behavior with `lookupLang` (#3). Previously `lookupLang`+ would let `de` fall back to `de-u-co-phonebk`.++* Add `collatorLang`, which reports the `Lang` used for+ tailoring (which may be different from the `Lang` passed to+ `collatorFor`, because of fallbacks).++* Add `--verbose` option to executable. This prints the fallback+ Lang used for tailoring to stderr to help diagnose issues.+ ## 0.1 * Initial release.
app/Main.hs view
@@ -22,8 +22,9 @@ when (any isHelp args) $ do putStrLn "Usage: unicode-collate [COLLATION]" putStrLn "Options:"- putStrLn " --help Print usage information"- putStrLn " --list List supported collations"+ putStrLn " --help Print usage information"+ putStrLn " --list List supported collations"+ putStrLn " --verbose Diagnostic information to stderr" putStrLn "" putStrLn "Sorts lines from stdin using the specified collation." putStrLn "COLLATION is a BCP47 language code. Examples:"@@ -39,9 +40,14 @@ mapM_ (T.putStrLn . renderLang . fst) tailorings exitSuccess - spec <- maybe "root" T.pack . listToMaybe <$> getArgs+ let isOpt ('-':_) = True+ isOpt _ = False+ spec <- maybe "root" T.pack . listToMaybe . filter (not . isOpt) <$> getArgs lang <- either handleError return $ parseLang spec let myCollator = collatorFor lang+ when ("--verbose" `elem` args) $+ hPutStrLn stderr $ "Tailoring: " <>+ maybe "ROOT" (T.unpack . renderLang) (collatorLang myCollator) T.getContents >>= mapM_ T.putStrLn . sortBy (collate myCollator) . T.lines handleError :: String -> IO a
benchmark/Main.hs view
@@ -6,6 +6,7 @@ import Test.QuickCheck import Data.Text (Text) import qualified Data.Text.ICU as ICU+import Data.Text.ICU.Collate (Attribute(..), Strength(..)) import Text.Collate import Test.QuickCheck.Instances.Text () import Data.List (sortBy)@@ -15,10 +16,18 @@ main = do (randomTexts :: [Text]) <- generate (infiniteListOf arbitrary) let tenThousand = take 10000 randomTexts+ let icuCollator lang = ICU.collatorWith (ICU.Locale lang)+ [NormalizationMode True, Strength Quaternary] defaultMain- [ bench "sort a list of 10000 random Texts"- (whnf (sortBy (collate rootCollator)) tenThousand)- , bench "sort same list with text-icu"- (whnf (sortBy (ICU.collate (ICU.collator ICU.Root))) tenThousand)+ [ bench "sort a list of 10000 random Texts (en)"+ (whnf (sortBy (collate (collatorFor "en"))) tenThousand)+ , bench "sort same list with text-icu (en)"+ (whnf (sortBy (ICU.collate (icuCollator "en"))) tenThousand)+ , bench "sort a list of 10000 random Texts (zh)"+ (whnf (sortBy (collate (collatorFor "zh"))) tenThousand)+ , bench "sort same list with text-icu (zh)"+ (whnf (sortBy (ICU.collate (icuCollator "zh"))) tenThousand)+ , bench "sort a list of 10000 random Texts (en-u-kk-false = no normalize)"+ (whnf (sortBy (collate (collatorFor "en-u-kk-false"))) tenThousand) ]
src/Text/Collate.hs view
@@ -44,7 +44,7 @@ >>> collate se "ö" "z" GT >>> sortKey de "ö"-SortKey [0x213C,0x2007,0x0000,0x0021,0x0021,0x0000,0x0002,0x0002,0x0000,0xFFFF,0xFFFF]+SortKey [0x213C,0x0000,0x0020,0x002B,0x0000,0x0002,0x0002,0x0000,0xFFFF,0xFFFF] >>> sortKey se "ö" SortKey [0x22FD,0x0000,0x0020,0x0000,0x0002,0x0000,0xFFFF] @@ -134,6 +134,7 @@ , SortKey(..) , sortKey , VariableWeighting(..)+ , collatorLang , setVariableWeighting , setNormalization , setFrenchAccents
src/Text/Collate/Collator.hs view
@@ -6,6 +6,7 @@ , SortKey(..) , VariableWeighting(..) , rootCollator+ , collatorLang , setVariableWeighting , setFrenchAccents , setUpperBeforeLower@@ -38,7 +39,8 @@ data CollatorOptions = CollatorOptions- { optVariableWeighting :: VariableWeighting -- ^ Method for handling+ { optLang :: Maybe Lang -- ^ Which lang was used for tailoring+ , optVariableWeighting :: VariableWeighting -- ^ Method for handling -- variable elements (see <http://www.unicode.org/reports/tr10/>, -- Tables 11 and 12). , optFrenchAccents :: Bool -- ^ If True, secondary weights are scanned@@ -82,6 +84,14 @@ rootCollator = mkCollator defaultCollatorOptions{ optCollation = ducetCollation } +-- | Report 'Lang' used for tailoring in a collator.+-- Note that because of fallbac rules, this may be somewhat+-- different from the 'Lang' passed to 'collatorFor'. This 'Lang'+-- won't contain unicode extensions used to set options, but+-- it will contain the collation if a non-default collation is being used.+collatorLang :: Collator -> Maybe Lang+collatorLang = optLang . collatorOptions+ -- | Set method for handling variable elements (punctuation -- and spaces): see <http://www.unicode.org/reports/tr10/>, -- Tables 11 and 12.@@ -133,7 +143,8 @@ defaultCollatorOptions :: CollatorOptions defaultCollatorOptions = CollatorOptions- { optVariableWeighting = NonIgnorable+ { optLang = Nothing+ , optVariableWeighting = NonIgnorable , optFrenchAccents = False , optUpperBeforeLower = False , optNormalize = True@@ -160,6 +171,7 @@ collatorFor lang = mkCollator opts where opts = defaultCollatorOptions{+ optLang = langUsed, optFrenchAccents = case lookup "u" exts >>= lookup "kb" of Just "" -> True@@ -191,7 +203,9 @@ Just "false" -> False _ -> True, optCollation = ducetCollation <> tailoring }- tailoring = maybe mempty snd $ lookupLang lang tailorings+ (langUsed, tailoring) = case lookupLang lang tailorings of+ Nothing -> (Nothing, mempty)+ Just (l,t) -> (Just l, t) exts = langExtensions lang -- | Returns a collator constructed using the collation and
src/Text/Collate/Lang.hs view
@@ -10,7 +10,7 @@ , lookupLang ) where-import Data.Maybe (listToMaybe)+import Data.Maybe (listToMaybe, mapMaybe) import Control.Monad (mzero) import Data.Ord (Down(..)) import Data.List (sortOn)@@ -47,26 +47,32 @@ return $ Lang a b c d e f -- | Find best match for a 'Lang' in an association list.--- We require a match in 'langLanguage'; after that,--- we look for matches in the following priority order:--- 'langScript', 'langRegion', 'langVariants',--- 'langExtensions' (under @"u"@),--- collation ('langExtensions' under @"u-co"@). lookupLang :: Lang -> [(Lang, a)] -> Maybe (Lang, a) lookupLang lang =- listToMaybe- . sortOn (Down . scoreMatch)- . filter (\(l,_) -> langLanguage l == langLanguage lang)+ fmap snd+ . listToMaybe+ . sortOn (Down . fst)+ . (mapMaybe (\(l,t) ->+ case match l of+ Nothing -> Nothing+ Just x -> Just (x,(l,t)))) where- scoreMatch :: (Lang, a) -> Int- scoreMatch (l,_) =- (if langScript l == langScript lang then 20 else 0) +- (if langRegion l == langRegion lang then 10 else 0) +- (if langVariants l == langVariants lang then 5 else 0) +- (if lookup "u" (langExtensions l) ==- lookup "u" (langExtensions lang) then 2 else 0) +- (if (lookup "u" (langExtensions l) >>= lookup "co") ==- (lookup "u" (langExtensions lang) >>= lookup "co") then 1 else 0)+ langsMatch l = if langLanguage lang == langLanguage l+ then Just True+ else Nothing+ maybeMatch f l = case (f l, f lang) of+ (Nothing, Nothing) -> Just True+ (Nothing, Just _) -> Just False+ (Just x, mby) -> case mby of+ Just y | x == y -> Just True+ _ -> Nothing+ langCollation l = lookup "u" (langExtensions l) >>= lookup "co"+ match l = do+ lm <- langsMatch l+ sm <- maybeMatch langScript l+ rm <- maybeMatch langRegion l+ cm <- maybeMatch langCollation l+ return (lm,sm,rm,cm) -- | Render a 'Lang' in BCP 47 form. renderLang :: Lang -> Text
stack.yaml view
@@ -1,4 +1,7 @@ resolver: lts-17.5+flags:+ unicode-collation:+ executable: true extra-deps: - git: https://github.com/WorldSEnder/text-icu commit: 7657227a7ca8ad13be86db5c190b806774a5fd6b
test/unit.hs view
@@ -97,6 +97,20 @@ (map langParseTest langPairs) , testGroup "BCP 47 Lang round-trip" (map langRoundTripTest langPairs)+ , testGroup "collatorLang and fallback behavior"+ [ testCase "de => ROOT" $+ collatorLang "de" @?= Nothing+ , testCase "de-AT => ROOT" $+ collatorLang "dt-AT" @?= Nothing+ , testCase "es-u-co-trad" $+ collatorLang "es-ES" @?= Just (Lang "es" Nothing Nothing [] [] [])+ , testCase "de-DE-u-co-phonebk" $+ collatorLang "de-DE-u-co-phonebk" @?=+ Just (Lang "de" Nothing Nothing [] [("u",[("co","phonebk")])] [])+ , testCase "es-u-co-nonexist-kb" $+ collatorLang "es-u-co-nonexist-kb" @?=+ Just (Lang "es" Nothing Nothing [] [] [])+ ] ] emptyLang :: Lang
unicode-collation.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: unicode-collation-version: 0.1-synopsis: Haskell implementation of the Unicode Collation Algorithm.+version: 0.1.1+synopsis: Haskell implementation of the Unicode Collation Algorithm description: This library provides a pure Haskell implementation of the Unicode Collation Algorithm described at <http://www.unicode.org/reports/tr10/>. It is not