1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
-- -*-haskell-*-
-- class of flag types
--
-- Author : Duncan Coutts
--
-- Created: 21 January 2005
--
-- Copyright (C) 2001-2005 Duncan Coutts, Axel Simon
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable
--
-- This module defines a type class for flags that are marshaled as bitflags.
--
module System.Glib.Flags (
Flags,
fromFlags,
toFlags
) where
import Data.Bits ((.|.), (.&.), testBit, shiftL, shiftR)
import Data.Maybe (catMaybes)
class (Enum a, Bounded a) => Flags a
fromFlags :: Flags a => [a] -> Int
fromFlags is = orNum 0 is
where orNum n [] = n
orNum n (i:is) = orNum (n .|. fromEnum i) is
-- * Note that this function ignores bits set in the passed
-- 'Int' that do not correspond to a flag.
toFlags :: Flags a => Int -> [a]
toFlags n = catMaybes [ if n .&. fromEnum flag == fromEnum flag
then Just flag
else Nothing
| flag <- [minBound .. maxBound] ]
-------------------------
-- QuickCheck test code
{-
import Test.QuickCheck
import List (sort, nub)
-- to run these tests you must copy EventMask and its Enum instance here
-- and make it an instance of Ord, Eq and Show.
prop_ToFlagsFromFlags :: Int -> Property
prop_ToFlagsFromFlags n =
(n >= 1 && n <= 21)
==>
collect n $
let flag :: [EventMask]
flag = toFlags (2^n)
in 2^n == fromFlags flag
prop_FromFlagsToFlags :: [EventMask] -> Bool
prop_FromFlagsToFlags flags =
(nub . sort) flags == toFlags (fromFlags flags)
instance Arbitrary EventMask where
arbitrary = sized $ \_ -> do x <- choose (1,21 :: Int)
return (toEnum $ 2^x)
-}
|
