-- -*-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 :: forall a. Flags a => [a] -> Int
fromFlags [a]
is = Int -> [a] -> Int
forall {a}. Enum a => Int -> [a] -> Int
orNum Int
0 [a]
is
  where orNum :: Int -> [a] -> Int
orNum Int
n []     = Int
n
        orNum Int
n (a
i:[a]
is) = Int -> [a] -> Int
orNum (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. a -> Int
forall a. Enum a => a -> Int
fromEnum a
i) [a]
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 :: forall a. Flags a => Int -> [a]
toFlags Int
n = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [ if Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. a -> Int
forall a. Enum a => a -> Int
fromEnum a
flag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Int
forall a. Enum a => a -> Int
fromEnum a
flag
                           then a -> Maybe a
forall a. a -> Maybe a
Just a
flag
                           else Maybe a
forall a. Maybe a
Nothing
                      | a
flag <- [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
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)
-}