-- |
-- /NOTE:/ This module is not meant for public consumption.  For user
-- documentation look at http://hspec.github.io/hspec-discover.html.
module Test.Hspec.Discover.Sort (
  sortNaturallyBy
, NaturalSortKey
, naturalSortKey
) where

import           Control.Arrow
import           Data.Char
import           Data.List
import           Data.Ord

sortNaturallyBy :: (a -> (String, Int)) -> [a] -> [a]
sortNaturallyBy :: (a -> (String, Int)) -> [a] -> [a]
sortNaturallyBy a -> (String, Int)
f = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((a -> (NaturalSortKey, Int)) -> a -> a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((\ (String
k, Int
t) -> (String -> NaturalSortKey
naturalSortKey String
k, Int
t)) ((String, Int) -> (NaturalSortKey, Int))
-> (a -> (String, Int)) -> a -> (NaturalSortKey, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (String, Int)
f))

data NaturalSortKey = NaturalSortKey [Chunk]
  deriving (NaturalSortKey -> NaturalSortKey -> Bool
(NaturalSortKey -> NaturalSortKey -> Bool)
-> (NaturalSortKey -> NaturalSortKey -> Bool) -> Eq NaturalSortKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NaturalSortKey -> NaturalSortKey -> Bool
$c/= :: NaturalSortKey -> NaturalSortKey -> Bool
== :: NaturalSortKey -> NaturalSortKey -> Bool
$c== :: NaturalSortKey -> NaturalSortKey -> Bool
Eq, Eq NaturalSortKey
Eq NaturalSortKey
-> (NaturalSortKey -> NaturalSortKey -> Ordering)
-> (NaturalSortKey -> NaturalSortKey -> Bool)
-> (NaturalSortKey -> NaturalSortKey -> Bool)
-> (NaturalSortKey -> NaturalSortKey -> Bool)
-> (NaturalSortKey -> NaturalSortKey -> Bool)
-> (NaturalSortKey -> NaturalSortKey -> NaturalSortKey)
-> (NaturalSortKey -> NaturalSortKey -> NaturalSortKey)
-> Ord NaturalSortKey
NaturalSortKey -> NaturalSortKey -> Bool
NaturalSortKey -> NaturalSortKey -> Ordering
NaturalSortKey -> NaturalSortKey -> NaturalSortKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NaturalSortKey -> NaturalSortKey -> NaturalSortKey
$cmin :: NaturalSortKey -> NaturalSortKey -> NaturalSortKey
max :: NaturalSortKey -> NaturalSortKey -> NaturalSortKey
$cmax :: NaturalSortKey -> NaturalSortKey -> NaturalSortKey
>= :: NaturalSortKey -> NaturalSortKey -> Bool
$c>= :: NaturalSortKey -> NaturalSortKey -> Bool
> :: NaturalSortKey -> NaturalSortKey -> Bool
$c> :: NaturalSortKey -> NaturalSortKey -> Bool
<= :: NaturalSortKey -> NaturalSortKey -> Bool
$c<= :: NaturalSortKey -> NaturalSortKey -> Bool
< :: NaturalSortKey -> NaturalSortKey -> Bool
$c< :: NaturalSortKey -> NaturalSortKey -> Bool
compare :: NaturalSortKey -> NaturalSortKey -> Ordering
$ccompare :: NaturalSortKey -> NaturalSortKey -> Ordering
$cp1Ord :: Eq NaturalSortKey
Ord)

data Chunk = Numeric Integer Int | Textual [(Char, Char)]
  deriving (Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c== :: Chunk -> Chunk -> Bool
Eq, Eq Chunk
Eq Chunk
-> (Chunk -> Chunk -> Ordering)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Bool)
-> (Chunk -> Chunk -> Chunk)
-> (Chunk -> Chunk -> Chunk)
-> Ord Chunk
Chunk -> Chunk -> Bool
Chunk -> Chunk -> Ordering
Chunk -> Chunk -> Chunk
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Chunk -> Chunk -> Chunk
$cmin :: Chunk -> Chunk -> Chunk
max :: Chunk -> Chunk -> Chunk
$cmax :: Chunk -> Chunk -> Chunk
>= :: Chunk -> Chunk -> Bool
$c>= :: Chunk -> Chunk -> Bool
> :: Chunk -> Chunk -> Bool
$c> :: Chunk -> Chunk -> Bool
<= :: Chunk -> Chunk -> Bool
$c<= :: Chunk -> Chunk -> Bool
< :: Chunk -> Chunk -> Bool
$c< :: Chunk -> Chunk -> Bool
compare :: Chunk -> Chunk -> Ordering
$ccompare :: Chunk -> Chunk -> Ordering
$cp1Ord :: Eq Chunk
Ord)

naturalSortKey :: String -> NaturalSortKey
naturalSortKey :: String -> NaturalSortKey
naturalSortKey = [Chunk] -> NaturalSortKey
NaturalSortKey ([Chunk] -> NaturalSortKey)
-> (String -> [Chunk]) -> String -> NaturalSortKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Chunk]
chunks
  where
    chunks :: String -> [Chunk]
chunks [] = []
    chunks s :: String
s@(Char
c:String
_)
      | Char -> Bool
isDigit Char
c = Integer -> Int -> Chunk
Numeric (String -> Integer
forall a. Read a => String -> a
read String
num) (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
num) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: String -> [Chunk]
chunks String
afterNum
      | Bool
otherwise = [(Char, Char)] -> Chunk
Textual ((Char -> (Char, Char)) -> String -> [(Char, Char)]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char
toLower (Char -> Char) -> (Char -> Char) -> Char -> (Char, Char)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Char -> Char
forall a. a -> a
id) String
str) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: String -> [Chunk]
chunks String
afterStr
      where
        (String
num, String
afterNum) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span  Char -> Bool
isDigit String
s
        (String
str, String
afterStr) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isDigit String
s