{-# 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
                        , naturalCompBy ) where

import Data.Char (isDigit, toTitle)
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 :: forall s. Stringy s => s -> s -> Ordering
naturalComp = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ordering
EQ

-- | natural order and case-insensitive string comparison
naturalCaseComp :: Stringy s => s -> s -> Ordering
naturalCaseComp :: forall s. Stringy s => s -> s -> Ordering
naturalCaseComp = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull ((Char -> Char) -> Char -> Char -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Char -> Char
toTitle) Ordering
EQ

-- | natural order string comparison, with user-specified function
naturalCompBy :: Stringy s => (Char -> Char -> Ordering)
              -> s -> s -> Ordering
naturalCompBy :: forall s.
Stringy s =>
(Char -> Char -> Ordering) -> s -> s -> Ordering
naturalCompBy = ((Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering)
-> Ordering -> (Char -> Char -> Ordering) -> s -> s -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Ordering
EQ

naturalCompFull :: Stringy s => (Char -> Char -> Ordering) -> Ordering
                -> s -> s -> Ordering
naturalCompFull :: forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Char -> Char -> Ordering
_ Ordering
o  (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) = Ordering
o
naturalCompFull Char -> Char -> Ordering
_ Ordering
EQ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) s
_                   = Ordering
LT
naturalCompFull Char -> Char -> Ordering
_ Ordering
EQ s
_                   (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) = Ordering
GT
naturalCompFull Char -> Char -> Ordering
f Ordering
EQ
                xl :: s
xl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
xs))
                yl :: s
yl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
ys)) =
    (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull0 Char -> Char -> Ordering
f Ordering
EQ s
xs s
ys
naturalCompFull Char -> Char -> Ordering
f Ordering
EQ xl :: s
xl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
_)) s
yl =
    (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull1 Char -> Char -> Ordering
f Ordering
EQ s
xl s
yl
naturalCompFull Char -> Char -> Ordering
f Ordering
EQ s
xl yl :: s
yl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
_)) =
    (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull1 Char -> Char -> Ordering
f Ordering
EQ s
xl s
yl
naturalCompFull Char -> Char -> Ordering
f Ordering
EQ
                xl :: s
xl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
x, s
xs))
                yl :: s
yl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
y, s
ys))
    | Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFullN Char -> Char -> Ordering
f Ordering
EQ s
xl s
yl
    | Bool
otherwise = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Char -> Char -> Ordering
f (Char -> Char -> Ordering
f Char
x Char
y) s
xs s
ys
naturalCompFull Char -> Char -> Ordering
_ Ordering
o  s
_  s
_  = Ordering
o

naturalCompFull0 :: (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull0 Char -> Char -> Ordering
f Ordering
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
xs))
                     (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
ys)) =
                          (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull0 Char -> Char -> Ordering
f Ordering
EQ s
xs s
ys
naturalCompFull0 Char -> Char -> Ordering
_ Ordering
_ s
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
ys)) = Ordering
GT
naturalCompFull0 Char -> Char -> Ordering
_ Ordering
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
'0', s
_))  s
_ = Ordering
LT
naturalCompFull0 Char -> Char -> Ordering
_ Ordering
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
y, s
_))
    | Char -> Bool
isDigit Char
y = Ordering
GT
    | Bool
otherwise = Ordering
LT
naturalCompFull0 Char -> Char -> Ordering
_ Ordering
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
x, s
_)) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing)
    | Char -> Bool
isDigit Char
x = Ordering
LT
    | Bool
otherwise = Ordering
GT
naturalCompFull0 Char -> Char -> Ordering
f Ordering
o s
xl s
yl = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull1 Char -> Char -> Ordering
f Ordering
o s
xl s
yl

naturalCompFull1 :: (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull1 Char -> Char -> Ordering
_ Ordering
LT s
_ s
_ = Ordering
LT
naturalCompFull1 Char -> Char -> Ordering
_ Ordering
GT s
_ s
_ = Ordering
GT
naturalCompFull1 Char -> Char -> Ordering
_ Ordering
EQ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
y, s
_))
    | Char -> Bool
isDigit Char
y = Ordering
LT
    | Bool
otherwise = Ordering
GT
naturalCompFull1 Char -> Char -> Ordering
_ Ordering
EQ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
x, s
_)) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing)
    | Char -> Bool
isDigit Char
x = Ordering
GT
    | Bool
otherwise = Ordering
LT
naturalCompFull1 Char -> Char -> Ordering
_ Ordering
EQ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) = Ordering
EQ
naturalCompFull1 Char -> Char -> Ordering
f Ordering
EQ xl :: s
xl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
x, s
xs))
                 yl :: s
yl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
y, s
ys))
    | Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull1 Char -> Char -> Ordering
f (Char
x Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Char
y) s
xs s
ys
    | Char -> Bool
isDigit Char
x              = Ordering
LT
    | Char -> Bool
isDigit Char
y              = Ordering
GT
    | Bool
otherwise              = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Char -> Char -> Ordering
f Ordering
EQ s
xl s
yl

naturalCompFullN :: (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFullN Char -> Char -> Ordering
_ Ordering
o (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) = Ordering
o
naturalCompFullN Char -> Char -> Ordering
_ Ordering
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) s
_ = Ordering
LT
naturalCompFullN Char -> Char -> Ordering
_ Ordering
_ s
_ (s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Maybe (Char, s)
Nothing) = Ordering
GT
naturalCompFullN Char -> Char -> Ordering
f Ordering
o  xl :: s
xl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
x, s
xs))
                 yl :: s
yl@(s -> Maybe (Char, s)
forall s. Stringy s => s -> Maybe (Char, s)
uncons -> Just (Char
y, s
ys))
    | Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFullN Char -> Char -> Ordering
f (Ordering
o Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
x Char
y) s
xs s
ys
    | Char -> Bool
isDigit Char
x              = Ordering
GT
    | Char -> Bool
isDigit Char
y              = Ordering
LT
    | Bool
otherwise              = (Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
forall s.
Stringy s =>
(Char -> Char -> Ordering) -> Ordering -> s -> s -> Ordering
naturalCompFull Char -> Char -> Ordering
f Ordering
o s
xl s
yl