{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module Bio.Utils.Types
    ( Sorted
    , ordering
    , fromSorted
    , toSorted
    , unsafeToSorted
    ) where

import qualified Data.Foldable as F
import Data.Ord ()

data Sorted f a where
    Sorted :: (F.Foldable f, Ord a)
           => { Sorted f a -> Ordering
ordering :: !Ordering
              , Sorted f a -> f a
fromSorted :: !(f a)
              }
           -> Sorted f a

deriving instance Show (f a) => Show (Sorted f a)

-- | if the data has been sorted, wrap it into Sorted type
toSorted :: (F.Foldable f, Ord a) => f a -> Sorted f a
toSorted :: f a -> Sorted f a
toSorted f a
xs = Ordering -> f a -> Sorted f a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
Ordering -> f a -> Sorted f a
Sorted Ordering
o f a
xs
  where
    o :: Ordering
o = (a -> Ordering, Ordering) -> Ordering
forall a b. (a, b) -> b
snd ((a -> Ordering, Ordering) -> Ordering)
-> (f a -> (a -> Ordering, Ordering)) -> f a -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Ordering, Ordering) -> a -> (a -> Ordering, Ordering))
-> (a -> Ordering, Ordering) -> f a -> (a -> Ordering, Ordering)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (a -> Ordering, Ordering) -> a -> (a -> Ordering, Ordering)
forall a.
Ord a =>
(a -> Ordering, Ordering) -> a -> (a -> Ordering, Ordering)
g (Ordering -> a -> Ordering
forall a b. a -> b -> a
const Ordering
EQ, Ordering
EQ) (f a -> Ordering) -> f a -> Ordering
forall a b. (a -> b) -> a -> b
$ f a
xs
    g :: (a -> Ordering, Ordering) -> a -> (a -> Ordering, Ordering)
g (a -> Ordering
func, Ordering
ord) a
x
        | Ordering
ord Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ = (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x, Ordering
ord')
        | Ordering
ord' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
ord Bool -> Bool -> Bool
|| Ordering
ord' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ = (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x, Ordering
ord)
        | Bool
otherwise = String -> (a -> Ordering, Ordering)
forall a. HasCallStack => String -> a
error String
"data is not sorted"
      where
        ord' :: Ordering
ord' = a -> Ordering
func a
x

unsafeToSorted :: (F.Foldable f, Ord a) => Ordering -> f a -> Sorted f a
unsafeToSorted :: Ordering -> f a -> Sorted f a
unsafeToSorted = Ordering -> f a -> Sorted f a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
Ordering -> f a -> Sorted f a
Sorted