edison question

paul@theV.net paul@theV.net
Tue, 30 Jul 2002 19:57:04 +0800


--PNTmBPCT7hxwcZjr
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

I am quite confused with the collection package provided by
the edison library. Attached is a sample program, what I
wanted to do is to maintain a sorted of Pair of id and time
(sorted by time). The error I got is:

ghc -package data -package lang test.hs

test.hs:17:
    No instance for `Collection.OrdColl c Pair'
    arising from use of `Collection.minElem' at test.hs:17
    in a pattern binding: Collection.minElem sorted

Actually I don't really understand what a class like
"OrdColl c a" really means and how to use them. Please help!

Regards,
.paul.

--PNTmBPCT7hxwcZjr
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="test.hs"

module Main where

import Posix
import EdisonPrelude
import qualified Collection as C

data Pair = Pair Int EpochTime

instance Eq Pair where
    Pair a b == Pair a' b' = a == a'

instance Ord Pair where
    Pair a b <= Pair a' b' = b <= b'

main = do
    let sorted = C.insert (Pair 0 0) (C.insert (Pair 1 1) C.empty)
    let (Pair id time) = C.minElem sorted
    let sorted' = C.deleteMin sorted
    putStrLn ("min is id:" ++ (show id) ++ " time:" ++ (show time))

--PNTmBPCT7hxwcZjr--