packages feed

data-flags (empty) → 0.0.1

raw patch · 5 files changed

+234/−0 lines, 5 filesdep +basedep +template-haskellsetup-changed

Dependencies added: base, template-haskell

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010, Mikhail Vorozhtsov+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice, +  this list of conditions and the following disclaimer.+- Redistributions in binary form must reproduce the above copyright +  notice, this list of conditions and the following disclaimer in the +  documentation and/or other materials provided with the distribution.+- Neither the names of the copyright owners nor the names of the +  contributors may be used to endorse or promote products derived +  from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ data-flags.cabal view
@@ -0,0 +1,27 @@+Name: data-flags+Version: 0.0.1+Category: Data+Stability: experimental+Synopsis: A package for working with bit masks and flags in general.+Description:+  This package provides type classes for flags and corresponding instances+  for standard numeric types viewed as bit masks.++Author: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Maintainer: Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+Copyright: 2010 Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>+License: BSD3+License-File: LICENSE++Cabal-Version: >= 1.6.0+Build-Type: Simple++Library+  Build-Depends: base == 4.*, template-haskell+  Extensions: TemplateHaskell+  Hs-Source-Dirs: src+  GHC-Options: -Wall+  Exposed-Modules:+    Data.Flags+    Data.Flags.TH+
+ src/Data/Flags.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE TemplateHaskell #-}++-- | This module provides type classes for working with sets of flags.+--   In particular, with wrappers around bit masks:+--+-- > import Data.Flags+-- >+-- > newtype MyFlags = MyFlags CInt deriving (Eq, Flags)+-- >+-- > #{enum MyFlags, MyFlags+-- >  , myFlag1 = C_FLAG1+-- >  , myFlag2 = C_FLAG2+-- >  , myFlag3 = C_FLAG3+-- >  }+-- >+-- > f :: MyFlags -> IO ()+-- > f = ...+--+--   And then use it like this:+--+-- > f $ myFlag1 .+. myFlag3+module Data.Flags (+    Flags(..),+    (.+.), (.-.), (.*.),++    BoundedFlags(..),+    allBut,++    containsAll, (.<=.), (.>=.),+    containsSome, (.~.),+    containsNone, (./~.),+  ) where++import Data.Bits ()+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Foreign.Ptr (IntPtr, WordPtr)+import Foreign.C.Types (CChar, CSChar, CUChar, CShort, CUShort, CInt, CUInt,+                        CLong, CULong, CLLong, CULLong)++import Data.Flags.TH++infixl 8 .<=., .>=., `containsAll`, .~., `containsSome`, ./~., `containsNone`+infixl 7 .-., `butFlags`+infixl 6 .+., `andFlags`+infixl 5 .*., `commonFlags`++class Eq a => Flags a where+  -- | The empty set of flags.+  noFlags :: a+  -- | Union of two flag sets.+  andFlags :: a -> a -> a+  -- | Difference between two flag sets.+  butFlags :: a -> a -> a+  -- | Intersection of two flag sets.+  commonFlags :: a -> a -> a+  f1 `commonFlags` f2 = (f1 .+. f2) .-. (f1 .-. f2) .-. (f2 .-. f1)++-- | Alias for 'andFlags'.+(.+.) :: Flags a => a -> a -> a+(.+.) = andFlags++-- | Alias for 'butFlags'.+(.-.) :: Flags a => a -> a -> a+(.-.) = butFlags++-- | Alias for 'commonFlags'.+(.*.) :: Flags a => a -> a -> a+(.*.) = commonFlags++-- | Use this class when the set of flags is fixed and not likely+--   to change in the future.+class Flags a => BoundedFlags a where+  -- | Set of all flags.+  allFlags :: a+  -- | List the individual flags.+  enumFlags :: a -> [a]++-- | Shorthand for 'allFlags' '.-.' /x/.+allBut :: BoundedFlags a => a -> a+allBut = (allFlags .-.)++-- | Test if the first flag set contains all flags from the second.+containsAll :: Flags a => a -> a -> Bool+containsAll flags subflags = flags .*. subflags == subflags++-- | Alias for 'containsAll'.+(.>=.) :: Flags a => a -> a -> Bool+(.>=.) = containsAll++-- | Shorthand for 'flip' 'containsAll'.+(.<=.) :: Flags a => a -> a -> Bool+(.<=.) = flip containsAll++-- | Test if two flag sets intersect.+containsSome :: Flags a => a -> a -> Bool+containsSome flags subflags = flags .*. subflags /= noFlags++-- | Alias for 'containsSome'.+(.~.) :: Flags a => a -> a -> Bool+(.~.) = containsSome++-- | Test if two flag sets do not intersect.+containsNone :: Flags a => a -> a -> Bool+containsNone flags subflags = flags .*. subflags == noFlags++-- | Alias for 'containsNone'.+(./~.) :: Flags a => a -> a -> Bool+(./~.) = containsNone++$(dataBitsAsFlags ''Integer)+$(dataBitsAsBoundedFlags ''Int)+$(dataBitsAsBoundedFlags ''Int8)+$(dataBitsAsBoundedFlags ''Int16)+$(dataBitsAsBoundedFlags ''Int32)+$(dataBitsAsBoundedFlags ''Int64)+$(dataBitsAsBoundedFlags ''Word)+$(dataBitsAsBoundedFlags ''Word8)+$(dataBitsAsBoundedFlags ''Word16)+$(dataBitsAsBoundedFlags ''Word32)+$(dataBitsAsBoundedFlags ''Word64)+$(dataBitsAsBoundedFlags ''IntPtr)+$(dataBitsAsBoundedFlags ''WordPtr)+$(dataBitsAsBoundedFlags ''CChar)+$(dataBitsAsBoundedFlags ''CSChar)+$(dataBitsAsBoundedFlags ''CUChar)+$(dataBitsAsBoundedFlags ''CShort)+$(dataBitsAsBoundedFlags ''CUShort)+$(dataBitsAsBoundedFlags ''CInt)+$(dataBitsAsBoundedFlags ''CUInt)+$(dataBitsAsBoundedFlags ''CLong)+$(dataBitsAsBoundedFlags ''CULong)+$(dataBitsAsBoundedFlags ''CLLong)+$(dataBitsAsBoundedFlags ''CULLong)+
+ src/Data/Flags/TH.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Template Haskell utils for declaring flags instances.+module Data.Flags.TH (+    dataBitsAsFlags,+    dataBitsAsBoundedFlags+  ) where++import Language.Haskell.TH++import Data.Bits (Bits(..))+import Control.Applicative ((<$>))++inst :: String -> Name -> [Dec] -> Dec+inst name typeName = InstanceD [] (AppT (ConT $ mkName name) (ConT typeName))++fun :: String -> Exp -> Dec+fun name expr = FunD (mkName name) [Clause [] (NormalB expr) []]++-- | Produces a 'Data.Flags.Flags' instance declaration for the specified+--   instance of 'Data.Bits.Bits'.+dataBitsAsFlags :: Name -> Q [Dec]+dataBitsAsFlags typeName = do+  noneE <- [| fromInteger 0 |]+  unionE <- [| (.|.) |]+  intersectionE <- [| (.&.) |] +  differenceE <- [| \x -> \y -> x .&. (complement y) |]+  return [inst "Flags" typeName+            [fun "noFlags" noneE,+             fun "andFlags" unionE,+             fun "commonFlags" intersectionE,+             fun "butFlags" differenceE]]++-- | Produces 'Data.Flags.Flags' and 'Data.Flags.BoundedFlags' instances+--   declarations for the specified instance of 'Data.Bits.Bits'.+dataBitsAsBoundedFlags :: Name -> Q [Dec]+dataBitsAsBoundedFlags typeName = do+  allE <- [| fromInteger (-1) |]+  enumE <- [| \x -> map (setBit 0) $ filter (testBit x) [0 .. bitSize x - 1] |]+  (++ [inst "BoundedFlags" typeName+         [fun "allFlags" allE,+          fun "enumFlags" enumE]]) <$> dataBitsAsFlags typeName+