data-sword 0.1 → 0.1.1

raw patch · 3 files changed

+63/−16 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• data-sword.cabal +1/−1
• src/Data/ShortWord.hs +5/−6
• src/Data/ShortWord/TH.hs +57/−9

@@ -1,5 +1,5 @@ Name: data-sword-Version: 0.1+Version: 0.1.1 Category: Data Stability: experimental Synopsis: Shorter binary words

@@ -18,13 +18,12 @@   , Int48   ) where -import Data.Typeable import Data.Word import Data.BinaryWord import Data.ShortWord.TH -mkShortWord "Word2" "Word2" "Int2" "Int2" ''Word8 2 [''Typeable]-mkShortWord "Word4" "Word4" "Int4" "Int4" ''Word8 4 [''Typeable]-mkShortWord "Word7" "Word7" "Int7" "Int7" ''Word8 7 [''Typeable]-mkShortWord "Word24" "Word24" "Int24" "Int24" ''Word32 24 [''Typeable]-mkShortWord "Word48" "Word48" "Int48" "Int48" ''Word64 48 [''Typeable]+mkShortWord "Word2" "Word2" "Int2" "Int2" ''Word8 2 []+mkShortWord "Word4" "Word4" "Int4" "Int4" ''Word8 4 []+mkShortWord "Word7" "Word7" "Int7" "Int7" ''Word8 7 []+mkShortWord "Word24" "Word24" "Int24" "Int24" ''Word32 24 []+mkShortWord "Word48" "Word48" "Int48" "Int48" ''Word64 48 []

@@ -9,6 +9,7 @@  import GHC.Arr (Ix(..)) import GHC.Enum (succError, predError, toEnumError)+import Data.Data import Data.Ratio ((%)) import Data.Bits (Bits(..)) #if MIN_VERSION_base(4,7,0)@@ -19,13 +20,16 @@ #else import Data.Hashable (Hashable(..), combine) #endif+import Data.Char (toLower)+import Data.List (union) import Control.Applicative ((<$>), (<*>))-import Language.Haskell.TH hiding (match)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax (Module(..), ModName(..)) import Data.BinaryWord (BinaryWord(..))  -- | Declare signed and unsigned binary word types that use a subset --   of the bits of the specified underlying type. For each data type---   the following instances are declared: 'Eq', 'Ord',+--   the following instances are declared: 'Typeable', 'Data', 'Eq', 'Ord', --   'Bounded', 'Enum', 'Num', 'Real', 'Integral', 'Show', 'Read', --   'Hashable', 'Ix', 'Bits', 'BinaryWord'. mkShortWord ∷ String -- ^ Unsigned variant type name@@ -51,22 +55,21 @@              → Int              → [Name]              → Q [Dec]-mkShortWord' signed tp cn otp ocn utp bl ad = return $+mkShortWord' signed tp cn otp ocn utp bl ad = returnDecls $     [ NewtypeD [] tp [] #if MIN_VERSION_template_haskell(2,11,0)                Nothing                (NormalC cn [(Bang NoSourceUnpackedness                                   NoSourceStrictness,                              uT)])-               (ConT <$> ad) #else                (NormalC cn [(NotStrict, uT)])-# if MIN_VERSION_template_haskell(2,10,0)-               (ConT <$> ad)-# else-               ad-# endif #endif+#if MIN_VERSION_template_haskell(2,10,0)+               (ConT <$> union [''Typeable] ad)+#else+               (union [''Typeable] ad)+#endif     , inst ''Eq [tp] $         {- (W x) == (W y) = x == y -}         [ funUn2 '(==) $ appVN '(==) [x, y]@@ -589,6 +592,7 @@       FunD n [Clause [TupP [VarP x, VarP y], VarP z] (NormalB e) []]     funTupLZ n e   =       FunD n [Clause [TupP [VarP x, WildP], VarP z] (NormalB e) []]+    fun_ZC n e     = FunD n [Clause [WildP, VarP z, VarP c] (NormalB e) []]     inline n = PragmaD $ InlineP n Inline FunLike AllPhases     inlinable n = PragmaD $ InlineP n Inlinable FunLike AllPhases     rule n m e = PragmaD $ RuleP n [] m e AllPhases@@ -615,3 +619,47 @@                       [SigE (VarE 'undefined) uT]                , sizeE ]     maskE = appV 'shiftL [VarE 'allOnes, shiftE]+    returnDecls ds = do+      Module _ (ModName modName) ← thisModule+      let typeVar = mkName $ uncapitalize (show tp) ++ "Type"+            where uncapitalize (h : t) = toLower h : t+                  uncapitalize []      = []+          fullName = modName ++ "." ++ show tp+      return $ (ds ++) $+        {- TYPEType ∷ DataType -}+        [ SigD typeVar (ConT ''DataType)+        {- TYPEType = mkIntType TYPE -}+        , fun typeVar $ appV 'mkIntType [litS fullName]+        , inst ''Data [tp] $+            {- toConstr = mkIntegralConstr TYPE -}+            [ fun 'toConstr $ appVN 'mkIntegralConstr [typeVar]+            {-+               gunfold _ z c = case constRep c of+                                 IntConstr x → z (fromIntegral x)+                                 _ → error $ "Data.Data.gunfold: Constructor" +++                                             show c ++ " is not of type " +++                                             fullName+            -}+            , fun_ZC 'gunfold $ CaseE (appVN 'constrRep [c]) $+                [ Match (ConP 'IntConstr [VarP x])+                        (NormalB $ appV z [appVN 'fromIntegral [x]])+                        []+                , Match WildP+                        (NormalB $+                           appV 'error+                                [appV '(++)+                                      [ litS "Data.Data.gunfold: Constructor"+                                      , appV '(++)+                                             [ appVN 'show [c]+                                             , appV '(++)+                                                    [ litS " is not of type "+                                                    , litS fullName ]+                                             ]+                                      ]+                                ])+                        []+                ]+            {- dataTypeOf _ = TYPEType -}+            , fun_ 'dataTypeOf $ VarE typeVar+            ]+        ]