Ordered list monad

ordlistmonad.hs

{-# LANGUAGE MonadComprehensions #-}

import Data.List.Ordered
import Data.Ord
import Control.Monad.Trans.Cont

fromList :: [a] -> Cont [Vec Double] a
fromList as = cont $ \k -> mergeAllBy (comparing norm) $ map k as

toList :: Cont [Vec Double] (Vec Double) -> [Vec Double]
toList = flip runCont return

genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = toList [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]

data Vec a = Vec a a
    deriving (Eq, Show)

instance Num a => Num (Vec a) where
    (Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
    -- ...

s .* (Vec x y) = Vec (s*x) (s*y)     
norm (Vec x y) = sqrt (x^2 + y^2)

test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)

ordlistmonad2.hs

{-# LANGUAGE MonadComprehensions #-}

import Data.List.Ordered
import Data.Ord
import Control.Monad.Trans.Cont


fromList :: [a] -> Cont ((r -> r -> Ordering) -> [r]) a
fromList as = cont $ \k cmp -> mergeAllBy cmp $ map (flip k cmp) as

orderedBy :: (a -> a -> Ordering) -> Cont ((a -> a -> Ordering) -> [a]) a -> [a]
orderedBy cmp = ($ cmp) . flip runCont (const . return)

genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = orderedBy (comparing norm) [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]

data Vec a = Vec a a
    deriving (Eq, Show)

instance Num a => Num (Vec a) where
    (Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
    -- ...

s .* (Vec x y) = Vec (s*x) (s*y)     
norm (Vec x y) = sqrt (x^2 + y^2)

test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)

ordlistmonad3.hs

{-# LANGUAGE MonadComprehensions #-}

import Data.List.Ordered
import Data.Ord
import Data.FMList (FMList, fromList)
import Data.Monoid
import Data.Foldable

newtype MergeList = MergeList { runMergeList :: [Vec Double] }
instance Monoid MergeList where
  mempty = MergeList []
  MergeList as `mappend` MergeList bs = MergeList (mergeAllBy (comparing norm) [as, bs])

run :: FMList (Vec Double) -> [Vec Double]
run = runMergeList . foldMap (MergeList . return)

genFromPair :: (Vec Double, Vec Double) -> [Vec Double]
genFromPair (e1, e2) = run [x.*e1 + y.*e2 | x <- fromList [0..], y <- fromList [0..]]

data Vec a = Vec a a
    deriving (Eq, Show)

instance Num a => Num (Vec a) where
    (Vec x1 y1) + (Vec x2 y2) = Vec (x1+x2) (y1+y2)
    -- ...

s .* (Vec x y) = Vec (s*x) (s*y)     
norm (Vec x y) = sqrt (x^2 + y^2)

test = take 5 $ genFromPair (Vec 0 1, Vec 1 0)