Haskell bitonic sorter (non-parallel, power of 2)

BitonicSort.hs

{- stack script
 --resolver lts-15.5
-}

-- To run:
-- stack BitonicSort.hs

module BitonicSort where

import Data.Bits as B
import Data.List(sort)
import Test.QuickCheck
import System.Exit

-- Ref: https://cs.wmich.edu/gupta/teaching/cs5260/5260Sp15web/lectureNotes/bitonicSort%20John%20Mellor-Crummey%20comp322-s12-lec28-slides-JMC.pdf

-- Bitonic merge operator.
-- Input must be a bitnoic sequence with length power of 2.
-- Output is a sorted sequence.
bitonicMerge :: (Ord a) => Bool -> [a] -> [a]
bitonicMerge isUp xs
  | n <= 1 = xs
  | otherwise = (bitonicMerge isUp bitonicLeft) ++ (bitonicMerge isUp bitonicRight)
  where
    n = length xs
    left = take (n `div` 2) xs
    right = drop (n `div` 2) xs
    leftCmp = if isUp then min else max
    rightCmp = if isUp then max else min
    bitonicLeft = [leftCmp l r | (l, r) <- zip left right]
    bitonicRight = [rightCmp l r | (l, r) <- zip left right]

-- Bitonic sorting network.
-- Input is an unsorted sequence with length power of 2.
-- Output is a sorted sequence.
bitonicSort :: (Ord a) => Bool -> [a] -> [a]
bitonicSort isUp xs
  | n <= 1 = xs
  | otherwise = bitonicMerge isUp $ (bitonicSort isUp left ++ bitonicSort (not isUp) right)
  where
    n = length xs
    left = take (n `div` 2) xs
    right = drop (n `div` 2) xs

-- QuickCheck
isPowerOf2 :: (B.Bits a, Integral a) => a -> Bool
isPowerOf2 n = n B..&. (n - 1) == 0

prop_sort :: [Int] -> Property
prop_sort xs = (isPowerOf2 $ length xs) ==> bitonicSort True xs == sort xs

prop_reverse :: [Int] -> Property
prop_reverse xs = (isPowerOf2 $ length xs) ==> bitonicSort True xs == (reverse $ bitonicSort False xs)

main :: IO ()
main = do
  quickCheck prop_sort
  quickCheck prop_reverse