doldol (empty) → 0.4.1.0

raw patch · 17 files changed

+747/−0 lines, 17 filesdep +HUnitdep +QuickCheckdep +base

Dependencies added: HUnit, QuickCheck, base, doldol, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th

Files

.gitignore +22/−0
.vscode/settings.json +8/−0
ChangeLog.md +102/−0
LICENSE +30/−0
README.md +19/−0
doldol.cabal +64/−0
src/Data/Flag.hs +7/−0
src/Data/Flag/Internal.hs +13/−0
src/Data/Flag/Phantom.hs +58/−0
src/Data/Flag/Simple.hs +126/−0
test/.ghci +11/−0
test/Spec.hs +19/−0
test/Test.hs +20/−0
test/Test/Flag.hs +116/−0
test/Test/Flag/Env.hs +8/−0
test/Test/Flag/Phantom.hs +102/−0
test/Test/Visualize.hs +22/−0

+ .gitignore view

@@ -0,0 +1,22 @@+/.HTF/+/.stack-work+/.vscode+/bench+/examples+/.gitignore+/doldol.cabal+/stack.yaml+/stack.yaml.lock+*.o+*.hi+*.chi+*.chs.h+*.dyn_o+*.dyn_hi+.hpc+*.prof+*.aux+*.hp+*.eventlog+/test/Test.hs+/install.sh

+ .vscode/settings.json view

@@ -0,0 +1,8 @@+{+  "languageServerHaskell.useCustomHieWrapper": true,+  "languageServerHaskell.useCustomHieWrapperPath": "t:\\QJoon\\VSCode\\hie.bat",+  "cSpell.words": [+    "hunit",+    "newtype"+  ]+}

+ ChangeLog.md view

@@ -0,0 +1,102 @@+Changelog for doldol+====++## [Unreleased]++## [0.4.1.0] - 2019-07-21++### Added+* Re-enable `allReq`++### Changed+* Remove unnecessary constraint `NFData`++### Improved+* Improve and fix test codes++### Removed+* Remove unnecessary ghc-option for parallelism++## [0.4.0.0] - 2019-07-16++### Changed+* Change type of some types to handle `Foldable (Enum e)`++### Improved+* Automate test code with test-framework++## [0.3.0.1] - 2017-03-05++### Improved+* Uses pattern matching for `Data.Flag.Phantom`.++## [0.3.0.0] - 2017-03-03++### Changed+* Change type of `Flag` from `Int64` to `Word64` to use unsigned integer.++## [0.2.0.0] - 2017-03-02++### Removed+* Remove `allReq` becasue of `include`.++### Changed+* Change implementation of `include` as like as `allReq`.++## [0.1.5.0] - 2017-03-02++### Added+* Add `anyReq`, `allReq`.++### Fixed+* Fix: Remove wrong indents before CPP.++### Improved+* Relax `base` dependency to 4.8.++## [0.1.4.1] - 2017-02-28++### Added+* Add `NFData` class for `Data.Flag.Phantom`.++## [0.1.4.0] - 2017-01-27++### Added+* Implement `Data.Flag.Phantom`.++## [0.1.3.2] - 2017-01-27++### Improved+* Refactoring to implement `Data.Flag.Phantom`.++### Removed+* Remove not-using dependency.++## [0.1.3.0] - 2017-01-21++### Added+* Implement `eqAbout`, `includeAbout`, and `excludeAbout`.+* Define `Flag` as `Int64`.++## [0.1.2.0] - 2017-01-21++### Added+* Implement `readFlag` and `readEnum`.++## [0.1.1.0] - 2017-01-21++### Added+* Implement `showFlagFit` and `showFlagBy`.++## [0.1.0.0] - 2017-01-20++### Changed+* Changed Functions' name.++### Added+* Implement `decodeFlag` and `showFlag`.++## [0.0.0.0] - 2017-01-18++### Added+* A interface only for `List`.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, YongJoon Joe++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 name of YongJoon Joe nor the names of other+      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.

