{-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | -- Module : Data.Sorted -- Copyright : (c) Conal Elliott 2008 -- License : BSD3 -- -- Maintainer : conal@conal.net -- Stability : experimental -- -- Sorted lists: experimental (unused) ---------------------------------------------------------------------- module Reactive.Sorted where import Data.Monoid import Data.List (sort) import Control.Applicative import Control.Monad newtype Sorted a = Sort { unSort :: [a] } -- non-decreasing values -- | Apply a unary function within the event representation. inSort :: ([a] -> [b]) -> (Sorted a -> Sorted b) inSort f = Sort . f . unSort -- | Apply a binary function within the event representation. inSort2 :: ([a] -> [b] -> [c]) -> (Sorted a -> Sorted b -> Sorted c) inSort2 f = inSort . f . unSort instance Ord a => Monoid (Sorted a) where mempty = Sort [] mappend = inSort2 merge -- | Merge two ordered lists into an ordered list. merge :: Ord a => [a] -> [a] -> [a] [] `merge` vs = vs us `merge` [] = us us@(u:us') `merge` vs@(v:vs') = (u `min` v) : if u <= v then us' `merge` vs else us `merge` vs' -- Alternatively, -- -- us@(u:us') `merge` vs@(v:vs') = -- if u <= v then -- u : (us' `merge` vs ) -- else -- v : (us `merge` vs') -- -- The definition used instead is more productive. It produces a cons -- cell immediately and can even produce partial information about @u -- `min` v@ before it's known which is smaller. class FunctorOrd h where fmapO :: (Ord a, Ord b) => (a -> b) -> h a -> h b class FunctorOrd h => ApplicativeOrd h where pureO :: Ord a => a -> h a (<*?>) :: (Ord a, Ord b) => h (a -> b) -> h a -> h b class MonadOrd h where returnO :: Ord a => a -> h a -- does joinO need Ord (h a) ? joinO :: Ord a => h (h a) -> h a instance FunctorOrd Sorted where fmapO f = inSort (sort . fmap f) instance ApplicativeOrd Sorted where pureO a = Sort (pure a) (<*?>) = inSort2 \$ (fmap.fmap) sort (<*>) instance MonadOrd Sorted where returnO = pureO joinO = inSort \$ sort . join . fmap unSort