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--