+ README.md view

@@ -0,0 +1,19 @@+doldol+====++doldol packs multiple flaggable data in a `Flag` value,+and checks its flags by cheap operators.++In the current version, doldol will handle `Enum e` in a list only.++# The name++`doldol` comes from Korean word **돌돌** which is a mimetic presenting *roll up fabrics or something like flags*.++# Gap analysis++## EnumSet++EnumSet is good library, but only works with List (ex. `toEnum`).+I also need List interface only. However, next version of my simulation project needs to support `Traversal` class. Therefore, I keep to develop this.+Of course, you can use EnumSet with `fromList` or etc., but when you consider performance seriously, let think one more time.

+ doldol.cabal view

@@ -0,0 +1,64 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 95b2ef45e98d851f82b0289b799a83f6b4f5b932966b4ead1ce5700d320f16da++name:           doldol+version:        0.4.1.0+synopsis:       Flag packer & handler for flaggable data+description:    Please see the README on GitHub at <https://github.com/QuietJoon/doldol#readme>+category:       Data+homepage:       https://github.com/QuietJoon/doldol/+bug-reports:    https://github.com/QuietJoon/doldol/issues+author:         YongJoon Joe+maintainer:     developer+doldol@quietjoon.net+copyright:      2017-2019 YongJoon Joe+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/QuietJoon/doldol++library+  exposed-modules:+      Data.Flag+      Data.Flag.Internal+      Data.Flag.Phantom+      Data.Flag.Simple+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+  default-language: Haskell2010++test-suite doldol-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test+      Test.Flag+      Test.Flag.Env+      Test.Flag.Phantom+      Test.Visualize+      Paths_doldol+  hs-source-dirs:+      test+  ghc-options: -rtsopts+  build-depends:+      HUnit+    , QuickCheck+    , base >=4.7+    , doldol+    , test-framework+    , test-framework-hunit+    , test-framework-quickcheck2+    , test-framework-th+  default-language: Haskell2010

+ src/Data/Flag.hs view

@@ -0,0 +1,7 @@+module Data.Flag+  ( module Flag+  ) where+++import Data.Flag.Internal as Flag+import Data.Flag.Simple as Flag

+ src/Data/Flag/Internal.hs view

@@ -0,0 +1,13 @@+module Data.Flag.Internal where+++import Data.Word+++type Flag = Word64+-- | Hard coded just for `Word64`. Should be improved+bitLen = 64++-- | Check `maxBound` of `Enum e` whether it have more than `bitLen` elements+isFlaggable :: (Bounded e, Enum e) => e -> Bool+isFlaggable x = fromEnum (maxBound `asTypeOf` x) < bitLen

+ src/Data/Flag/Phantom.hs view

