diff --git a/generic-accessors.cabal b/generic-accessors.cabal --- a/generic-accessors.cabal +++ b/generic-accessors.cabal @@ -1,5 +1,5 @@ name: generic-accessors -version: 0.6.2.0 +version: 0.7.0.0 synopsis: stringly-named getters for generic data license: BSD3 license-file: LICENSE diff --git a/src/Accessors/Accessors.hs b/src/Accessors/Accessors.hs --- a/src/Accessors/Accessors.hs +++ b/src/Accessors/Accessors.hs @@ -27,6 +27,8 @@ import GHC.Generics +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) import Control.Lens ( Lens', Prism', (^.), (.~), preview, prism, withPrism ) import Data.List ( intercalate ) import Text.Printf ( printf ) @@ -51,7 +53,14 @@ data GAField a = FieldDouble (Lens' a Double) | FieldFloat (Lens' a Float) - | FieldInt (Lens' a Int) + | FieldInt8 (Lens' a Int8) + | FieldInt16 (Lens' a Int16) + | FieldInt32 (Lens' a Int32) + | FieldInt64 (Lens' a Int64) + | FieldWord8 (Lens' a Word8) + | FieldWord16 (Lens' a Word16) + | FieldWord32 (Lens' a Word32) + | FieldWord64 (Lens' a Word64) | FieldString (Lens' a String) | FieldSorry -- ^ a field which is not yet supported @@ -85,23 +94,44 @@ -- | Return the type of field, such as "Bool", "Double", "String", etc. describeGAField :: GAField a -> String describeGAField (FieldDouble _) = "Double" -describeGAField (FieldFloat _) = "Float" -describeGAField (FieldInt _) = "Int" +describeGAField (FieldFloat _) = "Float" +describeGAField (FieldInt8 _) = "Int8" +describeGAField (FieldInt16 _) = "Int16" +describeGAField (FieldInt32 _) = "Int32" +describeGAField (FieldInt64 _) = "Int64" +describeGAField (FieldWord8 _) = "Word8" +describeGAField (FieldWord16 _) = "Word16" +describeGAField (FieldWord32 _) = "Word32" +describeGAField (FieldWord64 _) = "Word64" describeGAField (FieldString _) = "String" -describeGAField FieldSorry = "Sorry" +describeGAField FieldSorry = "Sorry" -- | Returns True if the __type__ of fields is the same. sameFieldType :: GAField a -> GAField b -> Bool sameFieldType (FieldDouble _) (FieldDouble _) = True -sameFieldType (FieldFloat _) (FieldFloat _) = True -sameFieldType (FieldInt _) (FieldInt _) = True +sameFieldType (FieldFloat _) (FieldFloat _) = True +sameFieldType (FieldInt8 _) (FieldInt8 _) = True +sameFieldType (FieldInt16 _) (FieldInt16 _) = True +sameFieldType (FieldInt32 _) (FieldInt32 _) = True +sameFieldType (FieldInt64 _) (FieldInt64 _) = True +sameFieldType (FieldWord8 _) (FieldWord8 _) = True +sameFieldType (FieldWord16 _) (FieldWord16 _) = True +sameFieldType (FieldWord32 _) (FieldWord32 _) = True +sameFieldType (FieldWord64 _) (FieldWord64 _) = True sameFieldType (FieldString _) (FieldString _) = True -sameFieldType FieldSorry FieldSorry = True -sameFieldType (FieldDouble _) _ = False -sameFieldType (FieldFloat _) _ = False -sameFieldType (FieldInt _) _ = False -sameFieldType (FieldString _) _ = False -sameFieldType FieldSorry _ = False +sameFieldType FieldSorry FieldSorry = True +sameFieldType (FieldDouble _) _ = False +sameFieldType (FieldFloat _) _ = False +sameFieldType (FieldInt8 _) _ = False +sameFieldType (FieldInt16 _) _ = False +sameFieldType (FieldInt32 _) _ = False +sameFieldType (FieldInt64 _) _ = False +sameFieldType (FieldWord8 _) _ = False +sameFieldType (FieldWord16 _) _ = False +sameFieldType (FieldWord32 _) _ = False +sameFieldType (FieldWord64 _) _ = False +sameFieldType (FieldString _) _ = False +sameFieldType FieldSorry _ = False accessors :: Lookup a => AccessorTree a accessors = toAccessorTree id @@ -335,7 +365,14 @@ cs = zipWith (showRecordField show' x spaces) trees ("{ " : repeat ", ") showFieldVal :: GAField a -> (Double -> String) -> a -> String -showFieldVal (FieldInt lens) _ x = show (x ^. lens) +showFieldVal (FieldInt8 lens) _ x = show (x ^. lens) +showFieldVal (FieldInt16 lens) _ x = show (x ^. lens) +showFieldVal (FieldInt32 lens) _ x = show (x ^. lens) +showFieldVal (FieldInt64 lens) _ x = show (x ^. lens) +showFieldVal (FieldWord8 lens) _ x = show (x ^. lens) +showFieldVal (FieldWord16 lens) _ x = show (x ^. lens) +showFieldVal (FieldWord32 lens) _ x = show (x ^. lens) +showFieldVal (FieldWord64 lens) _ x = show (x ^. lens) showFieldVal (FieldDouble lens) show' x = show' (x ^. lens) showFieldVal (FieldFloat lens) show' x = show' (realToFrac (x ^. lens)) showFieldVal (FieldString lens) _ x = x ^. lens diff --git a/src/Accessors/Dynamic.hs b/src/Accessors/Dynamic.hs --- a/src/Accessors/Dynamic.hs +++ b/src/Accessors/Dynamic.hs @@ -14,6 +14,8 @@ import GHC.Generics import Data.Binary ( Binary ) +import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) import Data.Serialize ( Serialize ) import Data.Data ( Data ) import Data.Either ( partitionEithers ) @@ -47,7 +49,14 @@ data DField = DDouble Double | DFloat Float - | DInt Int + | DInt8 Int8 + | DInt16 Int16 + | DInt32 Int32 + | DInt64 Int64 + | DWord8 Word8 + | DWord16 Word16 + | DWord32 Word32 + | DWord64 Word64 | DString String | DSorry deriving (Generic, Show, Eq, Ord, Data, Typeable) @@ -93,22 +102,43 @@ -- | Returns True if the __type__ of fields is the same. sameDFieldType :: DField -> DField -> Bool sameDFieldType (DDouble _) (DDouble _) = True -sameDFieldType (DFloat _) (DFloat _) = True -sameDFieldType (DInt _) (DInt _) = True +sameDFieldType (DFloat _) (DFloat _) = True +sameDFieldType (DInt8 _) (DInt8 _) = True +sameDFieldType (DInt16 _) (DInt16 _) = True +sameDFieldType (DInt32 _) (DInt32 _) = True +sameDFieldType (DInt64 _) (DInt64 _) = True +sameDFieldType (DWord8 _) (DWord8 _) = True +sameDFieldType (DWord16 _) (DWord16 _) = True +sameDFieldType (DWord32 _) (DWord32 _) = True +sameDFieldType (DWord64 _) (DWord64 _) = True sameDFieldType (DString _) (DString _) = True -sameDFieldType DSorry DSorry = True -sameDFieldType (DDouble _) _ = False -sameDFieldType (DFloat _) _ = False -sameDFieldType (DInt _) _ = False -sameDFieldType (DString _) _ = False -sameDFieldType DSorry _ = False +sameDFieldType DSorry DSorry = True +sameDFieldType (DDouble _) _ = False +sameDFieldType (DFloat _) _ = False +sameDFieldType (DInt8 _) _ = False +sameDFieldType (DInt16 _) _ = False +sameDFieldType (DInt32 _) _ = False +sameDFieldType (DInt64 _) _ = False +sameDFieldType (DWord8 _) _ = False +sameDFieldType (DWord16 _) _ = False +sameDFieldType (DWord32 _) _ = False +sameDFieldType (DWord64 _) _ = False +sameDFieldType (DString _) _ = False +sameDFieldType DSorry _ = False describeDField :: DField -> String -describeDField (DInt _) = "Int" +describeDField (DInt8 _) = "Int8" +describeDField (DInt16 _) = "Int16" +describeDField (DInt32 _) = "Int32" +describeDField (DInt64 _) = "Int64" +describeDField (DWord8 _) = "Word8" +describeDField (DWord16 _) = "Word16" +describeDField (DWord32 _) = "Word32" +describeDField (DWord64 _) = "Word64" describeDField (DDouble _) = "Double" -describeDField (DFloat _) = "Float" +describeDField (DFloat _) = "Float" describeDField (DString _) = "String" -describeDField DSorry = "Sorry" +describeDField DSorry = "Sorry" -- | convert to a dynamic value toDData :: forall a . Lookup a => a -> DTree @@ -127,11 +157,18 @@ DConstructor cname $ map (\(n, f) -> (n, toDData' f)) fields toDField :: GAField a -> DField - toDField (FieldInt f) = DInt (x ^. f) toDField (FieldDouble f) = DDouble (x ^. f) - toDField (FieldFloat f) = DFloat (x ^. f) + toDField (FieldFloat f) = DFloat (x ^. f) + toDField (FieldInt8 f) = DInt8 (x ^. f) + toDField (FieldInt16 f) = DInt16 (x ^. f) + toDField (FieldInt32 f) = DInt32 (x ^. f) + toDField (FieldInt64 f) = DInt64 (x ^. f) + toDField (FieldWord8 f) = DWord8 (x ^. f) + toDField (FieldWord16 f) = DWord16 (x ^. f) + toDField (FieldWord32 f) = DWord32 (x ^. f) + toDField (FieldWord64 f) = DWord64 (x ^. f) toDField (FieldString f) = DString (x ^. f) - toDField FieldSorry = DSorry + toDField FieldSorry = DSorry -- | Update something using a dynamic representation @@ -208,14 +245,28 @@ updateField :: a -> GAField a -> DField -> Either String a updateField x0 (FieldDouble f) (DDouble x) = Right $ (f .~ x) x0 -updateField x0 (FieldFloat f) (DFloat x) = Right $ (f .~ x) x0 -updateField x0 (FieldInt f) (DInt x) = Right $ (f .~ x) x0 +updateField x0 (FieldFloat f) (DFloat x) = Right $ (f .~ x) x0 +updateField x0 (FieldInt8 f) (DInt8 x) = Right $ (f .~ x) x0 +updateField x0 (FieldInt16 f) (DInt16 x) = Right $ (f .~ x) x0 +updateField x0 (FieldInt32 f) (DInt32 x) = Right $ (f .~ x) x0 +updateField x0 (FieldInt64 f) (DInt64 x) = Right $ (f .~ x) x0 +updateField x0 (FieldWord8 f) (DWord8 x) = Right $ (f .~ x) x0 +updateField x0 (FieldWord16 f) (DWord16 x) = Right $ (f .~ x) x0 +updateField x0 (FieldWord32 f) (DWord32 x) = Right $ (f .~ x) x0 +updateField x0 (FieldWord64 f) (DWord64 x) = Right $ (f .~ x) x0 updateField x0 (FieldString f) (DString x) = Right $ (f .~ x) x0 -updateField x0 FieldSorry _ = Right x0 -updateField _ f@(FieldDouble _) d = Left (fieldMismatch f d) -updateField _ f@(FieldFloat _) d = Left (fieldMismatch f d) -updateField _ f@(FieldInt _) d = Left (fieldMismatch f d) -updateField _ f@(FieldString _) d = Left (fieldMismatch f d) +updateField x0 FieldSorry _ = Right x0 +updateField _ f@(FieldDouble _) d = Left (fieldMismatch f d) +updateField _ f@(FieldFloat _) d = Left (fieldMismatch f d) +updateField _ f@(FieldInt8 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldInt16 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldInt32 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldInt64 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldWord8 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldWord16 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldWord32 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldWord64 _) d = Left (fieldMismatch f d) +updateField _ f@(FieldString _) d = Left (fieldMismatch f d) fieldMismatch :: GAField a -> DField -> String fieldMismatch f d = @@ -237,11 +288,18 @@ diffDTrees' name _ _ = [showName name ++ " have different types"] diffDFields :: [String] -> DField -> DField -> Maybe String -diffDFields name (DDouble x) (DDouble y) = diffEq name x y -diffDFields name (DFloat x) (DFloat y) = diffEq name x y -diffDFields name (DInt x) (DInt y) = diffEq name x y -diffDFields name (DString x) (DString y) = diffEq name x y -diffDFields name DSorry DSorry = Just (showName name ++ ": can't diff this type") +diffDFields name (DDouble x) (DDouble y) = diffEq name x y +diffDFields name (DFloat x) (DFloat y) = diffEq name x y +diffDFields name (DInt8 x) (DInt8 y) = diffEq name x y +diffDFields name (DInt16 x) (DInt16 y) = diffEq name x y +diffDFields name (DInt32 x) (DInt32 y) = diffEq name x y +diffDFields name (DInt64 x) (DInt64 y) = diffEq name x y +diffDFields name (DWord8 x) (DWord8 y) = diffEq name x y +diffDFields name (DWord16 x) (DWord16 y) = diffEq name x y +diffDFields name (DWord32 x) (DWord32 y) = diffEq name x y +diffDFields name (DWord64 x) (DWord64 y) = diffEq name x y +diffDFields name (DString x) (DString y) = diffEq name x y +diffDFields name DSorry DSorry = Just (showName name ++ ": can't diff this type") diffDFields name x y | sameDFieldType x y = Just $ showName name ++ ": ERROR! unhandled type " ++ show (x, y) | otherwise = Just $ showName name ++ ": has different types" diff --git a/src/Accessors/Instances.hs b/src/Accessors/Instances.hs --- a/src/Accessors/Instances.hs +++ b/src/Accessors/Instances.hs @@ -69,6 +69,7 @@ lens4 :: Lens' (a, b, c, d) d lens4 f (x, y, z, w) = fmap (\w' -> (x, y, z, w')) (f w) +-- TODO(MP): Product? Const? Identity? -- some instance from linear instance Lookup a => Lookup (Linear.V0 a) where @@ -113,8 +114,22 @@ -- basic types instance Lookup () where -- hack to get dummy tree toAccessorTree _ = Left FieldSorry -instance Lookup Int where - toAccessorTree lens = Left (FieldInt lens) +instance Lookup Int8 where + toAccessorTree lens = Left (FieldInt8 lens) +instance Lookup Int16 where + toAccessorTree lens = Left (FieldInt16 lens) +instance Lookup Int32 where + toAccessorTree lens = Left (FieldInt32 lens) +instance Lookup Int64 where + toAccessorTree lens = Left (FieldInt64 lens) +instance Lookup Word8 where + toAccessorTree lens = Left (FieldWord8 lens) +instance Lookup Word16 where + toAccessorTree lens = Left (FieldWord16 lens) +instance Lookup Word32 where + toAccessorTree lens = Left (FieldWord32 lens) +instance Lookup Word64 where + toAccessorTree lens = Left (FieldWord64 lens) instance Lookup Float where toAccessorTree lens = Left (FieldFloat lens) instance Lookup Double where @@ -125,80 +140,66 @@ -- Word types instance Lookup Word where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Word8 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Word16 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Word32 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Word64 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) -- Int types -instance Lookup Int8 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Int16 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Int32 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) -instance Lookup Int64 where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) +instance Lookup Int where + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) -- C types -- todo(greg): some of these have inappropriate fields instance Lookup CChar where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt8 (lens0 . integralLens)) instance Lookup CSChar where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt8 (lens0 . integralLens)) instance Lookup CUChar where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord8 (lens0 . integralLens)) instance Lookup CShort where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt16 (lens0 . integralLens)) instance Lookup CUShort where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord16 (lens0 . integralLens)) instance Lookup CInt where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt32 (lens0 . integralLens)) instance Lookup CUInt where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord32 (lens0 . integralLens)) instance Lookup CLong where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) instance Lookup CULong where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) instance Lookup CPtrdiff where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) instance Lookup CSize where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) instance Lookup CWchar where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt32 (lens0 . integralLens)) instance Lookup CSigAtomic where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt32 (lens0 . integralLens)) instance Lookup CLLong where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) instance Lookup CULLong where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) instance Lookup CIntPtr where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) instance Lookup CUIntPtr where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) instance Lookup CIntMax where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . integralLens)) instance Lookup CUIntMax where - toAccessorTree lens0 = Left (FieldInt (lens0 . integralLens)) + toAccessorTree lens0 = Left (FieldWord64 (lens0 . integralLens)) instance Lookup CClock where - toAccessorTree lens0 = Left (FieldInt (lens0 . clockLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . clockLens)) where clockLens f (CClock x) = fmap (CClock . fromIntegral) (f (fromIntegral x)) instance Lookup CTime where - toAccessorTree lens0 = Left (FieldInt (lens0 . timeLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . timeLens)) where timeLens f (CTime x) = fmap (CTime . fromIntegral) (f (fromIntegral x)) instance Lookup CUSeconds where - toAccessorTree lens0 = Left (FieldInt (lens0 . usecondsLens)) + toAccessorTree lens0 = Left (FieldWord32 (lens0 . usecondsLens)) where usecondsLens f (CUSeconds x) = fmap (CUSeconds . fromIntegral) (f (fromIntegral x)) instance Lookup CSUSeconds where - toAccessorTree lens0 = Left (FieldInt (lens0 . susecondsLens)) + toAccessorTree lens0 = Left (FieldInt64 (lens0 . susecondsLens)) where susecondsLens f (CSUSeconds x) = fmap (CSUSeconds . fromIntegral) (f (fromIntegral x)) instance Lookup CFloat where @@ -207,7 +208,7 @@ toAccessorTree lens0 = Left (FieldDouble (lens0 . realFracLens)) {-# INLINE integralLens #-} -integralLens :: Integral a => Lens' a Int +integralLens :: (Integral a, Integral b) => Lens' a b integralLens f x = fmap fromIntegral (f (fromIntegral x)) {-# INLINE realFracLens #-} diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -5,6 +5,8 @@ import GHC.Generics ( Generic ) +import Data.Int ( Int8, Int16 ) +import Data.Word ( Word64 ) import Data.Monoid ( mempty ) import Text.Printf ( printf ) import Test.Framework ( ColorMode(..), RunnerOptions'(..), TestOptions'(..), defaultMainWithOpts ) @@ -33,7 +35,7 @@ my_test_opts = mempty { topt_timeout = Just (Just 2000000) } -data Xyz a = Xyz { xx :: Int +data Xyz a = Xyz { xx :: Int8 , yy :: Double , zz :: Float , bb :: (Bool, Bool, Bool) @@ -41,8 +43,8 @@ } deriving (Generic, Show) data One = MkOne { one :: Double } deriving (Generic, Show) -data Foo = MkFoo { aaa :: Int - , bbb :: Xyz Int +data Foo = MkFoo { aaa :: Int16 + , bbb :: Xyz Word64 , lol :: Bool , notlol :: Bool , yoyo :: Xyz (Xyz Double) @@ -105,7 +107,7 @@ toDValueTest :: HUnit.Assertion toDValueTest = assertEqualString x y where - x = "Right (DData \"Xyz\" (DConstructor \"Xyz\" [(Just \"xx\",Left (DInt 1)),(Just \"yy\",Left (DDouble 2.0)),(Just \"zz\",Left (DFloat 3.0)),(Just \"bb\",Right (DData \"(,,)\" (DConstructor \"(,,)\" [(Just \"(x,_,_)\",Right (DData \"Bool\" (DSum (DSimpleEnum [\"False\",\"True\"] 1)))),(Just \"(_,x,_)\",Right (DData \"Bool\" (DSum (DSimpleEnum [\"False\",\"True\"] 0)))),(Just \"(_,_,x)\",Right (DData \"Bool\" (DSum (DSimpleEnum [\"False\",\"True\"] 1))))]))),(Just \"ww\",Right (DData \"One\" (DConstructor \"MkOne\" [(Just \"one\",Left (DDouble 4.0))])))]))" + x = "Right (DData \"Xyz\" (DConstructor \"Xyz\" [(Just \"xx\",Left (DInt8 1)),(Just \"yy\",Left (DDouble 2.0)),(Just \"zz\",Left (DFloat 3.0)),(Just \"bb\",Right (DData \"(,,)\" (DConstructor \"(,,)\" [(Just \"(x,_,_)\",Left (DBool True)),(Just \"(_,x,_)\",Left (DBool False)),(Just \"(_,_,x)\",Left (DBool True))]))),(Just \"ww\",Right (DData \"One\" (DConstructor \"MkOne\" [(Just \"one\",Left (DDouble 4.0))])))]))" y = show (toDData (Xyz 1 2 3 (True, False, True) (MkOne 4))) @@ -118,15 +120,15 @@ dvalue = DData "Xyz" $ DConstructor "Xyz" $ - [ (Just "xx", Left (DInt 10)) + [ (Just "xx", Left (DInt8 10)) , (Just "yy", Left (DDouble 20.0)) , (Just "zz", Left (DFloat 30.0)) , ( Just "bb" , Right (DData "(,,)" (DConstructor "(,,)" - [ (Just "(x,_,_)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 0)))) - , (Just "(_,x,_)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 1)))) - , (Just "(_,_,x)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 1)))) + [ (Just "(x,_,_)", Left (DBool False)) + , (Just "(_,x,_)", Left (DBool True)) + , (Just "(_,_,x)", Left (DBool True)) ])) ) , (Just "ww", Right (DData "One" @@ -150,15 +152,15 @@ dvalue = DData "Xyz" $ DConstructor "Xyz" $ - [ (Just "xx", Left (DInt 10)) + [ (Just "xx", Left (DInt8 10)) , (Just "yy", Left (DDouble 20.0)) , (Just "zz", Left (DFloat 30.0)) , ( Just "b" , Right (DData "(,,)" (DConstructor "(,,)" - [ (Just "(x,_,_)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 0)))) - , (Just "(_,x,_)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 1)))) - , (Just "(_,_,x)", Right (DData "Bool" (DSum (DSimpleEnum ["False", "True"] 1)))) + [ (Just "(x,_,_)", Left (DBool False)) + , (Just "(_,x,_)", Left (DBool True)) + , (Just "(_,_,x)", Left (DBool True)) ])) ) , (Just "ww", Right (DData "One"