generic-accessors 0.7.0.0 → 0.7.1.0
raw patch · 5 files changed
+29/−4 lines, 5 files
Files
- CHANGELOG.md +14/−0
- generic-accessors.cabal +1/−1
- src/Accessors/Accessors.hs +5/−0
- src/Accessors/Dynamic.hs +6/−0
- src/Accessors/Instances.hs +3/−3
CHANGELOG.md view
@@ -1,3 +1,17 @@+HEAD+---+* ...++0.7.1.0+---+* Support for ()+* Remove redundant `Lookup a` constraint on `Lookup (V0 a)`+* Switch Bool from basic type to sum type.++0.7.0.0+---+* Break Int into several integer types.+ 0.6.2.0 --- * bugfix diffDTree
generic-accessors.cabal view
@@ -1,5 +1,5 @@ name: generic-accessors-version: 0.7.0.0+version: 0.7.1.0 synopsis: stringly-named getters for generic data license: BSD3 license-file: LICENSE
src/Accessors/Accessors.hs view
@@ -62,6 +62,7 @@ | FieldWord32 (Lens' a Word32) | FieldWord64 (Lens' a Word64) | FieldString (Lens' a String)+ | FieldUnit | FieldSorry -- ^ a field which is not yet supported data GATip a =@@ -104,6 +105,7 @@ describeGAField (FieldWord32 _) = "Word32" describeGAField (FieldWord64 _) = "Word64" describeGAField (FieldString _) = "String"+describeGAField FieldUnit = "()" describeGAField FieldSorry = "Sorry" -- | Returns True if the __type__ of fields is the same.@@ -119,6 +121,7 @@ sameFieldType (FieldWord32 _) (FieldWord32 _) = True sameFieldType (FieldWord64 _) (FieldWord64 _) = True sameFieldType (FieldString _) (FieldString _) = True+sameFieldType FieldUnit FieldUnit = True sameFieldType FieldSorry FieldSorry = True sameFieldType (FieldDouble _) _ = False sameFieldType (FieldFloat _) _ = False@@ -131,6 +134,7 @@ sameFieldType (FieldWord32 _) _ = False sameFieldType (FieldWord64 _) _ = False sameFieldType (FieldString _) _ = False+sameFieldType FieldUnit _ = False sameFieldType FieldSorry _ = False accessors :: Lookup a => AccessorTree a@@ -376,6 +380,7 @@ showFieldVal (FieldDouble lens) show' x = show' (x ^. lens) showFieldVal (FieldFloat lens) show' x = show' (realToFrac (x ^. lens)) showFieldVal (FieldString lens) _ x = x ^. lens+showFieldVal FieldUnit _ _ = "()" showFieldVal FieldSorry _ _ = "" showTipVal :: GATip a -> (Double -> String) -> a -> String
src/Accessors/Dynamic.hs view
@@ -58,6 +58,7 @@ | DWord32 Word32 | DWord64 Word64 | DString String+ | DUnit | DSorry deriving (Generic, Show, Eq, Ord, Data, Typeable) instance Serialize DField@@ -112,6 +113,7 @@ sameDFieldType (DWord32 _) (DWord32 _) = True sameDFieldType (DWord64 _) (DWord64 _) = True sameDFieldType (DString _) (DString _) = True+sameDFieldType DUnit DUnit = True sameDFieldType DSorry DSorry = True sameDFieldType (DDouble _) _ = False sameDFieldType (DFloat _) _ = False@@ -124,6 +126,7 @@ sameDFieldType (DWord32 _) _ = False sameDFieldType (DWord64 _) _ = False sameDFieldType (DString _) _ = False+sameDFieldType DUnit _ = False sameDFieldType DSorry _ = False describeDField :: DField -> String@@ -138,6 +141,7 @@ describeDField (DDouble _) = "Double" describeDField (DFloat _) = "Float" describeDField (DString _) = "String"+describeDField DUnit = "()" describeDField DSorry = "Sorry" -- | convert to a dynamic value@@ -168,6 +172,7 @@ toDField (FieldWord32 f) = DWord32 (x ^. f) toDField (FieldWord64 f) = DWord64 (x ^. f) toDField (FieldString f) = DString (x ^. f)+ toDField FieldUnit = DUnit toDField FieldSorry = DSorry @@ -255,6 +260,7 @@ 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 FieldUnit _ = Right x0 updateField x0 FieldSorry _ = Right x0 updateField _ f@(FieldDouble _) d = Left (fieldMismatch f d) updateField _ f@(FieldFloat _) d = Left (fieldMismatch f d)
src/Accessors/Instances.hs view
@@ -72,7 +72,7 @@ -- TODO(MP): Product? Const? Identity? -- some instance from linear-instance Lookup a => Lookup (Linear.V0 a) where+instance Lookup (Linear.V0 a) where toAccessorTree _ = Right $ GAData "V0" $ GAConstructor "V0" [] instance Lookup a => Lookup (Linear.V1 a) where@@ -112,8 +112,8 @@ ] -- basic types-instance Lookup () where -- hack to get dummy tree- toAccessorTree _ = Left FieldSorry+instance Lookup () where+ toAccessorTree _ = Left FieldUnit instance Lookup Int8 where toAccessorTree lens = Left (FieldInt8 lens) instance Lookup Int16 where