{-# 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 = naturalCompFull compare EQ

-- | natural order and case-insensitive string comparison
naturalCaseComp :: Stringy s => s -> s -> Ordering
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
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