@@ -0,0 +1,58 @@+{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving #-}++-- | `Data.Flag.Phantom` is for strict typing of Flag.+--+--   When you want to distinguish two Flag by its origination, use this module instead of `Data.Flag`(`Data.Flag.Simple`).+module Data.Flag.Phantom (+    module Data.Flag.Phantom+  , module Data.Flag.Internal+  ) where+++import Data.Flag.Internal+import qualified Data.Flag.Simple as SF+++newtype PhantomFlag t = PhFlag Flag deriving (Show, Eq, Ord)++-- | Take `Flag` from `PhantomFlag`+getFlag (PhFlag f) = f++encodeFlag :: (Foldable f, Bounded e, Enum e) => f e -> PhantomFlag t+encodeFlag = PhFlag . SF.encodeFlag++decodeFlag :: Enum e => PhantomFlag t -> [e]+decodeFlag = SF.decodeFlag . getFlag++showFlag :: PhantomFlag t -> String+showFlag (PhFlag f) = SF.showFlag f++showFlagFit :: (Bounded e, Enum e) => e -> PhantomFlag t -> String+showFlagFit a (PhFlag f) = SF.showFlagFit a f++showFlagBy :: Int -> PhantomFlag t -> String+showFlagBy l (PhFlag f) = SF.showFlagBy l f++readFlag :: String -> PhantomFlag t+readFlag = PhFlag . SF.readFlag++readEnum :: (Enum e) => String -> [e]+readEnum = SF.readEnum++include :: PhantomFlag t -> PhantomFlag t -> Bool+include (PhFlag f1) (PhFlag f2) = SF.include f1 f2+exclude :: PhantomFlag t -> PhantomFlag t -> Bool+exclude (PhFlag f1) (PhFlag f2) = SF.exclude f1 f2++about :: (Flag -> Flag -> b) -> PhantomFlag t -> PhantomFlag t -> PhantomFlag t -> b+about f (PhFlag fb) (PhFlag f1) (PhFlag f2)  = SF.about f fb f1 f2++eqAbout = about (==)++includeAbout = about SF.include+-- Should be tested that this really works properly!+excludeAbout = about SF.exclude++anyReq (PhFlag obj) (PhFlag req) = SF.anyReq obj req++allReq (PhFlag obj) (PhFlag req) = SF.allReq obj req

+ src/Data/Flag/Simple.hs view

@@ -0,0 +1,126 @@+{-# LANGUAGE MagicHash, BangPatterns #-}+{-# LANGUAGE CPP #-}++module Data.Flag.Simple+  ( module Data.Flag.Simple+  , module Flag+  ) where+++#ifdef DEBUG+import Control.Exception+#endif++import Data.Bits++import GHC.Base+++import Data.Flag.Internal as Flag++-- | Encode `Flag` from a given collection of `Enum` e+encodeFlag :: (Foldable f, Bounded e, Enum e) => f e -> Flag+encodeFlag = Prelude.foldr (\x b -> setBit b (fromEnum x)) zeroBits++-- | Decode `Flag` to a list of `Enum` e+decodeFlag :: Enum e => Flag -> [e]+decodeFlag aFlag = decodeFlagSub (bitLen# -# 1#)+  where+    !(I# bitLen#) = bitLen+    decodeFlagSub (-1#) = []+    decodeFlagSub  idx# =+      if testBit aFlag (I# idx#)+        then toEnum (I# idx#) : decodeFlagSub (idx# -# 1#)+        else                    decodeFlagSub (idx# -# 1#)++-- | Show `Flag` as a binary digit `String`+showFlag :: Flag -> String+showFlag aFlag = showFlagSub (bitLen#-#1#)+  where+    !(I# bitLen#) = bitLen+    showFlagSub (-1#) = ""+    showFlagSub  idx# =+      if testBit aFlag (I# idx#)+        then '1' : showFlagSub (idx#-#1#)+        else '0' : showFlagSub (idx#-#1#)++-- | Show `Flag` as a binary digit `String` with a minimum length+showFlagFit :: (Bounded e, Enum e) => e -> Flag -> String+showFlagFit a aFlag =+#ifdef DEBUG+    -- Assertion for `Flag` according to `a`. This is not needed for `showFlag`.+  assert (isFlaggable a) $+#endif+    showFlagSub bitLen#+  where+    !(I# bitLen#) = fromEnum (maxBound `asTypeOf` a)+    showFlagSub (-1#) = ""+    showFlagSub  idx# =+      if testBit aFlag (I# idx#)+        then '1' : showFlagSub (idx#-#1#)+        else '0' : showFlagSub (idx#-#1#)++-- | Show `Flag` as a binary digit `String` with a given length+showFlagBy :: Int -> Flag -> String+showFlagBy l@(I# bitLen#) aFlag =+#ifdef DEBUG+    -- Assertion for Flag. This is not needed for showFlag+  assert (l <= bitLen && l > 0) $+#endif+    showFlagSub (bitLen#-#1#)+  where+    showFlagSub (-1#) = ""+    showFlagSub  idx# =+      if testBit aFlag (I# idx#)+        then '1' : showFlagSub (idx#-#1#)+        else '0' : showFlagSub (idx#-#1#)++-- | Encode `Flag` from a given binary digit `String`+--+--   This allows any character which is not '0' or '1' as '1'+readFlag :: String -> Flag+readFlag aFlagString = readFlagSub aFlagString zeroBits+readFlagSub [] acc = acc+readFlagSub (x:xs) acc =+  if x == '0'+    then readFlagSub xs next+    else readFlagSub xs (setBit next 0)+  where+    next = shiftL acc 1++-- | Encode `Enum` e from a given binary digit `String`+readEnum :: (Enum e) => String -> [e]+readEnum = decodeFlag . readFlag++-- | Check whether `Flag` f1 covers every positive bit in `Flag` f2+--+--   This implementations implies that when f2 == `zeroBits` then the results of `include` is same as `exclude`+include :: Flag -> Flag -> Bool+include f1 f2 = (f1 .&. f2) == f2+-- | Check whether `Flag` f1 does not cover any positive bit in `Flag` f2+exclude :: Flag -> Flag -> Bool+exclude f1 f2 = (f1 .&. f2) == zeroBits++-- | Apply f with two latter `Flag` arguments under the first `Flag`+about :: (Flag -> Flag -> b) -> Flag -> Flag -> Flag -> b+about f fb f1 f2 = f (fb .&. f1) (fb .&. f2)++-- | Check whether two `Flag`s are same or not under the first `Flag`+--+--   `eqAbout` fb f1 f2 = (fb .&. f1) == (fb .&. f2)+eqAbout :: Flag -> Flag -> Flag -> Bool+eqAbout = about (==)++includeAbout = about include+-- Should be tested that this really works properly!+excludeAbout = about exclude++-- | Check any positive bit of req matches corresponding bit of obj+--+--   When req is `zerobits`, this returns `True`+anyReq :: Flag -> Flag -> Bool+anyReq obj req = (req == zeroBits) || (obj .&. req) /= zeroBits++-- | Check every positive bit of req matches corresponding bit of obj+allReq :: Flag -> Flag -> Bool+allReq obj req = (obj .&. req) == req

+ test/.ghci view

@@ -0,0 +1,11 @@+:set -XOverloadedStrings+:set -XCPP+:set -i.:../src++:set -package HUnit+:set -package QuickCheck+:set -package test-framework+:set -package test-framework-hunit+:set -package test-framework-quickcheck2++:load Test.hs

+ test/Spec.hs view

@@ -0,0 +1,19 @@+import qualified Test.Framework as Test+import qualified Test.Framework.Providers.HUnit as Test+import qualified Test.Framework.Providers.QuickCheck2 as Test+import Test.HUnit+import Test.QuickCheck++import Test.Flag+import Test.Flag.Env+import Test.Flag.Phantom++import Data.Flag+import Data.Word+++main =+  Test.defaultMain+    [ Test.Flag.tests+    , Test.Flag.Phantom.tests+    ]

+ test/Test.hs view

@@ -0,0 +1,20 @@+module Test where++import qualified Data.Flag as S+import qualified Data.Flag.Phantom as P++import Test.Flag.Env++{-+ef = S.encodeFlag+df = S.decodeFlag+sf = S.showFlag+sff = S.showFlagFit+sfb = S.showFlagBy+rf = S.readFlag+re = S.readEnum+ea = S.eqAbout+ia = S.includeAbout+xa = S.excludeAbout+ar = S.anyReq+-}

+ test/Test/Flag.hs view

@@ -0,0 +1,116 @@+{-# LANGUAGE TemplateHaskell #-}++module Test.Flag where+++import Data.Flag.Simple+import Data.Word++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.Framework.TH+import Test.HUnit.Base+import Test.QuickCheck++import Test.Flag.Env+++tests = $(testGroupGenerator)++test_showFlag =+  [ testCase "\"0000000000000000000000000000000000000000000000000000000001001001\" == showFlag  73" c_sF01+  , testCase "\"0000000000000000000000000000000000000000000000000000000001111101\" == showFlag 125" c_sF02+  , testCase "\"0000000000000000000000000000000000000000000000000000000011001011\" == showFlag 203" c_sF03+  , testCase "\"0000000000000000000000000000000000000000000000000000000011001111\" == showFlag 207" c_sF04+  , testCase "\"0000000000000000000000000000000000000000000000000000000101001001\" == showFlag 329" c_sF05+  ]++c_sF01 = "0000000000000000000000000000000000000000000000000000000001001001" @=? showFlag  73+c_sF02 = "0000000000000000000000000000000000000000000000000000000001111101" @=? showFlag 125+c_sF03 = "0000000000000000000000000000000000000000000000000000000011001011" @=? showFlag 203+c_sF04 = "0000000000000000000000000000000000000000000000000000000011001111" @=? showFlag 207+c_sF05 = "0000000000000000000000000000000000000000000000000000000101001001" @=? showFlag 329++test_eqAbout =+  [ testCase "eqAbout 125 203 329 == True" c_eA01+  , testCase "eqAbout 125 207 329 == False" c_eA02+  ]++c_eA01 = assertBool ""        (eqAbout 125 203 329)+c_eA02 = assertBool "" (not $ eqAbout 125 207 329)++-- To understand `readFlag` with any character which is not '0' or '1', read the document.+filterFlag = readFlag "0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0F"++test_includeAbout =+  [ testCase "includeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1110111011101110') == True" c_iA01+  , testCase "includeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1010101010101110') == True" c_iA02+  , testCase "includeAbout (Flag '0101010101010101') (Flag '1110111001000100') (Flag '1110111011101110') == True" c_iA03+  , testCase "includeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1110111011101111') == False" c_iA04+  , testCase "includeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1010101010101011') == False" c_iA05+  ]++c_iA01 = assertBool ""       (includeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_1_0_1_0_1_0_1_0"))+c_iA02 = assertBool ""       (includeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_1_0_0_0_0_0_1_0"))+c_iA03 = assertBool ""       (includeAbout filterFlag (readFlag "_1_0_1_001000100") (readFlag "_1_0_1_0_1_0_1_0"))+c_iA04 = assertBool "" (not $ includeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_1_0_1_0_1_0_1_1"))+c_iA05 = assertBool "" (not $ includeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_0_0_0_0_0_0_0_1"))++test_excludeAbout =+  [ testCase "excludeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1110111011101110') == True"  c_xA01+  , testCase "excludeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1010101010101110') == True"  c_xA02+  , testCase "excludeAbout (Flag '0101010101010101') (Flag '1110111001000100') (Flag '1110111011101110') == True"  c_xA03+  , testCase "excludeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1110111011101111') == False" c_xA04+  , testCase "excludeAbout (Flag '0101010101010101') (Flag '1110111011101110') (Flag '1010101010101011') == False" c_xA05+  ]++c_xA01 = assertBool ""       (excludeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_0_1_0_1_0_1_0_1"))+c_xA02 = assertBool ""       (excludeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_0_1_0_0_0_1_0_0"))+c_xA03 = assertBool ""       (excludeAbout filterFlag (readFlag "_1_0_1_001000100") (readFlag "_0_1_0_1_0_1_0_1"))+c_xA04 = assertBool "" (not $ excludeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_1_0_1_0_1_0_1_1"))+c_xA05 = assertBool ""       (excludeAbout filterFlag (readFlag "_1_0_1_0_1_0_1_0") (readFlag "_0_0_0_0_0_0_0_1"))++test_anyReq =+  [ testCase "anyReq (Flag '0000') (Flag '000') == True"  c_aR01+  , testCase "anyReq (Flag '0000') (Flag '001') == False" c_aR02+  , testCase "anyReq (Flag '0001') (Flag '001') == True"  c_aR03+  , testCase "anyReq (Flag '0001') (Flag '000') == True"  c_aR04+  , testCase "anyReq (Flag '0110') (Flag '001') == False" c_aR05+  , testCase "anyReq (Flag '0011') (Flag '001') == True"  c_aR06+  , testCase "anyReq (Flag '0011') (Flag '010') == True"  c_aR07+  , testCase "anyReq (Flag '0011') (Flag '100') == False" c_aR08+  , testCase "anyReq (Flag '0001') (Flag '101') == True"  c_aR09+  ]++c_aR01 = assertBool ""       (anyReq (readFlag "0000") (readFlag "000"))+c_aR02 = assertBool "" (not $ anyReq (readFlag "0000") (readFlag "001"))+c_aR03 = assertBool ""       (anyReq (readFlag "0001") (readFlag "001"))+c_aR04 = assertBool ""       (anyReq (readFlag "0001") (readFlag "000"))+c_aR05 = assertBool "" (not $ anyReq (readFlag "0110") (readFlag "001"))+c_aR06 = assertBool ""       (anyReq (readFlag "0011") (readFlag "001"))+c_aR07 = assertBool ""       (anyReq (readFlag "0011") (readFlag "010"))+c_aR08 = assertBool "" (not $ anyReq (readFlag "0011") (readFlag "100"))+c_aR09 = assertBool ""       (anyReq (readFlag "0001") (readFlag "101"))++test_allReq =+  [ testCase "allReq (Flag '0000') (Flag '000') == True"  c_AR01+  , testCase "allReq (Flag '0000') (Flag '001') == False" c_AR02+  , testCase "allReq (Flag '0001') (Flag '001') == True"  c_AR03+  , testCase "allReq (Flag '0001') (Flag '000') == True"  c_AR04+  , testCase "allReq (Flag '0110') (Flag '001') == False" c_AR05+  , testCase "allReq (Flag '0011') (Flag '001') == True"  c_AR06+  , testCase "allReq (Flag '0011') (Flag '010') == True"  c_AR07+  , testCase "allReq (Flag '0011') (Flag '100') == False" c_AR08+  , testCase "allReq (Flag '0101') (Flag '101') == True"  c_AR09+  ]++c_AR01 = assertBool ""       (allReq (readFlag "0000") (readFlag "000"))+c_AR02 = assertBool "" (not $ allReq (readFlag "0000") (readFlag "001"))+c_AR03 = assertBool ""       (allReq (readFlag "0001") (readFlag "001"))+c_AR04 = assertBool ""       (allReq (readFlag "0001") (readFlag "000"))+c_AR05 = assertBool "" (not $ allReq (readFlag "0110") (readFlag "001"))+c_AR06 = assertBool ""       (allReq (readFlag "0011") (readFlag "001"))+c_AR07 = assertBool ""       (allReq (readFlag "0011") (readFlag "010"))+c_AR08 = assertBool "" (not $ allReq (readFlag "0011") (readFlag "100"))+c_AR09 = assertBool ""       (allReq (readFlag "0101") (readFlag "101"))+c_AR10 = assertBool "" (not $ allReq (readFlag "0101") (readFlag "111"))

+ test/Test/Flag/Env.hs view

@@ -0,0 +1,8 @@+module Test.Flag.Env where+++data A = A | B | C deriving (Show,Enum,Bounded)+data X = X0 | X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8 | X9 | X10 | X11 | X12 | X13 | X14 | X15 | X16 | X17 | X18 | X19 | X20 | X21 | X22 | X23 | X24 | X25 | X26 | X27 | X28 | X29 | X30 | X31 | X32 | X33 | X34 | X35 | X36 | X37 | X38 | X39 | X40 | X41 | X42 | X43 | X44 | X45 | X46 | X47 | X48 | X49 | X50 | X51 | X52 | X53 | X54 | X55 | X56 | X57 | X58 | X59 | X60 | X61 | X62 | X63 | X64 deriving (Show,Enum,Bounded)+data Y =      Y1 | Y2 | Y3 | Y4 | Y5 | Y6 | Y7 | Y8 | Y9 | Y10 | Y11 | Y12 | Y13 | Y14 | Y15 | Y16 | Y17 | Y18 | Y19 | Y20 | Y21 | Y22 | Y23 | Y24 | Y25 | Y26 | Y27 | Y28 | Y29 | Y30 | Y31 | Y32 | Y33 | Y34 | Y35 | Y36 | Y37 | Y38 | Y39 | Y40 | Y41 | Y42 | Y43 | Y44 | Y45 | Y46 | Y47 | Y48 | Y49 | Y50 | Y51 | Y52 | Y53 | Y54 | Y55 | Y56 | Y57 | Y58 | Y59 | Y60 | Y61 | Y62 | Y63 | Y64 deriving (Show,Enum,Bounded)+data P = P0 | P01 | P02 | P03 | P04 | P05 | P06 | P07 | P08 | P09 | P10 | P11 | P12 | P13 | P14 | P15 | P16 | P17 | P18 | P19 | P20 | P21 | P22 | P23 | P24 | P25 | P26 | P27 | P28 | P29 | P30 | P31 | P32 | P33 | P34 | P35 | P36 | P37 | P38 | P39 | P40 | P41 | P42 | P43 | P44 | P45 | P46 | P47 | P48 | P49 | P50 | P51 | P52 | P53 | P54 | P55 | P56 | P57 | P58 | P59 | P60 | P61 | P62 | P63 | P64 deriving (Show,Enum,Bounded)+data Q =      Q01 | Q02 | Q03 | Q04 | Q05 | Q06 | Q07 | Q08 | Q09 | Q10 | Q11 | Q12 | Q13 | Q14 | Q15 | Q16 | Q17 | Q18 | Q19 | Q20 | Q21 | Q22 | Q23 | Q24 | Q25 | Q26 | Q27 | Q28 | Q29 | Q30 | Q31 | Q32 | Q33 | Q34 | Q35 | Q36 | Q37 | Q38 | Q39 | Q40 | Q41 | Q42 | Q43 | Q44 | Q45 | Q46 | Q47 | Q48 | Q49 | Q50 | Q51 | Q52 | Q53 | Q54 | Q55 | Q56 | Q57 | Q58 | Q59 | Q60 | Q61 | Q62 | Q63 | Q64 deriving (Show,Enum,Bounded)

+ test/Test/Flag/Phantom.hs view

@@ -0,0 +1,102 @@+{-# LANGUAGE TemplateHaskell #-}++module Test.Flag.Phantom where+++import Data.Flag.Phantom+import Data.Word++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.Framework.TH+import Test.HUnit.Base+import Test.QuickCheck++import Test.Flag.Env+++tests = $(testGroupGenerator)++test_isFlaggable =+  [ testCase "isFlaggable A  == True"  c_if01+  , testCase "isFlaggable X0 == False" c_if02+  , testCase "isFlaggable Y1 == True"  c_if03+  ]++c_if01 = assertBool "" (isFlaggable $ A)+c_if02 = assertBool "" (not . isFlaggable $ X0)+c_if03 = assertBool "" (isFlaggable $ Y1)++test_encDec =+  [ testProperty "(getFlag . encodeFlag . (decodeFlag :: PhantomFlag X -> [X]) . PhFlag) i == i" p_ged01+  , testProperty "(getFlag . encodeFlag . (decodeFlag :: PhantomFlag Y -> [Y]) . PhFlag) i == i" p_ged02+  ]++p_ged01 i = (getFlag . encodeFlag . (decodeFlag :: PhantomFlag X -> [X]) . PhFlag) i == i+  where types = (i :: Flag)+p_ged02 i = (getFlag . encodeFlag . (decodeFlag :: PhantomFlag Y -> [Y]) . PhFlag) i == i+  where types = (i :: Flag)++test_readShow =+  [ testProperty "(getFlag . readFlag . showFlag . PhFlag) i == i" p_rs01+  --, testProperty "(getFlag . readFlag . showFlagBy 16 . PhFlag) i == i" p_rs02+  , testProperty "(getFlag . readFlag . showFlagFit X0 . PhFlag) i == i" p_rs03+  , testProperty "(getFlag . readFlag . showFlagFit Y1 . PhFlag) i == i" p_rs04+  ]++p_rs01 i = (getFlag . readFlag . showFlag . PhFlag) i == i+  where types = (i :: Flag)+-- NOTE: This test should fail because input is not limited by -2^15~2^15-1+p_rs02 i = (getFlag . readFlag . showFlagBy 16 . PhFlag) i == i+  where types = (i :: Flag)+-- NOTE: This should not fail at test but assertion because input is limited in Flag representation+p_rs03 i = (getFlag . readFlag . showFlagFit X0 . PhFlag) i == i+  where types = (i :: Flag)+p_rs04 i = (getFlag . readFlag . showFlagFit Y1 . PhFlag) i == i+  where types = (i :: Flag)++test_showFlagBy =+  [ testCase "showFlagBy  0 (PhFlag 1) == \"\"" c_sFB01+  , testCase "showFlagBy  1 (PhFlag 1) == \"1\"" c_sFB02+  , testCase "showFlagBy  9 (PhFlag 1) == \"000000001\"" c_sFB03+  , testCase "showFlagBy 10 (PhFlag 1) == \"0000000001\"" c_sFB04+  , testCase "showFlagBy  1 (PhFlag 2) == \"0\"" c_sFB05+  , testCase "showFlagBy  2 (PhFlag 2) == \"10\"" c_sFB06+  , testCase "showFlagBy 10 (PhFlag 2) == \"0000000010\"" c_sFB07+  ]++c_sFB01 = showFlagBy  0 (PhFlag 1) @?= ""+c_sFB02 = showFlagBy  1 (PhFlag 1) @?= "1"+c_sFB03 = showFlagBy  9 (PhFlag 1) @?= "000000001"+c_sFB04 = showFlagBy 10 (PhFlag 1) @?= "0000000001"+c_sFB05 = showFlagBy  1 (PhFlag 2) @?= "0"+c_sFB06 = showFlagBy  2 (PhFlag 2) @?= "10"+c_sFB07 = showFlagBy 10 (PhFlag 2) @?= "0000000010"++test_encodeFlag =+  [ testCase "encodeFlag [X0,X1] == PhFlag 3" c_eF01+  ]++c_eF01 = PhFlag 3 @=? encodeFlag [X0,X1]++{-+  Can't test because of type error++_test_equal =+  [ testCase "x1 /= x2" c_eq01+  , testCase "x1 == y1" c_eq02+  ]++c_eq01 = x1 @?= x2+c_eq02 = x1 @?= y1++_test_include =+  [ testCase "include x1 y1" c_incl01+  , testCase "include x1 x2" c_incl02+  ]++c_incl01 = assertBool "" (include x1 y1)+c_incl02 = assertBool "" (include x1 x2)+-}+

+ test/Test/Visualize.hs view

@@ -0,0 +1,22 @@+module Test.Visualize where+++import Data.Flag+import Data.Word+++a = ["00","01","10","11"]+b = [(x,y) | x <- a, y <- a]+c f = map (\(x,y) -> (x,y,f (readFlag x) (readFlag y))) b++d = [0..255] :: [Word64]+e = [(x,y) | x <- d, y <- d]+g f = map (\(x,y) -> (x,y,f x y)) e++prints :: (Show a) => [a] -> IO ()+prints = mapM_ print+++main = do+  prints $ c include+  prints $ g include