diff --git a/.hg_archival.txt b/.hg_archival.txt --- a/.hg_archival.txt +++ b/.hg_archival.txt @@ -1,5 +1,5 @@ repo: a17264ceea088a1ccab9c1c27a4909f450da3259 -node: 3eebe9e1ef6643a5a3fd39c0cd0aea68b389aa17 +node: 5ef3b4bf8c8f525b7136b4ff4953aae8316dde3d branch: default latesttag: 0.0.1 -latesttagdistance: 2 +latesttagdistance: 5 diff --git a/Text/NaturalComp.hs b/Text/NaturalComp.hs --- a/Text/NaturalComp.hs +++ b/Text/NaturalComp.hs @@ -12,9 +12,11 @@ to glibc's strverscmp() function. -} -module Text.NaturalComp (naturalComp, naturalCaseComp) where +module Text.NaturalComp ( naturalComp + , naturalCaseComp + , naturalCompBy ) where -import Data.Char (isDigit, toLower) +import Data.Char (isDigit, toTitle) import Data.Monoid ((<>)) import Data.Ord (comparing) @@ -26,7 +28,12 @@ -- | natural order and case-insensitive string comparison naturalCaseComp :: Stringy s => s -> s -> Ordering -naturalCaseComp = naturalCompFull (comparing toLower) EQ +naturalCaseComp = naturalCompFull (comparing toTitle) EQ + +-- | natural order string comparison, with user-specified function +naturalCompBy :: Stringy s => (Char -> Char -> Ordering) + -> s -> s -> Ordering +naturalCompBy = flip naturalCompFull EQ naturalCompFull :: Stringy s => (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering diff --git a/Text/NaturalComp/Collation.hs b/Text/NaturalComp/Collation.hs new file mode 100644 --- /dev/null +++ b/Text/NaturalComp/Collation.hs @@ -0,0 +1,21 @@ +{- | + Module: Text.NaturalComp.Collation + Copyright: 2013 Hironao Komatsu + License: BSD + Maintainer: Hironao Komatsu + Portability: portable + + Natural order and Unicode-aware string comparison using rfc5051 module. +-} + +module Text.NaturalComp.Collation (naturalCollate) where + +import Data.Function (on) +import Data.RFC5051 +import Text.NaturalComp (naturalCompBy) +import Text.NaturalComp.Stringy (Stringy) + +-- | Natural order and Unicode-aware string collation +naturalCollate :: Stringy s => s -> s -> Ordering +naturalCollate = naturalCompBy (compareUnicode `on` return) + diff --git a/naturalcomp.cabal b/naturalcomp.cabal --- a/naturalcomp.cabal +++ b/naturalcomp.cabal @@ -1,5 +1,5 @@ Name: naturalcomp -Version: 0.0.1 +Version: 0.0.2 Synopsis: Natural-order string comparison Description: Natural order string comparison is needed when e.g. one wants to compare file names or strings of software version. It's @@ -17,20 +17,28 @@ Category: Text Tested-With: GHC == 7.6.3 -Extra-Source-Files: test/nctest.cabal - test/nctest.hs +Extra-Source-Files: tests/colltest.hs + tests/naturalcomp-tests.cabal + tests/nctest.hs flag filepath default: False manual: True +flag unicode-collation + default: False + manual: True + Library exposed-modules: Text.NaturalComp Text.NaturalComp.Stringy - if flag(filepath) - exposed-modules: Text.NaturalComp.FilePath - build-depends: base >= 4 && < 5, text, utf8-string + if flag(filepath) + exposed-modules: Text.NaturalComp.FilePath build-depends: system-filepath >= 0.3 + + if flag(unicode-collation) + exposed-modules: Text.NaturalComp.Collation + build-depends: rfc5051 diff --git a/test/nctest.cabal b/test/nctest.cabal deleted file mode 100644 --- a/test/nctest.cabal +++ /dev/null @@ -1,10 +0,0 @@ -name: nctest -version: 0 -build-type: Simple -cabal-version: >= 1.6 - -executable nctest - main-is: nctest.hs - ghc-options: -Wall - hs-source-dirs: ../,. - build-depends: base >= 4 && < 5, HUnit, text, utf8-string diff --git a/test/nctest.hs b/test/nctest.hs deleted file mode 100644 --- a/test/nctest.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Control.Monad (forM_) -import Data.List (sortBy) -import Data.Monoid ((<>)) -import qualified Data.ByteString.UTF8 as U -import qualified Data.Text as T -import Test.HUnit -import Text.NaturalComp -import Text.NaturalComp.Stringy - -testData1 :: [(U.ByteString, U.ByteString, Ordering)] -testData1 = - [("AAA", "AAA", EQ) - ,("AAA", "AAa", LT) - ,("aaa", "AAA", GT) - ,("aaa", "aaaa", LT) - ,("aaaa", "aab", LT) - ,("aaa1", "aaa2", LT) - ,("aaa9", "aaa10", LT) - ,("aaa9a", "aaa10a", LT) - ,("aaa01", "aaa1", LT) - ,("aaa10", "aaa10", EQ) - ,("aaa10", "aaa10a", LT) - ,("aaa10", "aaa20", LT) - ,("aaa99", "aaa100", LT) - ,("aaa100", "aaa101", LT) - ,("aaa999", "aaa1000", LT) - ,("aaa99a", "aaa99a", EQ) - ,("aaa99a1", "aaa99a2", LT) - ,("aaa99a", "aaa99b", LT) - ,("aaa99aa", "aaa99b", LT) - ,("aaa99a9", "aaa99a10", LT)] - -testData2 :: [(T.Text, T.Text, Ordering)] -testData2 = - [("AAA", "AAA", EQ) - ,("AAA", "AAa", EQ) - ,("aaa", "AAA", EQ) - ,("aaa", "aaaa", LT) - ,("aaaa", "aab", LT) - ,("aaa1", "aaa2", LT) - ,("aaa9", "aaa10", LT) - ,("aaa9a", "aaa10a", LT) - ,("aaa01", "aaa1", LT) - ,("aaa10", "aaa10", EQ) - ,("aaa10", "aaa10a", LT) - ,("aaa10", "aaa20", LT) - ,("aaa99", "aaa100", LT) - ,("aaa100", "aaa101", LT) - ,("aaa999", "aaa1000", LT) - ,("aaa99a", "aaa99a", EQ) - ,("aaa99a", "aaa99b", LT) - ,("aaa99aa", "aaa99b", LT) - ,("aaa99a9", "aaa99a10", LT)] - -testData3 :: ([String], [String]) -testData3 = - (["28627986_p3.jpg" - ,"28627986_p0.jpg" - ,"28627986_p8.jpg" - ,"28627986_p20.jpg" - ,"28627986_p4.jpg" - ,"28627986_p12.jpg" - ,"28627986_p5.jpg" - ,"28627986_p10.jpg" - ,"28627986_p6.jpg" - ,"28627986_p7.jpg" - ,"28627986_p11.jpg" - ,"28627986_p1.jpg" - ,"28627986_p9.jpg" - ,"28627986_p2.jpg"] - - ,["28627986_p0.jpg" - ,"28627986_p1.jpg" - ,"28627986_p2.jpg" - ,"28627986_p3.jpg" - ,"28627986_p4.jpg" - ,"28627986_p5.jpg" - ,"28627986_p6.jpg" - ,"28627986_p7.jpg" - ,"28627986_p8.jpg" - ,"28627986_p9.jpg" - ,"28627986_p10.jpg" - ,"28627986_p11.jpg" - ,"28627986_p12.jpg" - ,"28627986_p20.jpg"]) - -testData4 :: ([T.Text], [T.Text]) -testData4 = - (["test1.999.c" - ,"test1.99.c" - ,"test1.11111.c" - ,"test1.0001.c" - ,"test1.2000.c" - ,"test1.0009.c"] - - ,["test1.0001.c" - ,"test1.0009.c" - ,"test1.99.c" - ,"test1.999.c" - ,"test1.2000.c" - ,"test1.11111.c"]) - -testData5 :: ([U.ByteString], [U.ByteString]) -testData5 = -- from strverscmp(3) man page - (["10" - ,"9" - ,"1" - ,"0" - ,"09" - ,"010" - ,"01" - ,"00" - ,"000"] - - ,["000" - ,"00" - ,"01" - ,"010" - ,"09" - ,"0" - ,"1" - ,"9" - ,"10"]) - -testData6 :: [(String, String, Ordering)] -testData6 = - [("000", "00", LT) - ,("00", "01", LT) - ,("01", "010", LT) - ,("010", "09", LT) - ,("09", "0", LT) - ,("0", "1", LT) - ,("1", "9", LT) - ,("9", "10", LT) - - ,("000a", "00a", LT) - ,("00a", "01a", LT) - ,("01a", "010a", GT) -- Why? But glibc says GT. - ,("010a", "09a", LT) - ,("09a", "0a", LT) - ,("0a", "1a", LT) - ,("1a", "9a", LT) - ,("9a", "10a", LT)] - -compTest f xyz = - TestCase $ forM_ xyz - $ \(x, y, z) -> - assertEqual (toString $ x <> " : " <> y) z (f x y) - -sortTest f (x, y) = - let sorted = sortBy f x - in TestCase $ assertEqual "" y sorted - -tests = - TestList [TestLabel "test1" $ compTest naturalComp testData1 - ,TestLabel "test2" $ compTest naturalCaseComp testData2 - ,TestLabel "test3" $ sortTest naturalComp testData3 - ,TestLabel "test4" $ sortTest naturalComp testData4 - ,TestLabel "test5" $ sortTest naturalComp testData5 - ,TestLabel "test6" $ compTest naturalComp testData6] - -main = runTestTT tests - diff --git a/tests/colltest.hs b/tests/colltest.hs new file mode 100644 --- /dev/null +++ b/tests/colltest.hs @@ -0,0 +1,16 @@ +-- -*- coding: utf-8 -*- + +import Data.List (sortBy) +import Test.HUnit +import Text.NaturalComp.Collation + +-- from rfc5051 docs +a = "Abe Oeb abe abé oeb Ábe Äbe Ôeb ábe äbe ôeb" +b = "Abe abe abé Ábe ábe Äbe äbe Oeb oeb Ôeb ôeb" + +sortTest x y = assertEqual "" y $ unwords $ sortBy naturalCollate $ words x + +tests = TestList [ TestLabel "test1" $ TestCase $ sortTest a b ] + +main = runTestTT tests + diff --git a/tests/naturalcomp-tests.cabal b/tests/naturalcomp-tests.cabal new file mode 100644 --- /dev/null +++ b/tests/naturalcomp-tests.cabal @@ -0,0 +1,16 @@ +name: naturalcomp-tests +version: 0 +build-type: Simple +cabal-version: >= 1.6 + +executable nctest + main-is: nctest.hs + ghc-options: -Wall + hs-source-dirs: ../,. + build-depends: base >= 4 && < 5, HUnit, text, utf8-string + +executable colltest + main-is: colltest.hs + ghc-options: -Wall + hs-source-dirs: ../,. + build-depends: base >= 4 && < 5, HUnit, rfc5051 diff --git a/tests/nctest.hs b/tests/nctest.hs new file mode 100644 --- /dev/null +++ b/tests/nctest.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Monad (forM_) +import Data.List (sortBy) +import Data.Monoid ((<>)) +import qualified Data.ByteString.UTF8 as U +import qualified Data.Text as T +import Test.HUnit +import Text.NaturalComp +import Text.NaturalComp.Stringy + +testData1 :: [(U.ByteString, U.ByteString, Ordering)] +testData1 = + [("AAA", "AAA", EQ) + ,("AAA", "AAa", LT) + ,("aaa", "AAA", GT) + ,("aaa", "aaaa", LT) + ,("aaaa", "aab", LT) + ,("aaa1", "aaa2", LT) + ,("aaa9", "aaa10", LT) + ,("aaa9a", "aaa10a", LT) + ,("aaa01", "aaa1", LT) + ,("aaa10", "aaa10", EQ) + ,("aaa10", "aaa10a", LT) + ,("aaa10", "aaa20", LT) + ,("aaa99", "aaa100", LT) + ,("aaa100", "aaa101", LT) + ,("aaa999", "aaa1000", LT) + ,("aaa99a", "aaa99a", EQ) + ,("aaa99a1", "aaa99a2", LT) + ,("aaa99a", "aaa99b", LT) + ,("aaa99aa", "aaa99b", LT) + ,("aaa99a9", "aaa99a10", LT)] + +testData2 :: [(T.Text, T.Text, Ordering)] +testData2 = + [("AAA", "AAA", EQ) + ,("AAA", "AAa", EQ) + ,("aaa", "AAA", EQ) + ,("aaa", "aaaa", LT) + ,("aaaa", "aab", LT) + ,("aaa1", "aaa2", LT) + ,("aaa9", "aaa10", LT) + ,("aaa9a", "aaa10a", LT) + ,("aaa01", "aaa1", LT) + ,("aaa10", "aaa10", EQ) + ,("aaa10", "aaa10a", LT) + ,("aaa10", "aaa20", LT) + ,("aaa99", "aaa100", LT) + ,("aaa100", "aaa101", LT) + ,("aaa999", "aaa1000", LT) + ,("aaa99a", "aaa99a", EQ) + ,("aaa99a", "aaa99b", LT) + ,("aaa99aa", "aaa99b", LT) + ,("aaa99a9", "aaa99a10", LT)] + +testData3 :: ([String], [String]) +testData3 = + (["28627986_p3.jpg" + ,"28627986_p0.jpg" + ,"28627986_p8.jpg" + ,"28627986_p20.jpg" + ,"28627986_p4.jpg" + ,"28627986_p12.jpg" + ,"28627986_p5.jpg" + ,"28627986_p10.jpg" + ,"28627986_p6.jpg" + ,"28627986_p7.jpg" + ,"28627986_p11.jpg" + ,"28627986_p1.jpg" + ,"28627986_p9.jpg" + ,"28627986_p2.jpg"] + + ,["28627986_p0.jpg" + ,"28627986_p1.jpg" + ,"28627986_p2.jpg" + ,"28627986_p3.jpg" + ,"28627986_p4.jpg" + ,"28627986_p5.jpg" + ,"28627986_p6.jpg" + ,"28627986_p7.jpg" + ,"28627986_p8.jpg" + ,"28627986_p9.jpg" + ,"28627986_p10.jpg" + ,"28627986_p11.jpg" + ,"28627986_p12.jpg" + ,"28627986_p20.jpg"]) + +testData4 :: ([T.Text], [T.Text]) +testData4 = + (["test1.999.c" + ,"test1.99.c" + ,"test1.11111.c" + ,"test1.0001.c" + ,"test1.2000.c" + ,"test1.0009.c"] + + ,["test1.0001.c" + ,"test1.0009.c" + ,"test1.99.c" + ,"test1.999.c" + ,"test1.2000.c" + ,"test1.11111.c"]) + +testData5 :: ([U.ByteString], [U.ByteString]) +testData5 = -- from strverscmp(3) man page + (["10" + ,"9" + ,"1" + ,"0" + ,"09" + ,"010" + ,"01" + ,"00" + ,"000"] + + ,["000" + ,"00" + ,"01" + ,"010" + ,"09" + ,"0" + ,"1" + ,"9" + ,"10"]) + +testData6 :: [(String, String, Ordering)] +testData6 = + [("000", "00", LT) + ,("00", "01", LT) + ,("01", "010", LT) + ,("010", "09", LT) + ,("09", "0", LT) + ,("0", "1", LT) + ,("1", "9", LT) + ,("9", "10", LT) + + ,("000a", "00a", LT) + ,("00a", "01a", LT) + ,("01a", "010a", GT) -- Why? But glibc says GT. + ,("010a", "09a", LT) + ,("09a", "0a", LT) + ,("0a", "1a", LT) + ,("1a", "9a", LT) + ,("9a", "10a", LT)] + +compTest f xyz = + TestCase $ forM_ xyz + $ \(x, y, z) -> + assertEqual (toString $ x <> " : " <> y) z (f x y) + +sortTest f (x, y) = + let sorted = sortBy f x + in TestCase $ assertEqual "" y sorted + +tests = + TestList [TestLabel "test1" $ compTest naturalComp testData1 + ,TestLabel "test2" $ compTest naturalCaseComp testData2 + ,TestLabel "test3" $ sortTest naturalComp testData3 + ,TestLabel "test4" $ sortTest naturalComp testData4 + ,TestLabel "test5" $ sortTest naturalComp testData5 + ,TestLabel "test6" $ compTest naturalComp testData6] + +main = runTestTT tests +