module Data.Tensort.OtherSorts.Quicksort (quicksort) where

import Data.Tensort.Utils.ComparisonFunctions (greaterThanBit, greaterThanRecord, lessThanOrEqualBit, lessThanOrEqualRecord)
import Data.Tensort.Utils.Types (Sortable (..), fromSortBit, fromSortRec)

quicksort :: Sortable -> Sortable
quicksort :: Sortable -> Sortable
quicksort (SortBit []) = [Bit] -> Sortable
SortBit []
quicksort (SortBit (Bit
x : [Bit]
xs)) =
  let lowerPartition :: Sortable
lowerPartition = Sortable -> Sortable
quicksort ([Bit] -> Sortable
SortBit [Bit
a | Bit
a <- [Bit]
xs, Bit -> Bit -> Bool
lessThanOrEqualBit Bit
a Bit
x])
      upperPartition :: Sortable
upperPartition = Sortable -> Sortable
quicksort ([Bit] -> Sortable
SortBit [Bit
a | Bit
a <- [Bit]
xs, Bit -> Bit -> Bool
greaterThanBit Bit
a Bit
x])
   in [Bit] -> Sortable
SortBit (Sortable -> [Bit]
fromSortBit Sortable
lowerPartition [Bit] -> [Bit] -> [Bit]
forall a. [a] -> [a] -> [a]
++ [Bit
x] [Bit] -> [Bit] -> [Bit]
forall a. [a] -> [a] -> [a]
++ Sortable -> [Bit]
fromSortBit Sortable
upperPartition)
quicksort (SortRec []) = [Record] -> Sortable
SortRec []
quicksort (SortRec (Record
x : [Record]
xs)) =
  let lowerPartition :: Sortable
lowerPartition = Sortable -> Sortable
quicksort ([Record] -> Sortable
SortRec [Record
a | Record
a <- [Record]
xs, Record -> Record -> Bool
lessThanOrEqualRecord Record
a Record
x])
      upperPartition :: Sortable
upperPartition = Sortable -> Sortable
quicksort ([Record] -> Sortable
SortRec [Record
a | Record
a <- [Record]
xs, Record -> Record -> Bool
greaterThanRecord Record
a Record
x])
   in [Record] -> Sortable
SortRec (Sortable -> [Record]
fromSortRec Sortable
lowerPartition [Record] -> [Record] -> [Record]
forall a. [a] -> [a] -> [a]
++ [Record
x] [Record] -> [Record] -> [Record]
forall a. [a] -> [a] -> [a]
++ Sortable -> [Record]
fromSortRec Sortable
upperPartition)