{-# 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)
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