diff --git a/Algorithms/NaturalSort.hs b/Algorithms/NaturalSort.hs deleted file mode 100644 --- a/Algorithms/NaturalSort.hs +++ /dev/null @@ -1,114 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Algorithms.NaturalSort --- Copyright : (c) 2010 John Millikin --- License : BSD3 --- --- Maintainer : jmillikin@gmail.com --- Portability : portable --- --- Human-friendly text collation --- ------------------------------------------------------------------------------ -{-# LANGUAGE TypeSynonymInstances #-} -module Algorithms.NaturalSort - ( SortKey - , NaturalSort (..) - , compare - ) where -import Prelude hiding (compare) -import qualified Prelude as Prelude -import Data.Char (isDigit) -import Data.Function (on) -import qualified Data.ByteString as B -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Text.Parsec as P - -data SortChunk - = Integer Integer - | Text T.Text - | Collated B.ByteString (T.Text -> B.ByteString) - -instance Show SortChunk where - show (Integer x) = show x - show (Text x) = show x - show (Collated x _) = show x - -instance Ord SortChunk where - -- Basic comparisons - compare (Integer x) (Integer y) = Prelude.compare x y - compare (Text x) (Text y) = Prelude.compare x y - compare (Collated x _) (Collated y _) = Prelude.compare x y - - -- Text <-> ByteString - compare (Text x) (Collated y f) = Prelude.compare (f x) y - compare (Collated x f) (Text y) = Prelude.compare x (f y) - - -- Integer < * - compare (Integer _) _ = LT - compare _ (Integer _) = GT - -instance Eq SortChunk where - (Integer x) == (Integer y) = x == y - (Text x) == (Text y) = x == y - (Collated x _) == (Collated y _) = x == y - - (Text x) == (Collated y f) = f x == y - (Collated x f) == (Text y) = x == f y - - _ == _ = False - -data SortKey = SortKey [SortChunk] - deriving (Show, Eq, Ord) - -class NaturalSort a where - -- | Split a sortable type into textual and numeric sections, with no - -- collation transformation. - -- - -- If advanced collation is required, either pre-transform the input - -- (using eg 'T.toLower') or use 'sortKeyCollated'. - -- - sortKey :: a -> SortKey - - -- | Split a sortable type into textual and numeric sections, using - -- a custom collation transformation. This is useful for providing - -- language- or use-specific ordering. - -- - sortKeyCollated :: (T.Text -> B.ByteString) -> a -> SortKey - -instance NaturalSort String where - sortKey = parseText Nothing - sortKeyCollated f = parseText (Just f) - -instance NaturalSort TL.Text where - sortKey = sortKey . TL.unpack - sortKeyCollated = (. TL.unpack) . sortKeyCollated - -instance NaturalSort T.Text where - sortKey = parseText Nothing . T.unpack - sortKeyCollated = (. T.unpack) . sortKeyCollated - --- | Compare two values, using their natural ordering. -compare :: NaturalSort a => a -> a -> Ordering -compare = Prelude.compare `on` sortKey - -parseText :: Maybe (T.Text -> B.ByteString) -> String -> SortKey -parseText toBytes string = parsed where - parsed = case P.parse parser "" string of - Right key -> key - - -- This should never happen; the parser has no failure - -- conditions, unless somehow something broke within Parsec - -- itself. - Left err -> error $ "sortKey failed: " ++ show err - - parser = fmap SortKey $ P.manyTill chunk P.eof where - chunk = P.choice [int, text] - int = fmap (Integer . read) $ P.many1 P.digit - text = fmap toText $ P.many1 notDigit - notDigit = P.satisfy (not . isDigit) - - toText chars = let text = T.pack chars in case toBytes of - Nothing -> Text text - Just f -> Collated (f text) f diff --git a/lib/Algorithms/NaturalSort.hs b/lib/Algorithms/NaturalSort.hs new file mode 100644 --- /dev/null +++ b/lib/Algorithms/NaturalSort.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} + +-- | +-- Module : Algorithms.NaturalSort +-- Copyright : (c) 2010 John Millikin +-- License : BSD3 +-- +-- Maintainer : jmillikin@gmail.com +-- Portability : portable +-- +-- Human-friendly text collation +module Algorithms.NaturalSort + ( SortKey + , NaturalSort (..) + , compare + ) where + +import Prelude hiding (compare) +import qualified Prelude as Prelude +import Data.Char (isDigit) +import Data.Function (on) +import qualified Data.ByteString as B +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL + +import qualified Text.Parsec as P + +data SortChunk + = Integer Integer + | Text T.Text + | Collated B.ByteString (T.Text -> B.ByteString) + +instance Show SortChunk where + show (Integer x) = show x + show (Text x) = show x + show (Collated x _) = show x + +instance Ord SortChunk where + -- Basic comparisons + compare (Integer x) (Integer y) = Prelude.compare x y + compare (Text x) (Text y) = Prelude.compare x y + compare (Collated x _) (Collated y _) = Prelude.compare x y + + -- Text <-> ByteString + compare (Text x) (Collated y f) = Prelude.compare (f x) y + compare (Collated x f) (Text y) = Prelude.compare x (f y) + + -- Integer < * + compare (Integer _) _ = LT + compare _ (Integer _) = GT + +instance Eq SortChunk where + (Integer x) == (Integer y) = x == y + (Text x) == (Text y) = x == y + (Collated x _) == (Collated y _) = x == y + + (Text x) == (Collated y f) = f x == y + (Collated x f) == (Text y) = x == f y + + _ == _ = False + +data SortKey = SortKey [SortChunk] + deriving (Show, Eq, Ord) + +class NaturalSort a where + -- | Split a sortable type into textual and numeric sections, with no + -- collation transformation. + -- + -- If advanced collation is required, either pre-transform the input + -- (using eg 'T.toLower') or use 'sortKeyCollated'. + sortKey :: a -> SortKey + + -- | Split a sortable type into textual and numeric sections, using + -- a custom collation transformation. This is useful for providing + -- language- or use-specific ordering. + sortKeyCollated :: (T.Text -> B.ByteString) -> a -> SortKey + +instance NaturalSort String where + sortKey = parseText Nothing + sortKeyCollated f = parseText (Just f) + +instance NaturalSort TL.Text where + sortKey = sortKey . TL.unpack + sortKeyCollated = (. TL.unpack) . sortKeyCollated + +instance NaturalSort T.Text where + sortKey = parseText Nothing . T.unpack + sortKeyCollated = (. T.unpack) . sortKeyCollated + +-- | Compare two values, using their natural ordering. +compare :: NaturalSort a => a -> a -> Ordering +compare = Prelude.compare `on` sortKey + +parseText :: Maybe (T.Text -> B.ByteString) -> String -> SortKey +parseText toBytes string = parsed where + parsed = case P.parse parser "" string of + Right key -> key + + -- This should never happen; the parser has no failure + -- conditions, unless somehow something broke within Parsec + -- itself. + Left err -> error ("sortKey failed: " ++ show err) + + parser = fmap SortKey (P.manyTill chunk P.eof) where + chunk = P.choice [int, text] + int = fmap (Integer . read) (P.many1 P.digit) + text = fmap toText (P.many1 notDigit) + notDigit = P.satisfy (not . isDigit) + + toText chars = let text = T.pack chars in case toBytes of + Nothing -> Text text + Just f -> Collated (f text) f diff --git a/natural-sort.cabal b/natural-sort.cabal --- a/natural-sort.cabal +++ b/natural-sort.cabal @@ -1,5 +1,15 @@ name: natural-sort -version: 0.1.1 +version: 0.1.2 +license: BSD3 +license-File: license.txt +author: John Millikin +maintainer: John Millikin +build-type: Simple +cabal-version: >= 1.6 +category: Algorithms +homepage: https://john-millikin.com/software/natural-sort/ +bug-reports: mailto:jmillikin@gmail.com + synopsis: User-friendly text collation description: The built-in comparisons for textual data are based on Unicode ordinals. This @@ -12,23 +22,24 @@ . See also: -license: BSD3 -license-File: license.txt -author: John Millikin -maintainer: John Millikin -copyright: 2010 John Millikin -build-type: Simple -cabal-version: >=1.2 -category: Algorithms +source-repository head + type: bazaar + location: https://john-millikin.com/branches/natural-sort/0.1/ +source-repository this + type: bazaar + location: https://john-millikin.com/branches/natural-sort/0.1/ + tag: natural-sort_0.1.2 + library + ghc-options: -Wall -O2 + hs-source-dirs: lib + build-depends: - base >= 2 && < 5 - , parsec >= 3 + base >= 4.0 && < 5.0 + , parsec >= 3.0 && < 4.0 , text , bytestring exposed-modules: Algorithms.NaturalSort - - ghc-options: -Wall