diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,17 @@ # ChangeLog / ReleaseNotes +## Version 0.4.1.0 + +* Introducing `Getter` newtype along with `get` function. (**new**) + * `get :: Getter s a -> s -> a` +* Introducing `Rec` data type that allows passing polymorphic record along with + its instances as a normal value. (**new**) +* Corrections and updates in documentation (**change**) +* Uploaded to [Hackage][]: + + + ## Version 0.4.0.0 * Renamed `SetField` type class to `ModifyField`, it now contains following diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -18,6 +18,7 @@ directly as getters and lenses. ```Haskell +import Data.Default (Default(def)) import Data.OverloadedRecords.TH (overloadedRecord) newtype Bar a = Bar {_bar :: a} @@ -126,7 +127,7 @@ overloadedRecord def ''V4 zeroV3 - :: (Num a, R ["x" ::: a, "y" ::: a, "z" ::: a] r) + :: (Num a, R '["x" ::: a, "y" ::: a, "z" ::: a] r) => r -> r zeroV3 = set' #x 0 . set' #y 0 . set' #z 0 ``` @@ -135,7 +136,7 @@ ```Haskell zeroV3 - :: (Num a, R ["x" ::: a, "y" ::: a, "z" ::: a] r) + :: (Num a, R '["x" ::: a, "y" ::: a, "z" ::: a] r) => r -> r ``` @@ -168,13 +169,15 @@ [lens][Hackage: lens] library: ```Haskell +import Control.Lens ((.~), simple) + zeroV3 - :: (Num a, R ["x" ::: a, "y" ::: a, "z" ::: a] r) + :: (Num a, R '["x" ::: a, "y" ::: a, "z" ::: a] r) => r -> r zeroV3 r = r - & #x .~ 0 - & #y .~ 0 - & #z .~ 0 + & #x . simple .~ 0 + & #y . simple .~ 0 + & #z . simple .~ 0 ``` diff --git a/overloaded-records.cabal b/overloaded-records.cabal --- a/overloaded-records.cabal +++ b/overloaded-records.cabal @@ -1,5 +1,5 @@ name: overloaded-records -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Overloaded Records based on current GHC proposal. description: Implementation of /Overloaded Record Fields/ based on current GHC proposal. @@ -78,6 +78,7 @@ cpp-options: -DHAVE_MONAD_FAIL -DHAVE_OVERLOADED_LABELS +-- -DHAVE_TYPE_FAMILY_DEPENDENCIES ghc-options: -Wall if flag(pedantic) @@ -148,6 +149,7 @@ cpp-options: -DHAVE_MONAD_FAIL -DHAVE_OVERLOADED_LABELS +-- -DHAVE_TYPE_FAMILY_DEPENDENCIES ghc-options: -Wall if flag(pedantic) @@ -163,4 +165,4 @@ source-repository this type: git location: git://github.com/trskop/overloaded-records.git - tag: 0.4.0.0 + tag: 0.4.1.0 diff --git a/src/Data/OverloadedRecords.hs b/src/Data/OverloadedRecords.hs --- a/src/Data/OverloadedRecords.hs +++ b/src/Data/OverloadedRecords.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -24,7 +25,7 @@ -- Stability: experimental -- Portability: ConstraintKinds, DataKinds, DeriveDataTypeable, DeriveGeneric, -- FlexibleInstances, FlexibleContexts, FunctionalDependencies, --- LambdaCase MagicHash, MultiParamTypeClasses, +-- GADTs, LambdaCase, MagicHash, MultiParamTypeClasses, -- NoImplicitPrelude, RankNTypes, TypeFamilies, TypeOperators, -- UndecidableInstances -- @@ -48,11 +49,15 @@ , FieldType , HasField(..) + , Getter + , get + -- ** Setter and Modifier , UpdateType , ModifyField(..) , R , (:::) + , Rec(..) , Setting , setting @@ -88,7 +93,7 @@ import Data.Proxy (Proxy) import Data.Typeable (Typeable) import GHC.Exts (Constraint, Proxy#) -import GHC.Generics (Generic) +import GHC.Generics (Generic, Generic1) import GHC.TypeLits (Symbol) import Data.OverloadedLabels @@ -99,8 +104,8 @@ type family FieldType (l :: Symbol) (s :: *) :: * -- | If field @l :: Symbol@ of a record @s :: *@ is set to new value which has --- type @a :: *@, then the modified record will have type @'UpdateType' l s a@. -type family UpdateType (l :: Symbol) (s :: *) (a :: *) :: * +-- type @b :: *@, then the modified record will have type @'UpdateType' l s b@. +type family UpdateType (l :: Symbol) (s :: *) (b :: *) :: * -- | Definition of this class is based on: -- @@ -221,7 +226,7 @@ -- 'Data.OverloadedRecords.TH.overloadedRecord' def ''V3 -- -- setV3 --- :: 'R' [\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r +-- :: 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r -- => a -> a -> a -> r -> r -- setV3 x y z = 'set'' \#x x . 'set'' \#y y . 'set'' \#z z -- @ @@ -240,6 +245,71 @@ -- /Since 0.4.0.0/ type (:::) (l :: Symbol) (a :: *) = '(l, a) +-- | Pass polymorphic record as a value along with all necessary instances. By +-- pattern matching on 'Rec' data constructor all those instances come in to +-- scope. +-- +-- Example: +-- +-- @ +-- {-\# LANGUAGE GADTs \#-} +-- -- May be required in addition to the basic set of language extensions. +-- +-- data V3 a = V3 +-- { _x :: a +-- , _y :: a +-- , _z :: a +-- } +-- deriving Show +-- +-- 'Data.OverloadedRecords.TH.overloadedRecord' def ''V3 +-- +-- zeroV3 :: 'Rec' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r -> r -> r +-- zeroV3 ('Rec' r) = 'set'' \#x 0 . 'set'' \#y 0 $ 'set'' \#z 0 r +-- @ +-- +-- >>> zeroV3 (V3 1 1 1 :: V3 Int) +-- V3 {_x = 0, _y = 0, _z = 0} +-- +-- /Since 0.4.1.0/ +data Rec ts r where + Rec :: R ts r => r -> Rec ts r + deriving (Typeable) + +-- {{{ Getter ----------------------------------------------------------------- + +-- | Provides alternative to the \"native\" 'IsLabel' instance for getter. +-- Since mixing getter instance and lens instance for 'IsLabel' on polymorphic +-- records is not possible, one may want to use 'Getter' as an alternative. +-- +-- /Since 0.4.1.0/ +newtype Getter s a = Getter (s -> a) + deriving (Generic, Generic1, Typeable) + +-- | /Since 0.4.1.0/ +instance (HasField l s a) => IsLabel l (Getter s a) where + fromLabel proxy = Getter (getField proxy) + +-- | Extract a getter function from overloaded label. +-- +-- Example: +-- +-- @ +-- newtype Bar a = Bar {_bar :: a} +-- +-- overloadedRecord ''Bar +-- @ +-- +-- >>> get #bar (Bar False) +-- False +-- +-- /Since 0.4.1.0/ +get :: Getter s a -> s -> a +get (Getter f) = f +{-# INLINE get #-} + +-- }}} Getter ----------------------------------------------------------------- + -- {{{ Setter ----------------------------------------------------------------- -- | 'Setting' is just a form of a 'Modifier' that allows us to specify what @@ -339,7 +409,7 @@ newtype Modifier s t a b = Modifier ((a -> b) -> s -> t) deriving (Generic, Typeable) --- /Since 0.4.0.0/ +-- | /Since 0.4.0.0/ instance (ModifyField l s t a b) => IsLabel l (Modifier s t a b) where fromLabel proxy = Modifier (modifyField proxy) @@ -1110,7 +1180,7 @@ -- 'Data.OverloadedRecords.TH.overloadedRecord' def ''V4 -- -- zeroV3 --- :: (Num a, 'R' [\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) +-- :: (Num a, 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) -- => r -> r -- zeroV3 = 'set'' \#x 0 . 'set'' \#y 0 . 'set'' \#z 0 -- @ @@ -1119,7 +1189,7 @@ -- -- @ -- zeroV3 --- :: (Num a, 'R' [\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) +-- :: (Num a, 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) -- => r -> r -- @ -- @@ -1149,11 +1219,44 @@ -- library: -- -- @ +-- import Control.Lens ((.~), simple) +-- -- zeroV3 --- :: (Num a, 'R' [\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) +-- :: (Num a, 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) -- => r -> r -- zeroV3 r = r --- & \#x .~ 0 --- & \#y .~ 0 --- & \#z .~ 0 +-- & \#x . simple .~ 0 +-- & \#y . simple .~ 0 +-- & \#z . simple .~ 0 +-- @ +-- +-- However, following function would fail to compile: +-- +-- @ +-- incV3 +-- :: (Num a, 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) +-- => r -> r +-- incV3 r = r +-- & \#x . simple .~ \#x r + 1 +-- & \#y . simple .~ \#y r + 1 +-- & \#z . simple .~ \#z r + 1 +-- @ +-- +-- The problem is that we have two 'IsLabel' instances at play. One is for a +-- lens and the other one is for getter. Unfortunatelly these two instances are +-- mutually exclusive in case of polymorphic value. There are multiple +-- solutions to this. Use lenses all the time, e.g. in general by using @^.@ +-- for getting the value, or in this case by using @+~@ operator for +-- incrementing. Example of using @+~@: +-- +-- @ +-- import Control.Lens ((.~), (+~), simple) +-- +-- incV3 +-- :: (Num a, 'R' '[\"x\" ':::' a, \"y\" ':::' a, \"z\" ':::' a] r) +-- => r -> r +-- incV3 r = r +-- & \#x . simple +~ 1 +-- & \#y . simple +~ 1 +-- & \#z . simple +~ 1 -- @