module Data.Tensort.Subalgorithms.Permutationsort (permutationsort) where

import Data.List (permutations)
import Data.Tensort.Utils.Check (isSorted)
import Data.Tensort.Utils.Types (Record, Sortable (..), fromSortBit, fromSortRec, Bit)

permutationsort :: Sortable -> Sortable
permutationsort :: Sortable -> Sortable
permutationsort (SortBit [Bit]
xs) = [Bit] -> Sortable
SortBit ([[Bit]] -> [Bit] -> [Bit]
acc ([Bit] -> [[Bit]]
forall a. [a] -> [[a]]
permutations [Bit]
x) [])
  where
    x :: [Bit]
x = [Bit]
xs
    acc :: [[Bit]] -> [Bit] -> [Bit]
    acc :: [[Bit]] -> [Bit] -> [Bit]
acc [] [Bit]
unsortedPermutations = Sortable -> [Bit]
fromSortBit (Sortable -> Sortable
permutationsort ([Bit] -> Sortable
SortBit [Bit]
unsortedPermutations))
    acc ([Bit]
permutation : [[Bit]]
remainingPermutations) [Bit]
unsortedPermutations
      | Sortable -> Bool
isSorted ([Bit] -> Sortable
SortBit [Bit]
permutation) = [Bit]
permutation
      | Bool
otherwise = [[Bit]] -> [Bit] -> [Bit]
acc [[Bit]]
remainingPermutations [Bit]
unsortedPermutations
permutationsort (SortRec [Record]
xs) = [Record] -> Sortable
SortRec ([[Record]] -> [Record] -> [Record]
acc ([Record] -> [[Record]]
forall a. [a] -> [[a]]
permutations [Record]
x) [])
  where
    x :: [Record]
x = [Record]
xs
    acc :: [[Record]] -> [Record] -> [Record]
    acc :: [[Record]] -> [Record] -> [Record]
acc [] [Record]
unsortedPermutations = Sortable -> [Record]
fromSortRec (Sortable -> Sortable
permutationsort ([Record] -> Sortable
SortRec [Record]
unsortedPermutations))
    acc ([Record]
permutation : [[Record]]
remainingPermutations) [Record]
unsortedPermutations
      | Sortable -> Bool
isSorted ([Record] -> Sortable
SortRec [Record]
permutation) = [Record]
permutation
      | Bool
otherwise = [[Record]] -> [Record] -> [Record]
acc [[Record]]
remainingPermutations [Record]
unsortedPermutations