{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} -- | -- Module: Optics.Label -- Description: Overloaded labels as optics. -- -- Overloaded labels are a solution to Haskell's namespace problem for records. -- The @-XOverloadedLabels@ extension allows a new expression syntax for labels, -- 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. 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' , GenericLabelOptics(..) -- ** Structure of 'LabelOptic' instances -- $instanceStructure -- ** Explanation of functional dependencies -- $fundepExplanation ) where import Data.Type.Bool import Data.Type.Equality import GHC.Generics import GHC.OverloadedLabels import GHC.TypeLits import Optics.Internal.Generic import Optics.Internal.Magic import Optics.Internal.Optic -- $sampleUsage -- -- #usage# -- -- An example showing how overloaded labels can be used as optics for fields of -- types having a 'Generic' instance. -- -- >>> :set -XDeriveAnyClass -- >>> :set -XDeriveGeneric -- >>> :set -XDuplicateRecordFields -- >>> :set -XOverloadedLabels -- >>> import GHC.Generics (Generic) -- -- >>> :{ -- data Pet -- = Cat { name :: String, age :: Int, lazy :: Bool } -- | Fish { name :: String, age :: Int, lazy :: Bool } -- deriving (Show, Generic) -- :} -- -- >>> :{ -- data Human = Human -- { name :: String -- , age :: Integer -- , pets :: [Pet] -- } deriving (Show, Generic) -- :} -- -- /Note:/ Generic deriving of optics works well on a moderate scale, but for -- ubiquitous usage (and in production in general) we recommend generating them -- with Template Haskell as it scales better in terms of compilation time. For -- more details see @makeFieldLabelsNoPrefix@ from -- <https://hackage.haskell.org/package/optics-th/docs/Optics-TH.html Optics.TH> -- in the <https://hackage.haskell.org/package/optics-th optics-th> package. -- -- Here is some test data: -- -- >>> :{ -- peter :: Human -- peter = Human { name = "Peter" -- , age = 13 -- , pets = [ Fish { name = "Goldie" -- , age = 1 -- , lazy = False -- } -- , Cat { name = "Loopy" -- , age = 3 -- , lazy = False -- } -- , Cat { name = "Sparky" -- , age = 2 -- , lazy = True -- } -- ] -- } -- :} -- -- Now we can ask for Peter's name: -- -- >>> peter ^. #name -- "Peter" -- -- or for names of his pets: -- -- >>> peter ^.. #pets % folded % #name -- ["Goldie","Loopy","Sparky"] -- -- We can check whether any of his pets is lazy: -- -- >>> orOf (#pets % folded % #lazy) peter -- True -- -- or how things might be be a year from now: -- -- >>> peter & #age %~ (+1) & #pets % mapped % #age %~ (+1) -- Human {name = "Peter", age = 14, pets = [Fish {name = "Goldie", age = 2, lazy = False},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 & #pets .~ [] -- Human {name = "Peter", age = 13, pets = []} -- $problem -- -- Standard Haskell records are a common source of frustration amongst seasoned -- Haskell programmers. Their main issues are: -- -- (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: -- -- - @<https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/duplicate_record_fields.html DuplicateRecordFields>@ - introduced in GHC 8.0.1, addresses (1) -- -- - @<https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/field_selectors.html NoFieldSelectors>@ and @<https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/overloaded_record_dot.html OverloadedRecordDot>@ - introduced in GHC 9.2.1, addresses (2) -- -- - @<https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/overloaded_record_update.html OverloadedRecordUpdate>@ - restricted version introduced in GHC 9.2.1, addresses (3) -- -- It needs to be noted however that @OverloadedRecordUpdate@ is not yet usable -- out of the box as it requires the user to enable @RebindableSyntax@ and -- provide their own @HasField@ class. -- -- Is there no hope then for people who would like to work with records in a -- reasonable way without waiting? 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 @<https://hackage.haskell.org/package/ghc-tags ghc-tags>@, -- 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, -- seamlessly derived via generic representation (see the -- <Optics-Label.html#usage Sample usage> section for more details) -- or generated with Template Haskell functions -- (defined in -- <https://hackage.haskell.org/package/optics-th/docs/Optics-TH.html Optics.TH> -- module from <https://hackage.haskell.org/package/optics-th optics-th> -- package) with -- -- @ -- makeFieldLabelsNoPrefix ''User -- makeFieldLabelsNoPrefix ''Movie -- @ -- -- Generally speaking, both techniques trade blows in terms of compile time and -- run time resources. Generic optics are a bit slower to compile without -- optimizations than Template Haskell generated ones and their updating part -- might be slightly slower for larger data types with GHC < 9.2. On the other -- hand, generic optics are much more developer friendly. -- -- /Note:/ there exists a similar approach that involves prefixing field names -- (either with the underscore or name of the data type) and generation of -- lenses as ordinary functions so that @prefixField@ 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. If you can't use GHC >= 9.2 and take advantage of the -- @NoFieldSelectors@ language extension, 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 -- } -- -- makeFieldLabelsNoPrefix ''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 #structure# -- -- You might wonder why instances generated with Template Haskell have the -- following form: -- -- @ -- instance (k ~ A_Lens, a ~ [Pet], b ~ [Pet]) => LabelOptic "pets" k Human Human a b where -- ... -- @ -- -- instead of -- -- @ -- instance LabelOptic "pets" A_Lens Human Human [Pet] [Pet] where -- ... -- @ -- -- The reason is that using the first form ensures that it is enough for GHC to -- match on the instance if either @s@ or @t@ is known (as equality constraints -- are solved after the instance matches), which not only makes type inference -- better, but also allows it to generate better error messages. -- -- >>> :set -XDataKinds -- >>> :set -XFlexibleInstances -- >>> :set -XMultiParamTypeClasses -- >>> :set -XTypeFamilies -- >>> :set -XUndecidableInstances -- >>> :{ -- data Pet = Dog { name :: String } -- | Cat { name :: String } -- deriving Show -- :} -- -- >>> :{ -- data Human1 = Human1 { pets :: [Pet] } -- deriving Show -- instance LabelOptic "pets" A_Lens Human1 Human1 [Pet] [Pet] where -- labelOptic = lensVL $ \f (Human1 pets) -> Human1 <$> f pets -- :} -- -- >>> :{ -- data Human2 = Human2 { pets :: [Pet] } -- deriving Show -- instance (k ~ A_Lens, a ~ [Pet], b ~ [Pet]) => LabelOptic "pets" k Human2 Human2 a b where -- labelOptic = lensVL $ \f (Human2 pets) -> Human2 <$> f pets -- :} -- -- >>> let human1 = Human1 [Dog "Lucky"] -- >>> let human2 = Human2 [Cat "Sleepy"] -- -- Let's have a look how these two instance definitions differ. -- -- >>> human1 & #pets .~ [] -- ... -- ...No instance for LabelOptic "pets" ‘A_Lens’ ‘Human1’ ‘()’ ‘[Pet]’ ‘[a0]’ -- ... -- -- >>> human2 & #pets .~ [] -- Human2 {pets = []} -- -- That's because an empty list doesn't have a type @[Pet]@, it has a type @[r]@ -- and GHC doesn't have enough information to match on the instance we -- provided. We'd need to either annotate the list: -- -- >>> human1 & #pets .~ ([] :: [Pet]) -- Human1 {pets = []} -- -- or the result type: -- -- >>> human1 & #pets .~ [] :: Human1 -- Human1 {pets = []} -- -- both of which are a nuisance. -- -- Here are more examples of confusing error messages if the instance for -- @LabelOptic "pets"@ is written without type equalities: -- -- >>> human1 ^. #pets :: Char -- ... -- ...No instance for LabelOptic "pets" ‘A_Lens’ ‘Human1’ ‘Human1’ ‘Char’ ‘Char’ -- ... -- -- >>> human1 & #pets .~ 'x' -- ... -- ...No instance for LabelOptic "pets" ‘A_Lens’ ‘Human1’ ‘Human1’ ‘[Pet]’ ‘Char’ -- ... -- -- >>> let pets = #pets :: Iso' Human1 [Pet] -- ... -- ...No instance for LabelOptic "pets" ‘An_Iso’ ‘Human1’ ‘Human1’ ‘[Pet]’ ‘[Pet]’ -- ... -- -- If we use the second form, error messages become much more accurate: -- -- >>> human2 ^. #pets :: Char -- ... -- ...Couldn't match type ‘Char’ with ‘[Pet]’ -- ... arising from the overloaded label ‘#pets’ -- ... -- -- >>> human2 & #pets .~ 'x' -- ... -- ...Couldn't match type ‘Char’ with ‘[Pet]’ -- ... arising from the overloaded label ‘#pets’ -- ... -- -- >>> let pets = #pets :: Iso' Human2 [Pet] -- ... -- ...Couldn't match type ‘An_Iso’ with ‘A_Lens’ -- ... arising from the overloaded label ‘#pets’ -- ... -- $fundepExplanation -- -- 'LabelOptic' uses the following functional dependencies to guarantee good -- type inference: -- -- 1. @name s -> k a@ (the optic for the field @name@ in @s@ is of type @k@ and -- focuses on @a@) -- -- 2. @name t -> k b@ (the optic for the field @name@ in @t@ is of type @k@ and -- focuses on @b@) -- -- 3. @name s b -> t@ (replacing the field @name@ in @s@ with @b@ yields @t@) -- -- 4. @name t a -> s@ (replacing the field @name@ in @t@ with @a@ yields @s@) -- -- Dependencies (1) and (2) ensure that when we compose two optics, the middle -- type is unambiguous. -- -- Dependencies (3) and (4) ensure that when we perform a chain of updates, the -- middle type is unambiguous. ---------------------------------------- -- Definitions -- | Support for overloaded labels as optics. -- -- An overloaded label @#foo@ can be used as an optic if there is an instance -- @'LabelOptic' "foo" k s t a b@. -- -- Alternatively, if both @s@ and @t@ have a 'Generic' ('GenericLabelOptics' if -- @explicit-generic-labels@ flag is enabled) instance, a total field of @s@ is -- accessible by a label @#field@ of kind 'A_Lens', whereas its constructor by a -- label @#_Constructor@ of kind 'A_Prism'. class LabelOptic (name :: Symbol) k s t a b | name s -> k a , name t -> k b , name s b -> t , name t a -> s where -- | Used to interpret overloaded label syntax. An overloaded label @#foo@ -- corresponds to @'labelOptic' \@"foo"@. labelOptic :: Optic k NoIx s t a b -- | Type synonym for a type-preserving optic as overloaded label. type LabelOptic' name k s a = LabelOptic name k s s a a data Void0 -- | If for an overloaded label @#label@ there is no instance starting with -- @LabelOptic "label"@ in scope, using it in the context of optics makes GHC -- immediately pick the overlappable instance defined below (since no other -- instance could match). If at this point GHC has no information about @s@ or -- @t@, it ends up picking incoherent instance of 'GenericLabelOptic' defined -- below. Prevent that (if only to be able to inspect most polymorphic types of -- @#foo % #bar@ or @view #foo@ in GHCi) by defining a dummy instance that -- matches all names, thus postponing instance resolution until @s@ or @t@ is -- known. instance ( k ~ An_Iso, a ~ Void0, b ~ Void0 ) => LabelOptic name k Void0 Void0 a b where labelOptic :: Optic k NoIx Void0 Void0 a b labelOptic = (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind) (i :: OpticKind). Profunctor p => Optic_ k p i (Curry NoIx i) Void0 Void0 a b) -> Optic k NoIx Void0 Void0 a b forall (k :: OpticKind) (is :: IxList) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). (forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind) (i :: OpticKind). Profunctor p => Optic_ k p i (Curry is i) s t a b) -> Optic k is s t a b Optic forall (a :: OpticKind). a -> a forall (p :: OpticKind -> OpticKind -> OpticKind -> OpticKind) (i :: OpticKind). Profunctor p => Optic_ k p i (Curry NoIx i) Void0 Void0 a b id -- | If no instance matches, try to use 'Generic' machinery for field access. -- -- For more information have a look at 'Optics.Generic.gfield' and -- 'Optics.Generic.gconstructor'. -- -- @since 0.4 instance {-# OVERLAPPABLE #-} ( GenericLabelOpticContext repDefined name k s t a b ) => LabelOptic name k s t a b where labelOptic :: Optic k NoIx s t a b labelOptic = forall (k :: OpticKind) (repDefined :: Bool) (name :: k) (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GenericOptic repDefined name k s t a b => Optic k NoIx s t a b forall (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GenericOptic repDefined name k s t a b => Optic k NoIx s t a b genericOptic @repDefined @name -- | Hide implementation from haddock. type GenericLabelOpticContext repDefined name k s t a b = ( s `HasShapeOf` t , t `HasShapeOf` s #ifdef EXPLICIT_GENERIC_LABELS , repDefined ~ (HasGenericLabelOptics s && HasGenericLabelOptics t) #else , repDefined ~ (Defined (Rep s) && Defined (Rep t)) #endif , Unless repDefined (NoLabelOpticError name k s t a b) , k ~ If (CmpSymbol "_@" name == 'LT && CmpSymbol "_[" name == 'GT) A_Prism A_Lens , GenericOptic repDefined name k s t a b , Dysfunctional name k s t a b ) -- | If there is no specific 'LabelOptic' instance, display a custom type error. type family NoLabelOpticError name k s t a b where NoLabelOpticError name k s t a b = TypeError ('Text "No instance for LabelOptic " ':<>: 'ShowType name ':<>: 'Text " " ':<>: QuoteType k ':<>: 'Text " " ':<>: QuoteType s ':<>: 'Text " " ':<>: QuoteType t ':<>: 'Text " " ':<>: QuoteType a ':<>: 'Text " " ':<>: QuoteType b ':$$: 'Text "Possible solutions:" ':$$: 'Text "- Check and correct spelling of the label" ':$$: 'Text "- Define the LabelOptic instance by hand or via Template Haskell" #ifdef EXPLICIT_GENERIC_LABELS ':$$: 'Text "- Derive a GenericLabelOptics instance for " ':<>: QuoteType s #else ':$$: 'Text "- Derive a Generic instance for " ':<>: QuoteType s #endif ) ---------------------------------------- -- | If the @explicit-generic-labels@ Cabal flag is enabled, only types with -- this instance (which can be trivially derived with @DeriveAnyClass@ -- extension) will be able to use labels as generic optics with a specific type. -- -- It's an option for application developers to disable implicit fallback to -- generic optics for more control. -- -- Libraries using generic labels with their data types should derive this -- instance for compatibility with the @explicit-generic-labels@ flag. -- -- /Note:/ the flag @explicit-generic-labels@ is disabled by default. Enabling -- it is generally unsupported as it might lead to compilation errors of -- dependencies relying on implicit fallback to generic optics. -- -- @since 0.4 class Generic a => GenericLabelOptics a where type HasGenericLabelOptics a :: Bool type HasGenericLabelOptics a = 'True ---------------------------------------- class GenericOptic (repDefined :: Bool) name k s t a b where genericOptic :: Optic k NoIx s t a b instance ( -- We always let GHC enter the GFieldImpl instance because doing so doesn't -- generate any additional error messages and we might get type improvements -- from the HasField constraint to show in the error message. GFieldImpl name s t a b ) => GenericOptic repDefined name A_Lens s t a b where genericOptic :: Optic A_Lens NoIx s t a b genericOptic = forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GFieldImpl name s t a b => Lens s t a b forall (name :: Symbol) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GFieldImpl name s t a b => Lens s t a b gfieldImpl @name instance ( GConstructorImpl repDefined name s t a b , _name ~ AppendSymbol "_" name ) => GenericOptic repDefined _name A_Prism s t a b where genericOptic :: Optic A_Prism NoIx s t a b genericOptic = forall (repDefined :: Bool) (name :: Symbol) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GConstructorImpl repDefined name s t a b => Prism s t a b forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). GConstructorImpl repDefined name s t a b => Prism s t a b gconstructorImpl @repDefined @name ---------------------------------------- instance (LabelOptic name k s t a b, is ~ NoIx ) => IsLabel name (Optic k is s t a b) where fromLabel :: Optic k is s t a b fromLabel = forall (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). LabelOptic name k s t a b => Optic k NoIx s t a b forall (name :: Symbol) (k :: OpticKind) (s :: OpticKind) (t :: OpticKind) (a :: OpticKind) (b :: OpticKind). LabelOptic name k s t a b => Optic k NoIx s t a b labelOptic @name -- $setup -- >>> import Optics.Core