diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +# optics-core-0.3.0.1 (2020-08-05) +* Add INLINE pragmas to `atraverseOf_`, `iaTraverseOf_` and `ignored` +* Improve error message in catch-all `GeneralLabelOptic` instance +* Make GHC optimize away profunctor type classes when profiling is enabled +* Improve documentation of `Optics.Label`: + - Add guide on how to effectively use labels as optics + - Restructure existing sections + # optics-core-0.3 (2020-04-15) * GHC-8.10 support * Add `filteredBy` and `unsafeFilteredBy` diff --git a/optics-core.cabal b/optics-core.cabal --- a/optics-core.cabal +++ b/optics-core.cabal @@ -1,5 +1,5 @@ name: optics-core -version: 0.3 +version: 0.3.0.1 license: BSD3 license-file: LICENSE build-type: Simple diff --git a/src/Optics/AffineFold.hs b/src/Optics/AffineFold.hs --- a/src/Optics/AffineFold.hs +++ b/src/Optics/AffineFold.hs @@ -109,6 +109,7 @@ atraverseOf_ o point f s = case preview o s of Just a -> () <$ f a Nothing -> point () +{-# INLINE atraverseOf_ #-} -- | Create an 'AffineFold' from a partial function. -- diff --git a/src/Optics/Internal/Optic.hs b/src/Optics/Internal/Optic.hs --- a/src/Optics/Internal/Optic.hs +++ b/src/Optics/Internal/Optic.hs @@ -22,6 +22,7 @@ , Optic' , Optic_ , Optic__ + , getOptic , castOptic , (%) , (%%) @@ -66,11 +67,20 @@ -- The parameters @s@ and @t@ represent the "big" structure, -- whereas @a@ and @b@ represent the "small" structure. -- -newtype Optic (k :: OpticKind) (is :: IxList) s t a b = Optic - { getOptic :: forall p i. Profunctor p - => Optic_ k p i (Curry is i) s t a b - } +newtype Optic (k :: OpticKind) (is :: IxList) s t a b + = Optic (forall p i. Profunctor p => Optic_ k p i (Curry is i) s t a b) +-- | Strip the newtype wrapper off. +getOptic + :: Profunctor p + => Optic k is s t a b + -> Optic_ k p i (Curry is i) s t a b +-- Note: This is not part of the definition of 'Optic' because it needs to be +-- marked INLINE for GHC to optimize away profunctor classes when profiling. +-- See https://github.com/well-typed/optics/issues/324 for more details. +getOptic (Optic o) = o +{-# INLINE getOptic #-} + -- | Common special case of 'Optic' where source and target types are equal. -- -- Here, we need only one "big" and one "small" type. For lenses, this @@ -197,9 +207,6 @@ -- | Support for overloaded labels as optics. An overloaded label @#foo@ can be -- used as an optic if there is an instance of @'LabelOptic' "foo" k s t a b@. --- --- See "Optics.Label" for examples and further details. --- class LabelOptic (name :: Symbol) k s t a b | name s -> k a , name t -> k b , name s b -> t @@ -256,7 +263,7 @@ ':<>: 'Text " " ':<>: QuoteType t ':<>: 'Text " " ':<>: QuoteType a ':<>: 'Text " " ':<>: QuoteType b - ':$$: 'Text " (maybe you forgot to define it or misspelled a name?)") + ':$$: 'Text "Perhaps you forgot to define it or misspelled its name?") => GeneralLabelOptic name k s t a b repDefined where generalLabelOptic = error "unreachable" diff --git a/src/Optics/IxAffineFold.hs b/src/Optics/IxAffineFold.hs --- a/src/Optics/IxAffineFold.hs +++ b/src/Optics/IxAffineFold.hs @@ -110,6 +110,7 @@ iatraverseOf_ o point f s = case ipreview o s of Just (i, a) -> () <$ f i a Nothing -> point () +{-# INLINE iatraverseOf_ #-} -- | Create an 'IxAffineFold' from a partial function. iafolding :: (s -> Maybe (i, a)) -> IxAffineFold i s a diff --git a/src/Optics/IxAffineTraversal.hs b/src/Optics/IxAffineTraversal.hs --- a/src/Optics/IxAffineTraversal.hs +++ b/src/Optics/IxAffineTraversal.hs @@ -127,6 +127,7 @@ -- 6 ignored :: IxAffineTraversal i s s a b ignored = iatraversalVL $ \point _ -> point +{-# INLINE ignored #-} -- $setup -- >>> import Optics.Core diff --git a/src/Optics/Label.hs b/src/Optics/Label.hs --- a/src/Optics/Label.hs +++ b/src/Optics/Label.hs @@ -7,15 +7,43 @@ -- a prefix @#@ sign followed by an identifier, e.g. @#foo@. These expressions -- can then be given an interpretation that depends on the type at which they -- are used and the text of the label. --- --- The following example shows how overloaded labels can be used as optics. --- --- == Example +module Optics.Label + ( -- * How to use labels as optics to make working with Haskell's records more convenient + -- + -- ** The problem + -- $problem + + -- ** The solution + -- $solution + + -- ** The result + -- $result + + -- * Sample usage + -- $sampleUsage + + -- * Technical details + + -- ** 'LabelOptic' type class + LabelOptic(..) + , LabelOptic' + + -- ** Structure of 'LabelOptic' instances + -- $instanceStructure + + -- ** Limitations arising from functional dependencies + -- $fundepLimitations + ) where + +import Optics.Internal.Optic + +-- $sampleUsage -- --- Consider the following: +-- #usage# +-- An example showing how overloaded labels can be used as optics. -- -- >>> :set -XDataKinds --- >>> :set -XFlexibleContexts +-- >>> :set -XDuplicateRecordFields -- >>> :set -XFlexibleInstances -- >>> :set -XMultiParamTypeClasses -- >>> :set -XOverloadedLabels @@ -23,30 +51,36 @@ -- >>> :set -XUndecidableInstances -- >>> :{ -- data Human = Human --- { humanName :: String --- , humanAge :: Integer --- , humanPets :: [Pet] +-- { name :: String +-- , age :: Integer +-- , pets :: [Pet] -- } deriving Show -- data Pet --- = Cat { petName :: String, petAge :: Int, petLazy :: Bool } --- | Fish { petName :: String, petAge :: Int } +-- = Cat { name :: String, age :: Int, lazy :: Bool } +-- | Fish { name :: String, age :: Int } -- deriving Show -- :} -- --- The following instances can be generated by @makeFieldLabels@ from --- @Optics.TH@ in the @optics-th@ package: +-- The following instances can be generated by @makeFieldLabelsWith +-- noPrefixFieldLabels@ from +-- @@ +-- in the @@ package: -- -- >>> :{ -- instance (k ~ A_Lens, a ~ String, b ~ String) => LabelOptic "name" k Human Human a b where --- labelOptic = lensVL $ \f s -> (\v -> s { humanName = v }) <$> f (humanName s) +-- labelOptic = lensVL $ \f (Human name age pets) -> (\name' -> Human name' age pets) <$> f name -- instance (k ~ A_Lens, a ~ Integer, b ~ Integer) => LabelOptic "age" k Human Human a b where --- labelOptic = lensVL $ \f s -> (\v -> s { humanAge = v }) <$> f (humanAge s) +-- labelOptic = lensVL $ \f (Human name age pets) -> (\age' -> Human name age' pets) <$> f age -- instance (k ~ A_Lens, a ~ [Pet], b ~ [Pet]) => LabelOptic "pets" k Human Human a b where --- labelOptic = lensVL $ \f s -> (\v -> s { humanPets = v }) <$> f (humanPets s) +-- labelOptic = lensVL $ \f (Human name age pets) -> (\pets' -> Human name age pets') <$> f pets -- instance (k ~ A_Lens, a ~ String, b ~ String) => LabelOptic "name" k Pet Pet a b where --- labelOptic = lensVL $ \f s -> (\v -> s { petName = v }) <$> f (petName s) +-- labelOptic = lensVL $ \f s -> case s of +-- Cat name age lazy -> (\name' -> Cat name' age lazy) <$> f name +-- Fish name age -> (\name' -> Fish name' age ) <$> f name -- instance (k ~ A_Lens, a ~ Int, b ~ Int) => LabelOptic "age" k Pet Pet a b where --- labelOptic = lensVL $ \f s -> (\v -> s { petAge = v }) <$> f (petAge s) +-- labelOptic = lensVL $ \f s -> case s of +-- Cat name age lazy -> (\age' -> Cat name age' lazy) <$> f age +-- Fish name age -> (\age' -> Fish name age' ) <$> f age -- instance (k ~ An_AffineTraversal, a ~ Bool, b ~ Bool) => LabelOptic "lazy" k Pet Pet a b where -- labelOptic = atraversalVL $ \point f s -> case s of -- Cat name age lazy -> (\lazy' -> Cat name age lazy') <$> f lazy @@ -57,10 +91,21 @@ -- -- >>> :{ -- peter :: Human --- peter = Human "Peter" 13 [ Fish "Goldie" 1 --- , Cat "Loopy" 3 False --- , Cat "Sparky" 2 True --- ] +-- peter = Human { name = "Peter" +-- , age = 13 +-- , pets = [ Fish { name = "Goldie" +-- , age = 1 +-- } +-- , Cat { name = "Loopy" +-- , age = 3 +-- , lazy = False +-- } +-- , Cat { name = "Sparky" +-- , age = 2 +-- , lazy = True +-- } +-- ] +-- } -- :} -- -- Now we can ask for Peter's name: @@ -81,16 +126,214 @@ -- or how things might be be a year from now: -- -- >>> peter & over #age (+1) & over (#pets % mapped % #age) (+1) --- Human {humanName = "Peter", humanAge = 14, humanPets = [Fish {petName = "Goldie", petAge = 2},Cat {petName = "Loopy", petAge = 4, petLazy = False},Cat {petName = "Sparky", petAge = 3, petLazy = True}]} +-- Human {name = "Peter", age = 14, pets = [Fish {name = "Goldie", age = 2},Cat {name = "Loopy", age = 4, lazy = False},Cat {name = "Sparky", age = 3, lazy = True}]} -- -- Perhaps Peter is going on vacation and needs to leave his pets at home: -- -- >>> peter & set #pets [] --- Human {humanName = "Peter", humanAge = 13, humanPets = []} +-- Human {name = "Peter", age = 13, pets = []} + +-- $problem -- +-- Standard Haskell records are a common source of frustration amongst seasoned +-- Haskell programmers. Their main issues are: -- --- == Structure of 'LabelOptic' instances +-- (1) Inability to define multiple data types sharing field names in the same +-- module. -- +-- (2) Pollution of global namespace as every field accessor is also a top-level +-- function. +-- +-- (3) Clunky update syntax, especially when nested fields get involved. +-- +-- Over the years multiple language extensions were proposed and implemented to +-- alleviate these issues. We're quite close to having a reasonable solution +-- with the following trifecta: +-- +-- - @@ - introduced in GHC 8.0.1, addresses (1) +-- +-- - @@ - accepted GHC proposal, addresses (2) +-- +-- - @@ - accepted GHC proposal, addresses (3) +-- +-- It needs to be noted however that both @NoFieldSelectors@ and +-- @RecordDotSyntax@ are not yet implemented, with the latter depending on +-- adding @setField@ to @HasField@ +-- (), not yet +-- merged. +-- +-- Is there no hope then for people who would like to work with records in a +-- reasonable way without waiting for these extensions? Not necessarily, as by +-- following a couple of simple patterns we can get pretty much the same (and +-- more) features with labels as optics, just with a slightly more verbose +-- syntax. + +-- $solution +-- +-- === Prefixless fields with @DuplicateRecordFields@ +-- +-- We necessarily want field names to be prefixless, i.e. @field@ to be a field +-- name and @#field@ to be an overloaded label that becomes an optic refering to +-- this field in the appropriate context. With this approach we get working +-- autocompletion and jump-to-definition in editors supporting @ctags@/@etags@ +-- in combination with @@, +-- both of which (especially the latter) are very important for developer's +-- productivity in real-world code bases. +-- +-- Let's look at data types defined with this approach in mind: +-- +-- @ +-- {-\# LANGUAGE DuplicateRecordFields \#-} +-- +-- import Data.Time +-- +-- data User = User { id :: Int +-- , name :: String +-- , joined :: UTCTime +-- , movies :: [Movie] +-- } +-- +-- data Movie = Movie { id :: Int +-- , name :: String +-- , releaseDate :: UTCTime +-- } +-- @ +-- +-- Then appropriate 'LabelOptic' instances can be either written by hand or +-- generated using Template Haskell functions (defined in +-- @@ +-- module from @@ package) +-- with +-- +-- @ +-- makeFieldLabelsWith noPrefixFieldLabels ''User +-- makeFieldLabelsWith noPrefixFieldLabels ''Movie +-- @ +-- +-- /Note:/ there exists a similar approach that involves prefixing field names +-- with the underscore and generation of lenses as ordinary functions so that +-- @_field@ is the ordinary field name and @field@ is the lens referencing +-- it. The drawback of such solution is inability to get working +-- jump-to-definition for field names, which makes navigation in unfamiliar code +-- bases significantly harder, so it's not recommended. +-- +-- === Emulation of @NoFieldSelectors@ +-- +-- Prefixless fields (especially ones with common names such as @id@ or @name@) +-- leak into global namespace as accessor functions and can generate a lot of +-- name clashes. Before @NoFieldSelectors@ is available, this can be alleviated by +-- splitting modules defining types into two, namely: +-- +-- (1) A private one that exports full type definitions, i.e. with their fields +-- and constructors. +-- +-- (2) A public one that exports only constructors (or no constructors at all if +-- the data type in question is opaque). +-- +-- There is no notion of private and public modules within a single cabal +-- target, but we can hint at it e.g. by naming the public module @T@ and +-- private @T.Internal@. +-- +-- An example: +-- +-- Private module: +-- +-- @ +-- {-\# LANGUAGE DataKinds \#-} +-- {-\# LANGUAGE FlexibleInstances \#-} +-- {-\# LANGUAGE MultiParamTypeClasses \#-} +-- {-\# LANGUAGE TemplateHaskell \#-} +-- {-\# LANGUAGE TypeFamilies \#-} +-- {-\# LANGUAGE UndecidableInstances \#-} +-- module User.Internal (User(..)) where +-- +-- import Optics.TH +-- +-- data User = User { id :: Int +-- , name :: String +-- } +-- +-- makeFieldLabelsWith noPrefixFieldLabels ''User +-- +-- ... +-- @ +-- +-- Public module: +-- +-- @ +-- module User (User(User)) where +-- +-- import User.Internal +-- +-- ... +-- @ +-- +-- Then, whenever we're dealing with a value of type @User@ and want to read or +-- modify its fields, we can use corresponding labels without having to import +-- @User.Internal@. Importing @User@ is enough because it provides appropriate +-- 'LabelOptic' instances through @User.Internal@ which enables labels to be +-- interpreted as optics in the appropriate context. +-- +-- /Note:/ if you plan to completely hide (some of) the fields of a data type, +-- you need to skip defining the corresponding 'LabelOptic' instances for them +-- (in case you want fields to be read only, you can make the optic kind of the +-- coresponding 'LabelOptic' 'A_Getter' instead of 'A_Lens'). It's because +-- Haskell makes it impossible to selectively hide instances, so once a +-- 'LabelOptic' instance is defined, it'll always be possible to use a label +-- that desugars to its usage whenever a module with its definition is +-- (transitively) imported. +-- +-- @ +-- {-\# LANGUAGE OverloadedLabels #-} +-- +-- import Optics +-- import User +-- +-- greetUser :: User -> String +-- greetUser user = "Hello " ++ user ^. #name ++ "!" +-- +-- addSurname :: String -> User -> User +-- addSurname surname user = user & #name %~ (++ " " ++ surname) +-- @ +-- +-- But what if we want to create a new @User@ with the record syntax? Importing +-- @User@ module is not sufficient since it doesn't export @User@'s +-- fields. However, if we import @User.Internal@ /fully qualified/ and make use +-- of the fact that field names used within the record syntax don't have to be +-- prefixed when @DisambiguateRecordFields@ language extension is enabled, it +-- works out: +-- +-- @ +-- {-\# LANGUAGE DisambiguateRecordFields \#-} +-- +-- import User +-- import qualified User.Internal +-- +-- newUser :: User +-- newUser = User { id = 1 -- not User.Internal.id +-- , name = \"Ian\" -- not User.Internal.name +-- } +-- @ +-- +-- This way top-level field accessor functions stay in their own qualified +-- namespace and don't generate name clashes, yet they can be used without +-- prefix within the record syntax. + +-- $result +-- +-- When we follow the above conventions for data types in our application, we +-- get: +-- +-- (1) Prefixless field names that don't pollute global namespace (with the +-- internal module qualification trick). +-- +-- (2) Working tags based jump-to-definition for field names (as @field@ is the +-- ordinary field, whereas @#field@ is the lens referencing it). +-- +-- (3) The full power of optics at our disposal, should we ever need it. + +-- $instanceStructure +-- -- You might wonder why instances above are written in form -- -- @ @@ -109,7 +352,7 @@ -- better, but also allows it to generate better error messages. -- -- For example, if you try to write @peter & set #pets []@ with the appropriate --- LabelOptic instance in the second form, you get the following: +-- 'LabelOptic' instance in the second form, you get the following: -- -- @ -- :16:1: error: @@ -180,37 +423,36 @@ -- • In the expression: #age :: Iso' Human Int -- In an equation for ‘age’: age = #age :: Iso' Human Int -- @ + +-- $fundepLimitations #limitations# -- --- == Limitations arising from functional dependencies +-- 'LabelOptic' uses the following functional dependencies to guarantee good +-- type inference: -- --- Functional dependencies guarantee good type inference, but also --- create limitations. We can split them into two groups: +-- 1. @name s -> k a@ (the optic for the field @name@ in @s@ is of type @k@ and +-- focuses on @a@) -- --- - @name s -> k a@, @name t -> k b@ +-- 2. @name t -> k b@ (the optic for the field @name@ in @t@ is of type @k@ and +-- focuses on @b@) -- --- - @name s b -> t@, @name t a -> s@ +-- 3. @name s b -> t@ (replacing the field @name@ in @s@ with @b@ yields @t@) -- --- The first group ensures that when we compose two optics, the middle type is --- unambiguous. The consequence is that it's not possible to create label optics --- with @a@ or @b@ referencing type variables not referenced in @s@ or @t@, --- i.e. getters for fields of rank 2 type or reviews for constructors with --- existentially quantified types inside. +-- 4. @name t a -> s@ (replacing the field @name@ in @t@ with @a@ yields @s@) -- --- The second group ensures that when we perform a chain of updates, the middle --- type is unambiguous. The consequence is that it's not possible to define --- label optics that: +-- Dependencies (1) and (2) ensure that when we compose two optics, the middle +-- type is unambiguous. The consequence is that it's not possible to create +-- label optics with @a@ or @b@ referencing type variables not referenced in @s@ +-- or @t@, i.e. getters for fields of rank 2 type or reviews for constructors +-- with existentially quantified types inside. -- +-- Dependencies (3) and (4) ensure that when we perform a chain of updates, the +-- middle type is unambiguous. The consequence is that it's not possible to +-- define label optics that: +-- -- - Modify phantom type parameters of type @s@ or @t@. -- -- - Modify type parameters of type @s@ or @t@ if @a@ or @b@ contain ambiguous -- applications of type families to these type parameters. --- -module Optics.Label - ( LabelOptic(..) - , LabelOptic' - ) where - -import Optics.Internal.Optic -- $setup -- >>> import Optics.Core