naturalcomp (empty) → 0.0.1
raw patch · 11 files changed
+433/−0 lines, 11 filesdep +basedep +system-filepathdep +textsetup-changed
Dependencies added: base, system-filepath, text, utf8-string
Files
- .hg_archival.txt +5/−0
- .hgignore +12/−0
- .hgtags +1/−0
- COPYING +25/−0
- Setup.hs +3/−0
- Text/NaturalComp.hs +88/−0
- Text/NaturalComp/FilePath.hs +43/−0
- Text/NaturalComp/Stringy.hs +45/−0
- naturalcomp.cabal +36/−0
- test/nctest.cabal +10/−0
- test/nctest.hs +165/−0
+ .hg_archival.txt view
@@ -0,0 +1,5 @@+repo: a17264ceea088a1ccab9c1c27a4909f450da3259+node: 3eebe9e1ef6643a5a3fd39c0cd0aea68b389aa17+branch: default+latesttag: 0.0.1+latesttagdistance: 2
+ .hgignore view
@@ -0,0 +1,12 @@+syntax: glob+\#*\#+.\#*+*~+*.bak+*.log+*.orig+*.rej+core+core.*+dist/*+test/dist/*
+ .hgtags view
@@ -0,0 +1,1 @@+08cb2ffc3241d02f0327ee7503ba37094212687e 0.0.1
+ COPYING view
@@ -0,0 +1,25 @@+Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, +INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ Text/NaturalComp.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE ViewPatterns #-}++{- |+ Module: Text.NaturalComp+ Copyright: 2013 Hironao Komatsu+ License: BSD+ Maintainer: Hironao Komatsu <hirkmt@gmail.com>+ Portability: portable++ Natural order string comparison is needed when e.g. one wants to compare+ file names or strings of software version. It's aimed to be compatible+ to glibc's strverscmp() function.+-}++module Text.NaturalComp (naturalComp, naturalCaseComp) where++import Data.Char (isDigit, toLower)+import Data.Monoid ((<>))+import Data.Ord (comparing)++import Text.NaturalComp.Stringy++-- | natural order string comparison, compatible to glibc's strverscmp()+naturalComp :: Stringy s => s -> s -> Ordering+naturalComp = naturalCompFull compare EQ++-- | natural order and case-insensitive string comparison+naturalCaseComp :: Stringy s => s -> s -> Ordering+naturalCaseComp = naturalCompFull (comparing toLower) EQ++naturalCompFull :: Stringy s => (Char -> Char -> Ordering) -> Ordering+ -> s -> s -> Ordering+naturalCompFull _ o (uncons -> Nothing) (uncons -> Nothing) = o+naturalCompFull _ EQ (uncons -> Nothing) _ = LT+naturalCompFull _ EQ _ (uncons -> Nothing) = GT+naturalCompFull f EQ+ xl@(uncons -> Just ('0', xs))+ yl@(uncons -> Just ('0', ys)) =+ naturalCompFull0 f EQ xs ys+naturalCompFull f EQ xl@(uncons -> Just ('0', _)) yl =+ naturalCompFull1 f EQ xl yl+naturalCompFull f EQ xl yl@(uncons -> Just ('0', _)) =+ naturalCompFull1 f EQ xl yl+naturalCompFull f EQ+ xl@(uncons -> Just (x, xs))+ yl@(uncons -> Just (y, ys))+ | isDigit x && isDigit y = naturalCompFullN f EQ xl yl+ | otherwise = naturalCompFull f (f x y) xs ys+naturalCompFull _ o _ _ = o++naturalCompFull0 f _ (uncons -> Just ('0', xs))+ (uncons -> Just ('0', ys)) =+ naturalCompFull0 f EQ xs ys+naturalCompFull0 _ _ _ (uncons -> Just ('0', ys)) = GT+naturalCompFull0 _ _ (uncons -> Just ('0', _)) _ = LT+naturalCompFull0 _ _ (uncons -> Nothing) (uncons -> Just (y, _))+ | isDigit y = GT+ | otherwise = LT+naturalCompFull0 _ _ (uncons -> Just (x, _)) (uncons -> Nothing)+ | isDigit x = LT+ | otherwise = GT+naturalCompFull0 f o xl yl = naturalCompFull1 f o xl yl++naturalCompFull1 _ LT _ _ = LT+naturalCompFull1 _ GT _ _ = GT+naturalCompFull1 _ EQ (uncons -> Nothing) (uncons -> Just (y, _))+ | isDigit y = LT+ | otherwise = GT+naturalCompFull1 _ EQ (uncons -> Just (x, _)) (uncons -> Nothing)+ | isDigit x = GT+ | otherwise = LT+naturalCompFull1 _ EQ (uncons -> Nothing) (uncons -> Nothing) = EQ+naturalCompFull1 f EQ xl@(uncons -> Just (x, xs))+ yl@(uncons -> Just (y, ys))+ | isDigit x && isDigit y = naturalCompFull1 f (x `compare` y) xs ys+ | isDigit x = LT+ | isDigit y = GT+ | otherwise = naturalCompFull f EQ xl yl++naturalCompFullN _ o (uncons -> Nothing) (uncons -> Nothing) = o+naturalCompFullN _ _ (uncons -> Nothing) _ = LT+naturalCompFullN _ _ _ (uncons -> Nothing) = GT+naturalCompFullN f o xl@(uncons -> Just (x, xs))+ yl@(uncons -> Just (y, ys))+ | isDigit x && isDigit y = naturalCompFullN f (o <> compare x y) xs ys+ | isDigit x = GT+ | isDigit y = LT+ | otherwise = naturalCompFull f o xl yl
+ Text/NaturalComp/FilePath.hs view
@@ -0,0 +1,43 @@+{- |+ Module: Text.NaturalComp.FilePath+ Copyright: 2013 Hironao Komatsu+ License: BSD+ Maintainer: Hironao Komatsu <hirkmt@gmail.com>+ Portability: portable++ FilePaths are hard to instantiate Stringy, thus newtypes here.+-}++module Text.NaturalComp.FilePath (FilePathNC (..), FilePathNCC (..)) where++import Filesystem.Path.CurrentOS+import Prelude hiding (FilePath)+import Text.NaturalComp++newtype FilePathNC = FilePathNC { getFilePath :: FilePath }+newtype FilePathNCC = FilePathNCC { getFilePathC :: FilePath }++instance Eq FilePathNC where+ x == y =+ let x' = encode $ getFilePath x+ y' = encode $ getFilePath y+ in naturalComp x' y' == EQ++instance Ord FilePathNC where+ x `compare` y =+ let x' = encode $ getFilePath x+ y' = encode $ getFilePath y+ in naturalComp x' y'++instance Eq FilePathNCC where+ x == y =+ let x' = encode $ getFilePathC x+ y' = encode $ getFilePathC y+ in naturalCaseComp x' y' == EQ++instance Ord FilePathNCC where+ x `compare` y =+ let x' = encode $ getFilePathC x+ y' = encode $ getFilePathC y+ in naturalCaseComp x' y'+
+ Text/NaturalComp/Stringy.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleInstances #-}++{- |+ Module: Text.NaturalComp.Stringy+ Copyright: 2013 Hironao Komatsu+ License: BSD+ Maintainer: Hironao Komatsu <hirkmt@gmail.com>+ Portability: portable++ A type class that have methods @uncons@ and @toString@, so that we+ can handle them as String-like objects.+-}++module Text.NaturalComp.Stringy (Stringy (..)) where++import qualified Data.ByteString.UTF8 as U+import qualified Data.ByteString.Lazy.UTF8 as UL+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL++class Stringy s where+ uncons :: s -> Maybe (Char, s)+ toString :: s -> String++instance Stringy [Char] where+ uncons [] = Nothing+ uncons (x:xs) = Just (x, xs)+ toString = id++instance Stringy U.ByteString where+ uncons = U.uncons+ toString = U.toString++instance Stringy UL.ByteString where+ uncons = UL.uncons+ toString = UL.toString++instance Stringy T.Text where+ uncons = T.uncons+ toString = T.unpack++instance Stringy TL.Text where+ uncons = TL.uncons+ toString = TL.unpack+
+ naturalcomp.cabal view
@@ -0,0 +1,36 @@+Name: naturalcomp+Version: 0.0.1+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+ aimed to be compatible to glibc's strverscmp() function.++License: BSD3+License-file: COPYING+Author: Hironao Komatsu+Maintainer: Hironao Komatsu <hirkmt@gmail.com>+Build-Type: Simple+Cabal-Version: >= 1.8+Stability: alpha+Homepage: not yet available+Bug-Reports: not yet available+Category: Text+Tested-With: GHC == 7.6.3++Extra-Source-Files: test/nctest.cabal+ test/nctest.hs++flag filepath+ 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)+ build-depends: system-filepath >= 0.3+
+ test/nctest.cabal view
@@ -0,0 +1,10 @@+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
+ test/nctest.hs view
@@ -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+